Changeset 29967 in project


Ignore:
Timestamp:
10/27/13 11:52:25 (8 years ago)
Author:
juergen
Message:

list-binding aif and vif

File:
1 edited

Legend:

Unmodified
Added
Removed
  • wiki/eggref/4/list-bindings

    r29966 r29967  
    181181(bind (x y z w) '(1 2 3 4) (list x y z w)) ; -> '(1 2 3 4)
    182182(bind (x (y (z . u) . v) . w)
    183         '(1 (2 (3 4) 5) 6)
    184         (list x y z u v w)) ; -> '(1 2 3 (4) (5) (6))
     183  '(1 (2 (3 4) 5) 6)
     184  (list x y z u v w)) ; -> '(1 2 3 (4) (5) (6))
    185185((bind-lambda (a (b . c) . d) (list a b c d))
    186186 '(1 (20 30 40) 2 3)) ; -> '(1 20 (30 40) (2 3))
     
    192192  ; -> '(1 2 3 (4 4))
    193193(bind-case '(1 (2 3))
    194         ((x (y z)) (list x y z))
    195         ((x (y . z)) (list x y z))
    196         ((x y) (list x y))) ; -> '(1 2 3)
     194  ((x (y z)) (list x y z))
     195  ((x (y . z)) (list x y z))
     196  ((x y) (list x y))) ; -> '(1 2 3)
    197197(bind-case '(1 (2 3))
    198         ((x (y . z)) (list x y z))
    199         ((x y) (list x y))
    200         ((x (y z)) (list x y z))) ; -> '(1 2 (3)))
     198  ((x (y . z)) (list x y z))
     199  ((x y) (list x y))
     200  ((x (y z)) (list x y z))) ; -> '(1 2 (3)))
    201201(bind-case '(1 (2 3))
    202         ((x y) (list x y))
    203         ((x (y . z)) (list x y z))
    204         ((x (y z)) (list x y z))) ; -> '(1 (2 3))
     202  ((x y) (list x y))
     203  ((x (y . z)) (list x y z))
     204  ((x (y z)) (list x y z))) ; -> '(1 (2 3))
    205205(bind-case '(1 (2 . 3))
    206         ((x y) (list x y))
    207         ((x (y . z)) (list x y z))
    208         ((x (y z)) (list x y z))) ; -> '(1 (2 . 3))
     206  ((x y) (list x y))
     207  ((x (y . z)) (list x y z))
     208  ((x (y z)) (list x y z))) ; -> '(1 (2 . 3))
    209209((bind-case-lambda
    210         ((a (b . c) . d) (list a b c d))
    211         ((e . f) (list e f)))
     210  ((a (b . c) . d) (list a b c d))
     211  ((e . f) (list e f)))
    212212 '(1 2 3 4 5)) ; -> '(1 (2 3 4 5))
    213213(letrec (
    214         (my-map
    215                 (lambda (fn lst)
    216                         (bind-case lst
    217                                 (() '())
    218                                 ((x . xs) (cons (fn x) (map fn xs))))))
    219         )
    220         (my-map add1 '(1 2 3))) ; -> '(2 3 4)
     214  (my-map
     215    (lambda (fn lst)
     216      (bind-case lst
     217        (() '())
     218        ((x . xs) (cons (fn x) (map fn xs))))))
     219  )
     220  (my-map add1 '(1 2 3))) ; -> '(2 3 4)
    221221((bindable? (a b)) '(1 2)) ; -> #t
    222222((bindable? (a . b)) '(1)) ; -> #t
     
    239239 
    240240(define-er-macro (efreeze xpr)
    241         (renaming (% %lambda)
    242                 (comparing ()
    243                         `(,%lambda () ,xpr))))
     241  (renaming (% %lambda)
     242    (comparing ()
     243      `(,%lambda () ,xpr))))
    244244((efreeze 3)) ; -> 3
    245245(define-macro (ifreeze xpr)
    246         `(lambda () ,xpr))
     246  `(lambda () ,xpr))
    247247((ifreeze 5)) ; -> 5
    248248(define-macro (alambda args xpr . xprs)
    249         (injecting (self)
    250                 `(letrec ((,self (lambda ,args ,xpr ,@xprs)))
    251                         ,self)))
     249  (injecting (self)
     250    `(letrec ((,self (lambda ,args ,xpr ,@xprs)))
     251      ,self)))
    252252(define ! (alambda (n) (if (zero? n) 1 (* n (self (- n 1))))))
    253253(! 5) ; -> 120
    254254(define-macro (foo pair)
    255         (comparing (? bar?) `(if ,(bar? (car pair)) ,@(cdr pair) 'unchecked)))
     255  (comparing (? bar?) `(if ,(bar? (car pair)) ,@(cdr pair) 'unchecked)))
    256256(foo (bar 'checked)) ; -> 'checked
    257257(foo (baz 'checked)) ; -> 'unchecked)
    258258(define-macro (baz pair)
    259         (renaming (% %if)
    260                 (comparing (? bar?)
    261                         `(,%if ,(bar? (car pair)) ,@(cdr pair) 'unchecked))))
     259  (renaming (% %if)
     260    (comparing (? bar?)
     261      `(,%if ,(bar? (car pair)) ,@(cdr pair) 'unchecked))))
    262262(baz (bar 'checked)) ; -> 'checked
    263263(baz (foo 'checked)) ; -> 'unchecked
     
    267267  ; -> '(y x)
    268268(letrec-macro (((ifreeze xpr) `(lambda () ,xpr))
    269                                                         ((efreeze xpr)
    270                                                                 (renaming (% %lambda)
    271                                                                 `(,%lambda () ,xpr))))
     269              ((efreeze xpr)
     270                (renaming (% %lambda)
     271                `(,%lambda () ,xpr))))
    272272 ((efreeze ((ifreeze 3)))))
    273273 ; -> 3
    274274(let-macro (((ifreeze xpr) `(lambda () ,xpr))
    275                                                 ((efreeze xpr)
    276                                                 (renaming (% %lambda)
    277                                                         `(,%lambda () ,xpr))))
     275            ((efreeze xpr)
     276            (renaming (% %lambda)
     277              `(,%lambda () ,xpr))))
    278278  (list ((efreeze 3)) ((ifreeze 5))))
    279279  ; -> '(3 5)
    280280
     281;; anaphoric if
    281282(define-syntax aif
    282         (macro-rules it ()
    283                 ((_ test consequent . alternative)
    284                  (if (null? alternative)
    285                         `(let ((,it ,test))
    286                                  (if ,it ,consequent))
    287                         `(let ((,it ,test))
    288                                  (if ,it ,consequent ,(car alternative)))))))
     283  (macro-rules it ()
     284    ((_ test consequent)
     285     `(let ((,it ,test))
     286        (if ,it ,consequent)))
     287    ((_ test consequent alternative)
     288      `(let ((,it ,test))
     289         (if ,it ,consequent ,alternative)))))
     290(aif #f it (not it)) ; -> #t
    289291(define (mist x) (aif (! x) it))
    290292(mist 5) ; -> 120
    291293
    292 (define-syntax if-then-
    293         (macro-rules (? then? else?)
    294                 ((_ test then-pair)
    295                  (if (and (pair? then-pair) (then? (car then-pair)))
    296                          `(if ,test
    297                                         (begin ,@(cdr then-pair)))
    298                          `(error 'if-then- "syntax-error")))
    299                 ((_ test then-pair else-pair)
    300                  (if (and (pair? then-pair) (then? (car then-pair))
    301                                                         (pair? else-pair) (else? (car else-pair)))
    302                          `(if ,test
    303                                         (begin ,@(cdr then-pair))
    304                                         (begin ,@(cdr else-pair)))
    305                          `(error 'if-then- "syntax-error")))))
     294;; verbose if
     295(define-syntax vif
     296  (macro-rules (? then? else?)
     297    ((_ test (then xpr . xprs))
     298     `(vif ,test (then ,xpr ,@xprs) (else (void))))
     299    ((_ test (else xpr . xprs))
     300     `(vif ,test (then (void)) (else ,xpr ,@xprs)))
     301    ((_ test consequent alternative)
     302     `(if ,test
     303       (if ,(and (pair? consequent) (then? (car consequent)))
     304       ;(if (and (pair? ',consequent) (,then? ',(car consequent)))
     305         (begin ,@(cdr consequent)))
     306       (if ,(and (pair? alternative) (else? (car alternative)))
     307       ;(if (and (pair? ',alternative) (,else? ',(car alternative)))
     308         (begin ,@(cdr alternative)))))
     309    ))
    306310(define (quux x)
    307         (if-then- (odd? x) (then "odd") (else "even")))
     311  (vif (odd? x) (then "odd") (else "even")))
    308312(quux 3) ; -> "odd"
    309313(quux 4) ; -> "even"
Note: See TracChangeset for help on using the changeset viewer.