-
Notifications
You must be signed in to change notification settings - Fork 0
/
while-do-when-unless.scm
127 lines (91 loc) · 2.46 KB
/
while-do-when-unless.scm
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
;; warning: 'do is already part of R6RS (reserved keyword) 'while is not in R5RS,R6RS, R7RS-small
;; but 'do in Scheme has a painful syntax
;; syntax defined in this file are inspired from Pascal language
;; scheme@(guile-user)> (use-modules (Scheme+))
;; scheme@(guile-user)> (define i 0)
;; scheme@(guile-user)> (define do '())
;; scheme@(guile-user)> (while {i < 4}
;; do
;; (display i)
;; (newline)
;; {i <- {i + 1}})
;; 0
;; 1
;; 2
;; 3
;; $1 = #f
;; (while {i < 4}
;; do
;; (display i)
;; (newline)
;; {i <- {i + 1}})
;; (define-syntax while
;; (syntax-rules (while do)
;; ((_ pred do b1 ...)
;; (let loop () (when pred b1 ... (loop))))))
;; (do ((i 1 (1+ i))
;; (p 3 (* 3 p)))
;; ((> i 4)
;; p)
;; (format #t "3**~s is ~s\n" i p))
;; 3**1 is 3
;; 3**2 is 9
;; 3**3 is 27
;; 3**4 is 81
;; $1 = 243
;; scheme@(guile-user)> (do ((i 1 (1+ i))
;; (p 3 (* 3 p)))
;; ((> i 4)
;; p)
;; (set! p (+ p i)))
;; $1 = 417
;; with a definition inside only the new version works:
;; (do ((i 1 (1+ i))
;; (p 3 (* 3 p)))
;; ((> i 4)
;; p)
;; (define x 7)
;; (set! p (+ p i x)))
;; $3 = 1257
;; 'do is redefined here only to allow 'define in body as allowed in Scheme+
(define-syntax do
(syntax-rules ()
((do ((var init step ...) ...)
(test expr ...)
command ...)
(letrec
((loop
(lambda (var ...)
(if test
;;(begin
(let ()
;;#f ; avoid empty begin but with (let () i don't care !
expr ...)
;;(begin
(let ()
command
...
(loop (do "step" var step ...)
...))))))
(loop init ...)))
((do "step" x)
x)
((do "step" x y)
y)))
;; definitions redefined here only to allow 'define in body as allowed in Scheme+
(define-syntax when
(syntax-rules ()
;;((when test result1 result2 ...)
((when test result1 ...)
(if test
;;(begin result1 result2 ...)))))
;;(let () result1 result2 ...)))))
(let () result1 ...)))))
(define-syntax unless
(syntax-rules ()
;;((unless test result1 result2 ...)
((unless test result1 ...)
(if (not test)
;;(begin result1 result2 ...)))))
;;(let () result1 result2 ...)))))
(let () result1 ...)))))