Changeset 38205 in project


Ignore:
Timestamp:
02/27/20 15:58:47 (5 weeks ago)
Author:
juergen
Message:

bindings 3.1 with bind-loop to replace bind*

Location:
release/5/bindings
Files:
3 edited
4 copied

Legend:

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

    r38193 r38205  
    44 (test-dependencies simple-tests checks biglists)
    55 (author "Juergen Lorenz")
    6  (version "3.0.1")
     6 (version "3.1")
    77 (components (extension bindings)))
  • release/5/bindings/tags/3.1/bindings.scm

    r38193 r38205  
    7777  bind-case-lambda*
    7878  bind*
     79  bind-loop
    7980  bind-let*
    8081  bind-let
     
    141142           (let loop ((pat pat) (seq seq) (result '()))
    142143             (cond
    143                ((null? pat); (reverse (cons seq result)))
     144               ((null? pat)
    144145                (if (seq-null? seq)
    145146                  (reverse result)
     
    173174                              (format #f "literals ~s and ~s not equal?~%"
    174175                                      pfirst sfirst))))
     176                    (else (error 'bind-listify*
     177                                 (format #f "~s is not a valid literal~%")
     178                                 pfirst))
    175179                    )))
    176180               (else
     
    186190                              (format #f "literals ~s and ~s not equal?~%"
    187191                                      pat seq))))
     192                   (else (error 'bind-listify*
     193                                (format #f "~s is not a valid literal~%")
     194                                pat))
    188195                   )))))))
    189196      ((seq? seq-car seq-cdr)
     
    513520
    514521#|[
     522The following macro, bind-loop, is an anaphoric version of bind.
     523It introduces an unrenamed symbol, loop, behind the scene and binds it
     524to a procedure, which can be used in the body.
     525For example
     526
     527  (bind-loop (x y) '(5 0)
     528    (if (zero? x)
     529      (list x y)
     530      (loop (list (sub1 x) (add1 y)))))
     531  -> '(0 5)
     532]|#
     533
     534;;; (bind-loop pat seq xpr ....)
     535;;; ---- ------------------------
     536;;; anaphoric version of bind, introducing loop routine behind the scene
     537(define-syntax bind-loop
     538  (er-macro-transformer
     539    (lambda (form rename compare?)
     540      (let ((pat (cadr form))
     541            (seq (caddr form))
     542            (xpr (cadddr form))
     543            (xprs (cddddr form))
     544            (%letrec (rename 'letrec))
     545            (%bind-lambda (rename 'bind-lambda)))
     546        `((,%letrec ((loop (,%bind-lambda ,pat ,xpr ,@xprs)))
     547            loop)
     548          ,seq)))))
     549
     550#|[
    515551The following macro, bind*, is a named version of bind. It takes an
    516552additional argument besides those of bind, which is bound to a
     
    527563
    528564;;; (bind* name pat seq xpr ....)
    529 ;;; ---- -----------------------------
     565;;; ---- ------------------------
    530566;;; named version of bind
    531567(define-syntax bind*
     
    687723      macro:
    688724      (bind* loop pat seq xpr ....)
    689       "named version of bind")
     725      "named version of bind,"
     726      "deprecated, use bind-loop instead")
     727    (bind-loop
     728      macro:
     729      (bind-loop pat seq xpr ....)
     730      "anaphoric version of bind,"
     731      "introduces a routine named loop behind the scene,"
     732      "to be used in the body xpr ....")
    690733    (bind-let
    691734      macro:
  • release/5/bindings/tags/3.1/tests/run.scm

    r38193 r38205  
    238238    '(1 2 3 4 5 #(6)))
    239239  (equal?
    240     (bind* loop (x (a . b) y) '(5 #(1) 0)
     240    (bind-loop (x (a . b) y) '(5 #(1) 0)
    241241      (>> x integer?)
    242242      (if (zero? x)
     
    244244        (loop (list (- x 1) (cons a (cons a b)) (+ y 1)))))
    245245    '(0 1 (1 1 1 1 1 . #()) 5))
     246  (equal?
     247    (bind* loop (x (a . b) y) '(5 #(1) 0)
     248      (>> x integer?)
     249      (if (zero? x)
     250        (list x a b y)
     251        (loop (list (- x 1) (cons a (cons a b)) (+ y 1)))))
     252    '(0 1 (1 1 1 1 1 . #()) 5))
     253  (equal?
     254    (bind-loop (x y) #(5 0)
     255      (>> x integer?)
     256      (if (zero? x)
     257        (vector x y)
     258        (loop (vector (- x 1) (+ y 1)))))
     259    '#(0 5))
    246260  (equal?
    247261    (bind* loop (x y) #(5 0)
     
    617631;(biglists?)
    618632
    619 
    620633(compound-test (BINDINGS)
    621634  (listify?)
  • release/5/bindings/trunk/bindings.egg

    r38193 r38205  
    44 (test-dependencies simple-tests checks biglists)
    55 (author "Juergen Lorenz")
    6  (version "3.0.1")
     6 (version "3.1")
    77 (components (extension bindings)))
  • release/5/bindings/trunk/bindings.scm

    r38193 r38205  
    7777  bind-case-lambda*
    7878  bind*
     79  bind-loop
    7980  bind-let*
    8081  bind-let
     
    141142           (let loop ((pat pat) (seq seq) (result '()))
    142143             (cond
    143                ((null? pat); (reverse (cons seq result)))
     144               ((null? pat)
    144145                (if (seq-null? seq)
    145146                  (reverse result)
     
    173174                              (format #f "literals ~s and ~s not equal?~%"
    174175                                      pfirst sfirst))))
     176                    (else (error 'bind-listify*
     177                                 (format #f "~s is not a valid literal~%")
     178                                 pfirst))
    175179                    )))
    176180               (else
     
    186190                              (format #f "literals ~s and ~s not equal?~%"
    187191                                      pat seq))))
     192                   (else (error 'bind-listify*
     193                                (format #f "~s is not a valid literal~%")
     194                                pat))
    188195                   )))))))
    189196      ((seq? seq-car seq-cdr)
     
    513520
    514521#|[
     522The following macro, bind-loop, is an anaphoric version of bind.
     523It introduces an unrenamed symbol, loop, behind the scene and binds it
     524to a procedure, which can be used in the body.
     525For example
     526
     527  (bind-loop (x y) '(5 0)
     528    (if (zero? x)
     529      (list x y)
     530      (loop (list (sub1 x) (add1 y)))))
     531  -> '(0 5)
     532]|#
     533
     534;;; (bind-loop pat seq xpr ....)
     535;;; ---- ------------------------
     536;;; anaphoric version of bind, introducing loop routine behind the scene
     537(define-syntax bind-loop
     538  (er-macro-transformer
     539    (lambda (form rename compare?)
     540      (let ((pat (cadr form))
     541            (seq (caddr form))
     542            (xpr (cadddr form))
     543            (xprs (cddddr form))
     544            (%letrec (rename 'letrec))
     545            (%bind-lambda (rename 'bind-lambda)))
     546        `((,%letrec ((loop (,%bind-lambda ,pat ,xpr ,@xprs)))
     547            loop)
     548          ,seq)))))
     549
     550#|[
    515551The following macro, bind*, is a named version of bind. It takes an
    516552additional argument besides those of bind, which is bound to a
     
    527563
    528564;;; (bind* name pat seq xpr ....)
    529 ;;; ---- -----------------------------
     565;;; ---- ------------------------
    530566;;; named version of bind
    531567(define-syntax bind*
     
    687723      macro:
    688724      (bind* loop pat seq xpr ....)
    689       "named version of bind")
     725      "named version of bind,"
     726      "deprecated, use bind-loop instead")
     727    (bind-loop
     728      macro:
     729      (bind-loop pat seq xpr ....)
     730      "anaphoric version of bind,"
     731      "introduces a routine named loop behind the scene,"
     732      "to be used in the body xpr ....")
    690733    (bind-let
    691734      macro:
  • release/5/bindings/trunk/tests/run.scm

    r38193 r38205  
    238238    '(1 2 3 4 5 #(6)))
    239239  (equal?
    240     (bind* loop (x (a . b) y) '(5 #(1) 0)
     240    (bind-loop (x (a . b) y) '(5 #(1) 0)
    241241      (>> x integer?)
    242242      (if (zero? x)
     
    244244        (loop (list (- x 1) (cons a (cons a b)) (+ y 1)))))
    245245    '(0 1 (1 1 1 1 1 . #()) 5))
     246  (equal?
     247    (bind* loop (x (a . b) y) '(5 #(1) 0)
     248      (>> x integer?)
     249      (if (zero? x)
     250        (list x a b y)
     251        (loop (list (- x 1) (cons a (cons a b)) (+ y 1)))))
     252    '(0 1 (1 1 1 1 1 . #()) 5))
     253  (equal?
     254    (bind-loop (x y) #(5 0)
     255      (>> x integer?)
     256      (if (zero? x)
     257        (vector x y)
     258        (loop (vector (- x 1) (+ y 1)))))
     259    '#(0 5))
    246260  (equal?
    247261    (bind* loop (x y) #(5 0)
     
    617631;(biglists?)
    618632
    619 
    620633(compound-test (BINDINGS)
    621634  (listify?)
Note: See TracChangeset for help on using the changeset viewer.