Changeset 16000 in project


Ignore:
Timestamp:
09/20/09 23:13:24 (10 years ago)
Author:
Kon Lovett
Message:

Rel 1.0.0

Location:
release/4/coerce
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/coerce/tags/1.0.0/coerce.setup

    r15998 r16000  
    88  "check-errors"              "1.5.0")
    99
    10 (setup-shared-extension-module 'type-extend-support (extension-version "4.0.0")
     10(setup-shared-extension-module 'type-extend-support (extension-version "1.0.0")
    1111  #:compile-options '(-optimize-level 3 -debug-level 0
    1212                      -fixnum-arithmetic
    1313                      -no-procedure-checks -no-bound-checks -no-argc-checks))
    1414
    15 (setup-shared-extension-module 'type-of (extension-version "4.0.0")
     15(setup-shared-extension-module 'type-of (extension-version "1.0.0")
    1616  #:compile-options '(-optimize-level 3
    1717                      -fixnum-arithmetic
    1818                      -no-procedure-checks))
    1919
    20 (setup-shared-extension-module 'type-coerce (extension-version "4.0.0")
     20(setup-shared-extension-module 'type-coerce (extension-version "1.0.0")
    2121  #:compile-options '(-optimize-level 3
    2222                      -fixnum-arithmetic
    2323                      -no-procedure-checks))
    2424
    25 (setup-shared-extension-module 'coerce (extension-version "4.0.0"))
     25(setup-shared-extension-module 'coerce (extension-version "1.0.0"))
  • release/4/coerce/tags/1.0.0/tests/run.scm

    r15998 r16000  
    1313      ((symbol)   '||)
    1414      ((list)     (list))
    15       ((vector)   (vector))))
     15      ((vector)   (vector))
     16      (else       (void) ) ) )
    1617
    1718  (define (unspecified? obj) (eq? (void) obj))
  • release/4/coerce/tags/1.0.0/type-coerce.scm

    r15998 r16000  
    5858(define-syntax case-coerce
    5959  (lambda (frm rnm cmp)
    60     (let ((_object (rnm 'object))
    61           (_on-error (rnm 'on-error))
    62           (_lambda (rnm 'lambda))
     60    (let ((_lambda (rnm 'lambda))
    6361          (_case (rnm 'case))
    6462          (_else (rnm 'else))
    65           (_*make-case-coerce (rnm '*make-case-coerce)) )
    66       (let ((else-clause `(,_else (,_on-error))))
     63          (_*make-case-coerce (rnm '*make-case-coerce))
     64          (_typ (rnm 'typ)) )
     65      (let ((else-clause `(,_else (on-error))))
    6766        (let loop ((clauses (cdr frm)) (sym-clauses '()))
    6867          (if (null? clauses)
    6968              `(,_*make-case-coerce
    70                  (,_lambda (,_object typ ,_on-error)
    71                    (,_case typ ,@(reverse! sym-clauses) ,else-clause))
     69                 (,_lambda (object ,_typ on-error)
     70                   (,_case ,_typ ,@(reverse! sym-clauses) ,else-clause))
    7271                 '())
    7372              (let* ((clause (car clauses))
     73                     (rest (cdr clauses))
    7474                     (tst (car clause))
    7575                     (bdy (cdr clause)) )
    7676                (##sys#check-syntax 'case-coerce bdy '#(_ 1))
    77                 (cond ((eq? 'else tst)
    78                         (set! else-clause clause) )
     77                (cond ((and (symbol? tst) (cmp tst _else))
     78                        (set! else-clause clause)
     79                        (loop rest sym-clauses) )
    7980                      (else
    8081                        (##sys#check-syntax 'case-coerce tst '#(symbol 1))
    81                         (loop (cdr clauses) (cons clause sym-clauses)) ) ) ) ) ) ) ) ) )
     82                        (loop rest (cons clause sym-clauses)) ) ) ) ) ) ) ) ) )
    8283
    8384;;@body
  • release/4/coerce/trunk/coerce.setup

    r15998 r16000  
    88  "check-errors"              "1.5.0")
    99
    10 (setup-shared-extension-module 'type-extend-support (extension-version "4.0.0")
     10(setup-shared-extension-module 'type-extend-support (extension-version "1.0.0")
    1111  #:compile-options '(-optimize-level 3 -debug-level 0
    1212                      -fixnum-arithmetic
    1313                      -no-procedure-checks -no-bound-checks -no-argc-checks))
    1414
    15 (setup-shared-extension-module 'type-of (extension-version "4.0.0")
     15(setup-shared-extension-module 'type-of (extension-version "1.0.0")
    1616  #:compile-options '(-optimize-level 3
    1717                      -fixnum-arithmetic
    1818                      -no-procedure-checks))
    1919
    20 (setup-shared-extension-module 'type-coerce (extension-version "4.0.0")
     20(setup-shared-extension-module 'type-coerce (extension-version "1.0.0")
    2121  #:compile-options '(-optimize-level 3
    2222                      -fixnum-arithmetic
    2323                      -no-procedure-checks))
    2424
    25 (setup-shared-extension-module 'coerce (extension-version "4.0.0"))
     25(setup-shared-extension-module 'coerce (extension-version "1.0.0"))
  • release/4/coerce/trunk/tests/run.scm

    r15998 r16000  
    1313      ((symbol)   '||)
    1414      ((list)     (list))
    15       ((vector)   (vector))))
     15      ((vector)   (vector))
     16      (else       (void) ) ) )
    1617
    1718  (define (unspecified? obj) (eq? (void) obj))
  • release/4/coerce/trunk/type-coerce.scm

    r15998 r16000  
    5858(define-syntax case-coerce
    5959  (lambda (frm rnm cmp)
    60     (let ((_object (rnm 'object))
    61           (_on-error (rnm 'on-error))
    62           (_lambda (rnm 'lambda))
     60    (let ((_lambda (rnm 'lambda))
    6361          (_case (rnm 'case))
    6462          (_else (rnm 'else))
    65           (_*make-case-coerce (rnm '*make-case-coerce)) )
    66       (let ((else-clause `(,_else (,_on-error))))
     63          (_*make-case-coerce (rnm '*make-case-coerce))
     64          (_typ (rnm 'typ)) )
     65      (let ((else-clause `(,_else (on-error))))
    6766        (let loop ((clauses (cdr frm)) (sym-clauses '()))
    6867          (if (null? clauses)
    6968              `(,_*make-case-coerce
    70                  (,_lambda (,_object typ ,_on-error)
    71                    (,_case typ ,@(reverse! sym-clauses) ,else-clause))
     69                 (,_lambda (object ,_typ on-error)
     70                   (,_case ,_typ ,@(reverse! sym-clauses) ,else-clause))
    7271                 '())
    7372              (let* ((clause (car clauses))
     73                     (rest (cdr clauses))
    7474                     (tst (car clause))
    7575                     (bdy (cdr clause)) )
    7676                (##sys#check-syntax 'case-coerce bdy '#(_ 1))
    77                 (cond ((eq? 'else tst)
    78                         (set! else-clause clause) )
     77                (cond ((and (symbol? tst) (cmp tst _else))
     78                        (set! else-clause clause)
     79                        (loop rest sym-clauses) )
    7980                      (else
    8081                        (##sys#check-syntax 'case-coerce tst '#(symbol 1))
    81                         (loop (cdr clauses) (cons clause sym-clauses)) ) ) ) ) ) ) ) ) )
     82                        (loop rest (cons clause sym-clauses)) ) ) ) ) ) ) ) ) )
    8283
    8384;;@body
Note: See TracChangeset for help on using the changeset viewer.