Changeset 28422 in project


Ignore:
Timestamp:
02/23/13 18:22:04 (7 years ago)
Author:
Kon Lovett
Message:

Fix for Ticket #630

Location:
release/4/procedure-decoration
Files:
8 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/procedure-decoration/tags/2.0.2/procedure-decoration.meta

    r23255 r28422  
    88 (synopsis "Procedure Decoration API")
    99 (depends
    10   (setup-helper "1.2.0")
     10  (setup-helper "1.5.2")
    1111  (check-errors "1.12.1"))
    1212 (test-depends test)
    13  (files "procedure-decoration.scm" "procedure-decoration.meta" "procedure-decoration.setup" "procedure-decoration.release-info" "tests/run.scm") )
     13 (files "procedure-decoration.scm" "procedure-decoration.meta" "procedure-decoration.setup" "tests/run.scm") )
  • release/4/procedure-decoration/tags/2.0.2/procedure-decoration.scm

    r16076 r28422  
    88    lambda-decoration
    99    decorate-lambda
    10     ;; 
     10    ;;
    1111    make-procedure-decorator
    1212    procedure-decorator?
     
    3737
    3838(define (update-lambda-decoration! proc pred decr)
    39   (define (setter proc i) (##sys#setslot proc i (decr (##sys#slot proc i))) proc)
    40   (##sys#decorate-lambda proc pred setter) )
     39  (##sys#decorate-lambda
     40    proc
     41    pred
     42    (lambda (proc i)
     43      (##sys#setslot proc i (decr (##sys#slot proc i)))
     44      proc)) )
    4145
    4246(define (procedure-become old new) (##sys#become! `((,old . ,new))))
     
    4448;;
    4549
    46 (define (check-procedure2 loc obj1 obj2)
    47   (check-procedure loc obj1)
    48   (check-procedure loc obj2) )
    49 
    50 (define (check-procedure3 loc obj1 obj2 obj3)
    51   (check-procedure2 loc obj1 obj2)
    52   (check-procedure loc obj3) )
    53 
    54 ;;
    55 
    5650(define (decorated-lambda? proc pred)
    57   (check-procedure2 'decorated-lambda? proc pred)
     51  (check-procedure 'decorated-lambda? proc 'procedure)
     52  (check-procedure 'decorated-lambda? pred 'predicate)
    5853  (->boolean (##sys#lambda-decoration proc pred)) )
    5954
    6055(define (lambda-decoration proc pred)
    61   (check-procedure2 'lambda-decoration proc pred)
     56  (check-procedure 'lambda-decoration proc 'procedure)
     57  (check-procedure 'lambda-decoration pred 'predicate)
    6258  (##sys#lambda-decoration proc pred) )
    6359
    6460(define (decorate-lambda proc pred decr)
    65   (check-procedure3 'decorate-lambda proc pred decr)
     61  (check-procedure 'decorate-lambda proc 'procedure)
     62  (check-procedure 'decorate-lambda pred 'predicate)
     63  (check-procedure 'decorate-lambda decr 'decorator)
    6664  (update-lambda-decoration! proc pred decr) )
    6765
     
    121119
    122120(define (make-procedure-decorator pred decr retr #!key (initializer #f) (replace? #f))
    123   (check-procedure3 'make-procedure-decorator pred decr retr)
     121  (check-procedure 'make-procedure-decorator pred 'predicate)
     122  (check-procedure 'make-procedure-decorator decr 'decorator)
     123  (check-procedure 'make-procedure-decorator retr 'retriever)
    124124  (when initializer (check-procedure 'make-procedure-decorator initializer))
    125125  (*make-procedure-decorator pred decr retr initializer replace?) )
  • release/4/procedure-decoration/tags/2.0.2/procedure-decoration.setup

    r20300 r28422  
    11;;;; procedure-decoration.setup  -*- Hen -*-
    22
    3 (include "setup-helper")
     3(use setup-helper-mod)
    44
    55(verify-extension-name "procedure-decoration")
    66
    7 (setup-shared-extension-module 'procedure-decoration (extension-version "2.0.1")
     7(setup-shared-extension-module 'procedure-decoration (extension-version "2.0.2")
     8  #:inline? #t
     9  #:types? #t
    810  #:compile-options '(
    911    -optimize-level 3
  • release/4/procedure-decoration/tags/2.0.2/tests/run.scm

    r16076 r28422  
    3636  (test-assert (decr-test-proc))
    3737)
     38
     39(test-exit)
  • release/4/procedure-decoration/trunk/procedure-decoration.meta

    r23255 r28422  
    88 (synopsis "Procedure Decoration API")
    99 (depends
    10   (setup-helper "1.2.0")
     10  (setup-helper "1.5.2")
    1111  (check-errors "1.12.1"))
    1212 (test-depends test)
    13  (files "procedure-decoration.scm" "procedure-decoration.meta" "procedure-decoration.setup" "procedure-decoration.release-info" "tests/run.scm") )
     13 (files "procedure-decoration.scm" "procedure-decoration.meta" "procedure-decoration.setup" "tests/run.scm") )
  • release/4/procedure-decoration/trunk/procedure-decoration.scm

    r16076 r28422  
    88    lambda-decoration
    99    decorate-lambda
    10     ;; 
     10    ;;
    1111    make-procedure-decorator
    1212    procedure-decorator?
     
    3737
    3838(define (update-lambda-decoration! proc pred decr)
    39   (define (setter proc i) (##sys#setslot proc i (decr (##sys#slot proc i))) proc)
    40   (##sys#decorate-lambda proc pred setter) )
     39  (##sys#decorate-lambda
     40    proc
     41    pred
     42    (lambda (proc i)
     43      (##sys#setslot proc i (decr (##sys#slot proc i)))
     44      proc)) )
    4145
    4246(define (procedure-become old new) (##sys#become! `((,old . ,new))))
     
    4448;;
    4549
    46 (define (check-procedure2 loc obj1 obj2)
    47   (check-procedure loc obj1)
    48   (check-procedure loc obj2) )
    49 
    50 (define (check-procedure3 loc obj1 obj2 obj3)
    51   (check-procedure2 loc obj1 obj2)
    52   (check-procedure loc obj3) )
    53 
    54 ;;
    55 
    5650(define (decorated-lambda? proc pred)
    57   (check-procedure2 'decorated-lambda? proc pred)
     51  (check-procedure 'decorated-lambda? proc 'procedure)
     52  (check-procedure 'decorated-lambda? pred 'predicate)
    5853  (->boolean (##sys#lambda-decoration proc pred)) )
    5954
    6055(define (lambda-decoration proc pred)
    61   (check-procedure2 'lambda-decoration proc pred)
     56  (check-procedure 'lambda-decoration proc 'procedure)
     57  (check-procedure 'lambda-decoration pred 'predicate)
    6258  (##sys#lambda-decoration proc pred) )
    6359
    6460(define (decorate-lambda proc pred decr)
    65   (check-procedure3 'decorate-lambda proc pred decr)
     61  (check-procedure 'decorate-lambda proc 'procedure)
     62  (check-procedure 'decorate-lambda pred 'predicate)
     63  (check-procedure 'decorate-lambda decr 'decorator)
    6664  (update-lambda-decoration! proc pred decr) )
    6765
     
    121119
    122120(define (make-procedure-decorator pred decr retr #!key (initializer #f) (replace? #f))
    123   (check-procedure3 'make-procedure-decorator pred decr retr)
     121  (check-procedure 'make-procedure-decorator pred 'predicate)
     122  (check-procedure 'make-procedure-decorator decr 'decorator)
     123  (check-procedure 'make-procedure-decorator retr 'retriever)
    124124  (when initializer (check-procedure 'make-procedure-decorator initializer))
    125125  (*make-procedure-decorator pred decr retr initializer replace?) )
  • release/4/procedure-decoration/trunk/procedure-decoration.setup

    r20300 r28422  
    11;;;; procedure-decoration.setup  -*- Hen -*-
    22
    3 (include "setup-helper")
     3(use setup-helper-mod)
    44
    55(verify-extension-name "procedure-decoration")
    66
    7 (setup-shared-extension-module 'procedure-decoration (extension-version "2.0.1")
     7(setup-shared-extension-module 'procedure-decoration (extension-version "2.0.2")
     8  #:inline? #t
     9  #:types? #t
    810  #:compile-options '(
    911    -optimize-level 3
  • release/4/procedure-decoration/trunk/tests/run.scm

    r16076 r28422  
    3636  (test-assert (decr-test-proc))
    3737)
     38
     39(test-exit)
Note: See TracChangeset for help on using the changeset viewer.