Changeset 36467 in project


Ignore:
Timestamp:
08/30/18 13:01:38 (3 months ago)
Author:
juergen
Message:

bindings 1.2 fixes null pattern bug

Location:
release/5/bindings
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/bindings/tags/1.2/bindings.egg

    r36356 r36467  
    55 (test-dependencies simple-tests)
    66 (author "Juergen Lorenz")
    7  (version "1.1")
     7 (version "1.2")
    88 (components (extension bindings)))
  • release/5/bindings/tags/1.2/bindings.scm

    r36356 r36467  
    8181  (bind bind-case bind-lambda bind-lambda* bind-case-lambda
    8282   bind-case-lambda* bind-named bind-let bind-let* bind-letrec bindrec
    83    bindable? bind-define bind-set! bind/cc bindings
    84    bind-seq-db bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception bind-pseudo-list?)
     83   bindable? bind-define bind-set! bind/cc bindings bind-seq-db
     84         bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception
     85         bind-pseudo-list?)
    8586
    8687  (import scheme
     
    333334                                literals
    334335                                tails)))
    335                        ((atom? item) ; literal
     336                       ;((atom? item) ; literal
     337                                                                                         ((and (not (pair? item)) (not (null? item)))
    336338                        (loop (+ k 1)
    337339                              pairs
     
    340342                                    literals)
    341343                              tails))
    342                        ((pair? item)
     344                       ;((pair? item)
     345                                                                                         ((or (null? item) (pair? item))
    343346                        (receive (ps ls ts)
    344347                          (destructure item `(,%bind-seq-ref ,seq ,k))
     
    400403                     `((,%where) ,xpr ,@xprs))))
    401404        `(,%let ((,%seq ,seq))
    402            ,(cons %bind-with
    403                   (cons %let
    404                         (cons pat
    405                               (cons %seq body)))))))))
     405           ;,(cons %bind-with
     406           ;       (cons %let
     407           ;             (cons pat
     408           ;                   (cons %seq body)))))))))
     409                                         ,(apply list %bind-with %let pat %seq body))))))
    406410
    407411#|[
  • release/5/bindings/tags/1.2/tests/run.scm

    r36356 r36467  
    4444(define-test (binds?)
    4545  (= (bind a 1 a) 1)
     46        (= (bind (a ()) (list 1 "") a) 1)
    4647  (equal? (bind (a b) '(1 2) (where (a odd?)) (list a b)) '(1 2))
    4748  (equal?
  • release/5/bindings/trunk/bindings.egg

    r36356 r36467  
    55 (test-dependencies simple-tests)
    66 (author "Juergen Lorenz")
    7  (version "1.1")
     7 (version "1.2")
    88 (components (extension bindings)))
  • release/5/bindings/trunk/bindings.scm

    r36356 r36467  
    8181  (bind bind-case bind-lambda bind-lambda* bind-case-lambda
    8282   bind-case-lambda* bind-named bind-let bind-let* bind-letrec bindrec
    83    bindable? bind-define bind-set! bind/cc bindings
    84    bind-seq-db bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception bind-pseudo-list?)
     83   bindable? bind-define bind-set! bind/cc bindings bind-seq-db
     84         bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception
     85         bind-pseudo-list?)
    8586
    8687  (import scheme
     
    333334                                literals
    334335                                tails)))
    335                        ((atom? item) ; literal
     336                       ;((atom? item) ; literal
     337                                                                                         ((and (not (pair? item)) (not (null? item)))
    336338                        (loop (+ k 1)
    337339                              pairs
     
    340342                                    literals)
    341343                              tails))
    342                        ((pair? item)
     344                       ;((pair? item)
     345                                                                                         ((or (null? item) (pair? item))
    343346                        (receive (ps ls ts)
    344347                          (destructure item `(,%bind-seq-ref ,seq ,k))
     
    400403                     `((,%where) ,xpr ,@xprs))))
    401404        `(,%let ((,%seq ,seq))
    402            ,(cons %bind-with
    403                   (cons %let
    404                         (cons pat
    405                               (cons %seq body)))))))))
     405           ;,(cons %bind-with
     406           ;       (cons %let
     407           ;             (cons pat
     408           ;                   (cons %seq body)))))))))
     409                                         ,(apply list %bind-with %let pat %seq body))))))
    406410
    407411#|[
  • release/5/bindings/trunk/tests/run.scm

    r36356 r36467  
    4444(define-test (binds?)
    4545  (= (bind a 1 a) 1)
     46        (= (bind (a ()) (list 1 "") a) 1)
    4647  (equal? (bind (a b) '(1 2) (where (a odd?)) (list a b)) '(1 2))
    4748  (equal?
Note: See TracChangeset for help on using the changeset viewer.