derived-expressions-implementation.texinfo (16499B)
1 @node Derived expression types formal 2 @section Derived expression types 3 4 This section gives syntax definitions for the derived expression 5 types in terms of the primitive expression types (literal, variable, 6 call, @code{lambda}, @code{if}, and @code{set!}), except for 7 @code{quasiquote}. 8 9 Conditional derived syntax types: 10 11 @lisp 12 (define-syntax cond 13 (syntax-rules (else =>) 14 ((cond (else result1 result2 ...)) 15 (begin result1 result2 ...)) 16 ((cond (test => result)) 17 (let ((temp test)) 18 (if temp (result temp)))) 19 ((cond (test => result) clause1 clause2 ...) 20 (let ((temp test)) 21 (if temp 22 (result temp) 23 (cond clause1 clause2 ...)))) 24 ((cond (test)) test) 25 ((cond (test) clause1 clause2 ...) 26 (let ((temp test)) 27 (if temp 28 temp 29 (cond clause1 clause2 ...)))) 30 ((cond (test result1 result2 ...)) 31 (if test (begin result1 result2 ...))) 32 ((cond (test result1 result2 ...) 33 clause1 clause2 ...) 34 (if test 35 (begin result1 result2 ...) 36 (cond clause1 clause2 ...))))) 37 38 (define-syntax case 39 (syntax-rules (else =>) 40 ((case (key ...) 41 clauses ...) 42 (let ((atom-key (key ...))) 43 (case atom-key clauses ...))) 44 ((case key 45 (else => result)) 46 (result key)) 47 ((case key 48 (else result1 result2 ...)) 49 (begin result1 result2 ...)) 50 ((case key 51 ((atoms ...) => result)) 52 (if (memv key '(atoms ...)) 53 (result key))) 54 ((case key 55 ((atoms ...) result1 result2 ...)) 56 (if (memv key '(atoms ...)) 57 (begin result1 result2 ...))) 58 ((case key 59 ((atoms ...) => result) 60 clause clauses ...) 61 (if (memv key '(atoms ...)) 62 (result key) 63 (case key clause clauses ...))) 64 ((case key 65 ((atoms ...) result1 result2 ...) 66 clause clauses ...) 67 (if (memv key '(atoms ...)) 68 (begin result1 result2 ...) 69 (case key clause clauses ...))))) 70 71 (define-syntax and 72 (syntax-rules () 73 ((and) #t) 74 ((and test) test) 75 ((and test1 test2 ...) 76 (if test1 (and test2 ...) #f)))) 77 78 (define-syntax or 79 (syntax-rules () 80 ((or) #f) 81 ((or test) test) 82 ((or test1 test2 ...) 83 (let ((x test1)) 84 (if x x (or test2 ...)))))) 85 86 (define-syntax when 87 (syntax-rules () 88 ((when test result1 result2 ...) 89 (if test 90 (begin result1 result2 ...))))) 91 92 (define-syntax unless 93 (syntax-rules () 94 ((unless test result1 result2 ...) 95 (if (not test) 96 (begin result1 result2 ...))))) 97 @end lisp 98 99 Binding constructs: 100 101 @lisp 102 (define-syntax let 103 (syntax-rules () 104 ((let ((name val) ...) body1 body2 ...) 105 ((lambda (name ...) body1 body2 ...) 106 val ...)) 107 ((let tag ((name val) ...) body1 body2 ...) 108 ((letrec ((tag (lambda (name ...) 109 body1 body2 ...))) 110 tag) 111 val ...)))) 112 113 (define-syntax let* 114 (syntax-rules () 115 ((let* () body1 body2 ...) 116 (let () body1 body2 ...)) 117 ((let* ((name1 val1) (name2 val2) ...) 118 body1 body2 ...) 119 (let ((name1 val1)) 120 (let* ((name2 val2) ...) 121 body1 body2 ...))))) 122 @end lisp 123 124 The following @code{letrec} macro uses the symbol @code{<undefined>} 125 in place of an expression which returns something that when stored in 126 a location makes it an error to try to obtain the value stored in the 127 location. (No such expression is defined in Scheme.) A trick is used 128 to generate the temporary names needed to avoid specifying the order 129 in which the values are evaluated. This could also be accomplished 130 by using an auxiliary macro. 131 132 @lisp 133 (define-syntax letrec 134 (syntax-rules () 135 ((letrec ((var1 init1) ...) body ...) 136 (letrec "generate_temp_names" 137 (var1 ...) 138 () 139 ((var1 init1) ...) 140 body ...)) 141 ((letrec "generate_temp_names" 142 () 143 (temp1 ...) 144 ((var1 init1) ...) 145 body ...) 146 (let ((var1 <undefined>) ...) 147 (let ((temp1 init1) ...) 148 (set! var1 temp1) 149 ... 150 body ...))) 151 ((letrec "generate_temp_names" 152 (x y ...) 153 (temp ...) 154 ((var1 init1) ...) 155 body ...) 156 (letrec "generate_temp_names" 157 (y ...) 158 (newtemp temp ...) 159 ((var1 init1) ...) 160 body ...)))) 161 162 (define-syntax letrec* 163 (syntax-rules () 164 ((letrec* ((var1 init1) ...) body1 body2 ...) 165 (let ((var1 <undefined>) ...) 166 (set! var1 init1) 167 ... 168 (let () body1 body2 ...))))) 169 170 (define-syntax let-values 171 (syntax-rules () 172 ((let-values (binding ...) body0 body1 ...) 173 (let-values "bind" 174 (binding ...) () (begin body0 body1 ...))) 175 176 ((let-values "bind" () tmps body) 177 (let tmps body)) 178 179 ((let-values "bind" ((b0 e0) 180 binding ...) tmps body) 181 (let-values "mktmp" b0 e0 () 182 (binding ...) tmps body)) 183 184 ((let-values "mktmp" () e0 args 185 bindings tmps body) 186 (call-with-values 187 (lambda () e0) 188 (lambda args 189 (let-values "bind" 190 bindings tmps body)))) 191 192 ((let-values "mktmp" (a . b) e0 (arg ...) 193 bindings (tmp ...) body) 194 (let-values "mktmp" b e0 (arg ... x) 195 bindings (tmp ... (a x)) body)) 196 197 ((let-values "mktmp" a e0 (arg ...) 198 bindings (tmp ...) body) 199 (call-with-values 200 (lambda () e0) 201 (lambda (arg ... . x) 202 (let-values "bind" 203 bindings (tmp ... (a x)) body)))))) 204 205 (define-syntax let*-values 206 (syntax-rules () 207 ((let*-values () body0 body1 ...) 208 (let () body0 body1 ...)) 209 210 ((let*-values (binding0 binding1 ...) 211 body0 body1 ...) 212 (let-values (binding0) 213 (let*-values (binding1 ...) 214 body0 body1 ...))))) 215 216 (define-syntax define-values 217 (syntax-rules () 218 ((define-values () expr) 219 (define dummy 220 (call-with-values (lambda () expr) 221 (lambda args #f)))) 222 ((define-values (var) expr) 223 (define var expr)) 224 ((define-values (var0 var1 ... varn) expr) 225 (begin 226 (define var0 227 (call-with-values (lambda () expr) 228 list)) 229 (define var1 230 (let ((v (cadr var0))) 231 (set-cdr! var0 (cddr var0)) 232 v)) ... 233 (define varn 234 (let ((v (cadr var0))) 235 (set! var0 (car var0)) 236 v)))) 237 ((define-values (var0 var1 ... . varn) expr) 238 (begin 239 (define var0 240 (call-with-values (lambda () expr) 241 list)) 242 (define var1 243 (let ((v (cadr var0))) 244 (set-cdr! var0 (cddr var0)) 245 v)) ... 246 (define varn 247 (let ((v (cdr var0))) 248 (set! var0 (car var0)) 249 v)))) 250 ((define-values var expr) 251 (define var 252 (call-with-values (lambda () expr) 253 list))))) 254 255 (define-syntax begin 256 (syntax-rules () 257 ((begin exp ...) 258 ((lambda () exp ...))))) 259 @end lisp 260 261 The following alternative expansion for @code{begin} does not make 262 use of the ability to write more than one expression in the body of 263 a lambda expression. In any case, note that these rules apply only 264 if the body of the @code{begin} contains no definitions. 265 266 @lisp 267 (define-syntax begin 268 (syntax-rules () 269 ((begin exp) 270 exp) 271 ((begin exp1 exp2 ...) 272 (call-with-values 273 (lambda () exp1) 274 (lambda args 275 (begin exp2 ...)))))) 276 @end lisp 277 278 The following syntax definition of do uses a trick to expand the 279 variable clauses. As with @code{letrec} above, an auxiliary macro 280 would also work. The expression @code{(if #f #f)} is used to obtain 281 an unspecific value. 282 283 @lisp 284 (define-syntax do 285 (syntax-rules () 286 ((do ((var init step ...) ...) 287 (test expr ...) 288 command ...) 289 (letrec 290 ((loop 291 (lambda (var ...) 292 (if test 293 (begin 294 (if #f #f) 295 expr ...) 296 (begin 297 command 298 ... 299 (loop (do "step" var step ...) 300 ...)))))) 301 (loop init ...))) 302 ((do "step" x) 303 x) 304 ((do "step" x y) 305 y))) 306 @end lisp 307 308 309 Here is a possible implementation of @code{delay}, @code{force} and 310 @code{delay-force}. We define the expression 311 312 @lisp 313 (delay-force @svar{expression}) 314 @end lisp 315 316 to have the same meaning as the procedure call 317 318 @lisp 319 (make-promise #f (lambda () @svar{expression})) 320 @end lisp 321 322 as follows 323 324 @lisp 325 (define-syntax delay-force 326 (syntax-rules () 327 ((delay-force expression) 328 (make-promise #f (lambda () expression))))) 329 @end lisp 330 331 and we define the expression 332 333 @lisp 334 (delay @svar{expression}) 335 @end lisp 336 337 to have the same meaning as: 338 339 @lisp 340 (delay-force (make-promise #t @svar{expression})) 341 @end lisp 342 343 as follows 344 345 @lisp 346 (define-syntax delay 347 (syntax-rules () 348 ((delay expression) 349 (delay-force (make-promise #t expression))))) 350 @end lisp 351 352 where @code{make-promise} is defined as follows: 353 354 @lisp 355 (define make-promise 356 (lambda (done? proc) 357 (list (cons done? proc)))) 358 @end lisp 359 360 Finally, we define @code{force} to call the procedure expressions 361 in promises iteratively using a trampoline technique following SRFI 362 45 [@ref{srfi45}] until a non-lazy result (i.e.@: a value created by @code{delay} 363 instead of @code{delay-force}) is returned, as follows: 364 365 @lisp 366 (define (force promise) 367 (if (promise-done? promise) 368 (promise-value promise) 369 (let ((promise* ((promise-value promise)))) 370 (unless (promise-done? promise) 371 (promise-update! promise* promise)) 372 (force promise)))) 373 @end lisp 374 375 with the following promise accessors: 376 377 @lisp 378 (define promise-done? 379 (lambda (x) (car (car x)))) 380 (define promise-value 381 (lambda (x) (cdr (car x)))) 382 (define promise-update! 383 (lambda (new old) 384 (set-car! (car old) (promise-done? new)) 385 (set-cdr! (car old) (promise-value new)) 386 (set-car! new (car old)))) 387 @end lisp 388 389 The following implementation of @code{make-parameter} and 390 @code{parameterize} is suitable for an implementation with no 391 threads. Parameter objects are implemented here as procedures, 392 using two arbitrary unique objects @svar{param-set!} and 393 @svar{param-convert}: 394 395 @lisp 396 (define (make-parameter init . o) 397 (let* ((converter 398 (if (pair? o) (car o) (lambda (x) x))) 399 (value (converter init))) 400 (lambda args 401 (cond 402 ((null? args) 403 value) 404 ((eq? (car args) @svar{param-set!}) 405 (set! value (cadr args))) 406 ((eq? (car args) @svar{param-convert}) 407 converter) 408 (else 409 (error "bad parameter syntax")))))) 410 @end lisp 411 412 Then @code{parameterize} uses @code{dynamic-wind} to 413 dynamically rebind the associated value: 414 415 @lisp 416 (define-syntax parameterize 417 (syntax-rules () 418 ((parameterize ("step") 419 ((param value p old new) ...) 420 () 421 body) 422 (let ((p param) ...) 423 (let ((old (p)) ... 424 (new ((p @svar{param-convert}) value)) ...) 425 (dynamic-wind 426 (lambda () (p @svar{param-set!} new) ...) 427 (lambda () . body) 428 (lambda () (p @svar{param-set!} old) ...))))) 429 ((parameterize ("step") 430 args 431 ((param value) . rest) 432 body) 433 (parameterize ("step") 434 ((param value p old new) . args) 435 rest 436 body)) 437 ((parameterize ((param value) ...) . body) 438 (parameterize ("step") 439 () 440 ((param value) ...) 441 body)))) 442 @end lisp 443 444 The following implementation of @code{guard} depends on an auxiliary 445 macro, here called @code{guard-aux}. 446 447 @lisp 448 (define-syntax guard 449 (syntax-rules () 450 ((guard (var clause ...) e1 e2 ...) 451 ((call/cc 452 (lambda (guard-k) 453 (with-exception-handler 454 (lambda (condition) 455 ((call/cc 456 (lambda (handler-k) 457 (guard-k 458 (lambda () 459 (let ((var condition)) 460 (guard-aux 461 (handler-k 462 (lambda () 463 (raise-continuable condition))) 464 clause ...)))))))) 465 (lambda () 466 (call-with-values 467 (lambda () e1 e2 ...) 468 (lambda args 469 (guard-k 470 (lambda () 471 (apply values args))))))))))))) 472 473 (define-syntax guard-aux 474 (syntax-rules (else =>) 475 ((guard-aux reraise (else result1 result2 ...)) 476 (begin result1 result2 ...)) 477 ((guard-aux reraise (test => result)) 478 (let ((temp test)) 479 (if temp 480 (result temp) 481 reraise))) 482 ((guard-aux reraise (test => result) 483 clause1 clause2 ...) 484 (let ((temp test)) 485 (if temp 486 (result temp) 487 (guard-aux reraise clause1 clause2 ...)))) 488 ((guard-aux reraise (test)) 489 (or test reraise)) 490 ((guard-aux reraise (test) clause1 clause2 ...) 491 (let ((temp test)) 492 (if temp 493 temp 494 (guard-aux reraise clause1 clause2 ...)))) 495 ((guard-aux reraise (test result1 result2 ...)) 496 (if test 497 (begin result1 result2 ...) 498 reraise)) 499 ((guard-aux reraise 500 (test result1 result2 ...) 501 clause1 clause2 ...) 502 (if test 503 (begin result1 result2 ...) 504 (guard-aux reraise clause1 clause2 ...))))) 505 506 (define-syntax case-lambda 507 (syntax-rules () 508 ((case-lambda (params body0 ...) ...) 509 (lambda args 510 (let ((len (length args))) 511 (letrec-syntax 512 ((cl (syntax-rules ::: () 513 ((cl) 514 (error "no matching clause")) 515 ((cl ((p :::) . body) . rest) 516 (if (= len (length '(p :::))) 517 (apply (lambda (p :::) 518 . body) 519 args) 520 (cl . rest))) 521 ((cl ((p ::: . tail) . body) 522 . rest) 523 (if (>= len (length '(p :::))) 524 (apply 525 (lambda (p ::: . tail) 526 . body) 527 args) 528 (cl . rest)))))) 529 (cl (params body0 ...) ...))))))) 530 @end lisp 531 532 This definition of @code{cond-expand} does not interact with the 533 @code{features} procedure. It requires that each feature identifier 534 provided by the implementation be explicitly mentioned. 535 536 @lisp 537 (define-syntax cond-expand 538 ;; Extend this to mention all feature ids and libraries 539 (syntax-rules (and or not else r7rs library scheme base) 540 ((cond-expand) 541 (syntax-error "Unfulfilled cond-expand")) 542 ((cond-expand (else body ...)) 543 (begin body ...)) 544 ((cond-expand ((and) body ...) more-clauses ...) 545 (begin body ...)) 546 ((cond-expand ((and req1 req2 ...) body ...) 547 more-clauses ...) 548 (cond-expand 549 (req1 550 (cond-expand 551 ((and req2 ...) body ...) 552 more-clauses ...)) 553 more-clauses ...)) 554 ((cond-expand ((or) body ...) more-clauses ...) 555 (cond-expand more-clauses ...)) 556 ((cond-expand ((or req1 req2 ...) body ...) 557 more-clauses ...) 558 (cond-expand 559 (req1 560 (begin body ...)) 561 (else 562 (cond-expand 563 ((or req2 ...) body ...) 564 more-clauses ...)))) 565 ((cond-expand ((not req) body ...) 566 more-clauses ...) 567 (cond-expand 568 (req 569 (cond-expand more-clauses ...)) 570 (else body ...))) 571 ((cond-expand (r7rs body ...) 572 more-clauses ...) 573 (begin body ...)) 574 ;; Add clauses here for each 575 ;; supported feature identifier. 576 ;; Samples: 577 ;; ((cond-expand (exact-closed body ...) 578 ;; more-clauses ...) 579 ;; (begin body ...)) 580 ;; ((cond-expand (ieee-float body ...) 581 ;; more-clauses ...) 582 ;; (begin body ...)) 583 ((cond-expand ((library (scheme base)) 584 body ...) 585 more-clauses ...) 586 (begin body ...)) 587 ;; Add clauses here for each library 588 ((cond-expand (feature-id body ...) 589 more-clauses ...) 590 (cond-expand more-clauses ...)) 591 ((cond-expand ((library (name ...)) 592 body ...) 593 more-clauses ...) 594 (cond-expand more-clauses ...)))) 595 @end lisp