Changeset 29967 in project
 Timestamp:
 10/27/13 11:52:25 (8 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

wiki/eggref/4/listbindings
r29966 r29967 181 181 (bind (x y z w) '(1 2 3 4) (list x y z w)) ; > '(1 2 3 4) 182 182 (bind (x (y (z . u) . v) . w) 183 184 183 '(1 (2 (3 4) 5) 6) 184 (list x y z u v w)) ; > '(1 2 3 (4) (5) (6)) 185 185 ((bindlambda (a (b . c) . d) (list a b c d)) 186 186 '(1 (20 30 40) 2 3)) ; > '(1 20 (30 40) (2 3)) … … 192 192 ; > '(1 2 3 (4 4)) 193 193 (bindcase '(1 (2 3)) 194 195 196 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) 197 197 (bindcase '(1 (2 3)) 198 199 200 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))) 201 201 (bindcase '(1 (2 3)) 202 203 204 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)) 205 205 (bindcase '(1 (2 . 3)) 206 207 208 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)) 209 209 ((bindcaselambda 210 211 210 ((a (b . c) . d) (list a b c d)) 211 ((e . f) (list e f))) 212 212 '(1 2 3 4 5)) ; > '(1 (2 3 4 5)) 213 213 (letrec ( 214 215 216 217 218 219 220 214 (mymap 215 (lambda (fn lst) 216 (bindcase lst 217 (() '()) 218 ((x . xs) (cons (fn x) (map fn xs)))))) 219 ) 220 (mymap add1 '(1 2 3))) ; > '(2 3 4) 221 221 ((bindable? (a b)) '(1 2)) ; > #t 222 222 ((bindable? (a . b)) '(1)) ; > #t … … 239 239 240 240 (defineermacro (efreeze xpr) 241 242 243 241 (renaming (% %lambda) 242 (comparing () 243 `(,%lambda () ,xpr)))) 244 244 ((efreeze 3)) ; > 3 245 245 (definemacro (ifreeze xpr) 246 246 `(lambda () ,xpr)) 247 247 ((ifreeze 5)) ; > 5 248 248 (definemacro (alambda args xpr . xprs) 249 250 251 249 (injecting (self) 250 `(letrec ((,self (lambda ,args ,xpr ,@xprs))) 251 ,self))) 252 252 (define ! (alambda (n) (if (zero? n) 1 (* n (self ( n 1)))))) 253 253 (! 5) ; > 120 254 254 (definemacro (foo pair) 255 255 (comparing (? bar?) `(if ,(bar? (car pair)) ,@(cdr pair) 'unchecked))) 256 256 (foo (bar 'checked)) ; > 'checked 257 257 (foo (baz 'checked)) ; > 'unchecked) 258 258 (definemacro (baz pair) 259 260 261 259 (renaming (% %if) 260 (comparing (? bar?) 261 `(,%if ,(bar? (car pair)) ,@(cdr pair) 'unchecked)))) 262 262 (baz (bar 'checked)) ; > 'checked 263 263 (baz (foo 'checked)) ; > 'unchecked … … 267 267 ; > '(y x) 268 268 (letrecmacro (((ifreeze xpr) `(lambda () ,xpr)) 269 270 271 269 ((efreeze xpr) 270 (renaming (% %lambda) 271 `(,%lambda () ,xpr)))) 272 272 ((efreeze ((ifreeze 3))))) 273 273 ; > 3 274 274 (letmacro (((ifreeze xpr) `(lambda () ,xpr)) 275 276 277 275 ((efreeze xpr) 276 (renaming (% %lambda) 277 `(,%lambda () ,xpr)))) 278 278 (list ((efreeze 3)) ((ifreeze 5)))) 279 279 ; > '(3 5) 280 280 281 ;; anaphoric if 281 282 (definesyntax aif 282 (macrorules 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 (macrorules 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 289 291 (define (mist x) (aif (! x) it)) 290 292 (mist 5) ; > 120 291 293 292 (definesyntax ifthen 293 (macrorules (? then? else?) 294 ((_ test thenpair) 295 (if (and (pair? thenpair) (then? (car thenpair))) 296 `(if ,test 297 (begin ,@(cdr thenpair))) 298 `(error 'ifthen "syntaxerror"))) 299 ((_ test thenpair elsepair) 300 (if (and (pair? thenpair) (then? (car thenpair)) 301 (pair? elsepair) (else? (car elsepair))) 302 `(if ,test 303 (begin ,@(cdr thenpair)) 304 (begin ,@(cdr elsepair))) 305 `(error 'ifthen "syntaxerror"))))) 294 ;; verbose if 295 (definesyntax vif 296 (macrorules (? 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 )) 306 310 (define (quux x) 307 (ifthen(odd? x) (then "odd") (else "even")))311 (vif (odd? x) (then "odd") (else "even"))) 308 312 (quux 3) ; > "odd" 309 313 (quux 4) ; > "even"
Note: See TracChangeset
for help on using the changeset viewer.