1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees
; A version of LET and LET* which allows clauses that return multiple values.
;
; MV = multiple-value
;
; (mvlet (<clause> ...) <body>)
; (mvlet* (<clause> ...) <body>)
;
; <clause> ::= (<ids> <expression>)
; <ids> ::= <id> | (<id> ...) | (<id> ... . <id>)
;
; A clause of the form (<id> <exp>) is like a normal LET clause. There is no
; clause equivalent to
; (call-with-values (lambda () <expression>)
; (lambda <id> <body>))
(define-syntax mvlet
(syntax-rules ()
((mvlet () body ...)
(let () body ...))
((mvlet (clause ...) body ...)
(mvlet-helper (clause ...) () (body ...)))))
(define-syntax mvlet-helper
(syntax-rules ()
((mvlet-helper () clauses (body ...))
(let clauses body ...))
((mvlet-helper (((var . more-vars) val) more ...) clauses body)
(copy-vars (var . more-vars) () val (more ...) clauses body))
((mvlet-helper ((var val) more ...) clauses body)
(mvlet-helper (more ...) ((var val) . clauses) body))))
(define-syntax copy-vars
(syntax-rules ()
((copy-vars (var . more-vars) (copies ...)
val more clauses body)
(copy-vars more-vars (copies ... x)
val more ((var x) . clauses) body))
((copy-vars () copies val more clauses body)
(call-with-values
(lambda () val)
(lambda copies
(mvlet-helper more clauses body))))
((copy-vars last (copies ...) val more clauses body)
(call-with-values
(lambda () val)
(lambda (copies ... . lastx)
(mvlet-helper more ((last lastx) . clauses) body))))))
(define-syntax mvlet*
(syntax-rules ()
((mvlet* () body ...)
(let () body ...))
((mvlet* (((vars ...) val) clause ...) body ...)
(call-with-values
(lambda () val)
(lambda (vars ...)
(mvlet* (clause ...) body ...))))
((mvlet* ((var val) clause ...) body ...)
(let ((var val)) (mvlet* (clause ...) body ...)))))
|
