r7rs-small-texinfo

R7RS-small Scheme converted to Texinfo.
git clone https://kaka.farm/~git/r7rs-small-texinfo
Log | Files | Refs | README | LICENSE

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