forked from LIPS-scheme/lips
-
Notifications
You must be signed in to change notification settings - Fork 0
/
quotation.scm
340 lines (250 loc) · 10.3 KB
/
quotation.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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
(test "quasiquote: it should splice nil"
(lambda (t)
(t.is `(x ,@nil x) '(x x))))
(test "quasiquote: it should splice nil as body in do macro"
(lambda (t)
(define-macro (do vars test . body)
"(do ((<var> <init> <next>)) (test expression) . body)
Iteration macro that evaluate the expression body in scope of the variables.
On Eeach loop it increase the variables according to next expression and run
test to check if the loop should continue. If test is signle call the macro
will not return anything. If the test is pair of expression and value the
macro will return that value after finish."
(let ((return? (eq? (length test) 2)) (loop (gensym)))
`(let ,loop (,@(map (lambda (spec)
`(,(car spec) ,(cadr spec)))
vars))
(if (not ,(car test))
(begin
,@body
(,loop ,@(map (lambda (spec)
(if (null? (cddr spec))
(car spec)
(caddr spec)))
vars)))
,(if return? (cadr test))))))
;; nil as body
(t.is (let ((x '(1 3 5 7 9)))
(do ((x x (cdr x))
(sum 0 (+ sum (car x))))
((null? x) sum))) 25)
;; ignored body
(t.is (let ((x '(1 3 5 7 9)))
(do ((x x (cdr x))
(sum 0 (+ sum (car x))))
((null? x) sum) 10)) 25)))
(test "quasiquote: it should double splice the list"
(lambda (t)
(define expr (let ((x '((list 1 2 3) (list 4 5 6) (list 7 8 9))))
`(list `(,@,@x))))
(t.is expr '(list (quasiquote ((unquote-splicing (list 1 2 3)
(list 4 5 6)
(list 7 8 9))))))
(define result (eval expr (interaction-environment)))
(t.is result '((1 2 3 4 5 6 7 8 9)))))
(test "quasiquote: it should backquote & unquote multiple times"
(lambda (t)
(define result `(```,,,,@(list 1 2)))
(t.is result '((quasiquote (quasiquote (quasiquote (unquote (unquote (unquote 1 2))))))))))
(test "quasiquote: it should quasiquote unquote-splice"
(lambda (t)
(t.is `(1 ```,,@,,@(list (+ 1 2)) 4)
'(1 (quasiquote (quasiquote (quasiquote (unquote (unquote-splicing (unquote 3)))))) 4))
(t.is `(1 `,@(list (+ 1 2)) 4)
'(1 (quasiquote (unquote-splicing (list (+ 1 2)))) 4))))
(test "quasiquote: it should return list"
(lambda (t)
(t.is (eval (let ((x '((list 1 2 3) (list 1 2 3) (list 1 2 3))))
`(list `(,@,(car x)))))
'((1 2 3)))))
(test "quasiquote: single unquote"
(lambda (t)
(define result `(let ((name 'x)) `(let ((name 'y)) `(list ',name))))
(t.is result '(let ((name (quote x)))
(quasiquote (let ((name (quote y)))
(quasiquote (list (quote (unquote name))))))))))
(test "quasiquote: double backquote and unquote on list"
(lambda (t)
(define result (eval (let ((x '((list 1 2 3) (list 4 5 6) (list 7 8 9))))
`(list `(,,@x)))
(interaction-environment)))
(t.is result '(((1 2 3) (4 5 6) (7 8 9))))))
(test "quasiquote: quaisquote quote unquoted"
(lambda (t)
(define (foo) 'bar)
;; `',(foo) came from book "On Lips" by Paul Graham
(t.is `',(foo) '(quote bar))
(let ((x 'foo))
(t.is `',x '(quote foo)))))
(test "quasiquote: unquote simple and double unquote symbol"
(lambda (t)
(define result (let ((y 20))
`(let ((x 10))
`(list ,x ,,y))))
(t.is result '(let ((x 10))
(quasiquote (list (unquote x) (unquote 20)))))))
(test "quasiquote: should join symbol"
(lambda (t)
(define result (let ((x 'foo)) `(a ,@x)))
(t.is result '(a . foo))))
(test "quasiquote: should unquote from double quotation"
(lambda (t)
(define result (let ((x '(1 2)))
`(let ((x '(2 3)))
(begin
`(list ,(car x))
`(list ,,(car x))))))
(t.is result '(let ((x (quote (2 3))))
(begin
(quasiquote (list (unquote (car x))))
(quasiquote (list (unquote 1))))))))
(test "quasiquote: evaluate unquote inside unquote-splice and double quasiquote"
(lambda (t)
(define-macro (bar)
(let ((x 10) (y '(1 2 3)) (z 'foo))
`(list ,x `(,@(list ',y)))))
(t.is (bar) '(10 ((1 2 3))))))
(test "quasiquote: evaluate unquote quote unquote inside double quasiquote"
(lambda (t)
(define-macro (bar)
(let ((x 10) (y '(1 2 3)) (z 'foo))
`(list ,x `(,',z ,,@y))))
(t.is (bar) '(10 (foo 1 2 3)))))
(test "quasiquote: evaluate nested quasiquote and unquote with bare list"
(lambda (t)
(define-macro (bar)
(let ((x 10) (y '(1 2 3)) (z 'foo))
`(list ,x `(,',z `(list ,,,@y)))))
(define (foo x) x)
(t.is (eval (cadr (bar))) '(list 1 2 3))))
(let ((fun (lambda (a b)
(if (number? a)
(+ a b)
(if (string? a)
(string-append a b)))))
(f2 (lambda (a b) (list a b)))
(rand (Math.random)))
(test "quasiquote: create list with function call"
(lambda (t)
(t.is `(1 2 3 ,(fun 2 2) 5) '(1 2 3 4 5))))
(test "quasiquote: create list with value"
(lambda (t)
(t.is `(1 2 3 ,value 4) (list 1 2 3 value 4))))
(test "quasiquote: create single list using uquote-splice"
(lambda (t)
(t.is `(1 2 3 ,@(f2 4 5) 6) '(1 2 3 4 5 6))))
(test "quasiquote: create single pair"
(lambda (t)
(define specs (list
`(1 . 2)
`(,(car (list 1 2 3)) . 2)
`(1 . ,(cadr (list 1 2 3)))
`(,(car (list 1 2 3)) . ,(cadr (list 1 2 3)))))
(define pair '(1 . 2))
(let iter ((specs specs))
(if (not (null? specs))
(begin
(t.is (car specs) pair)
(iter (cdr specs)))))))
(test "quasiquote: create list from pair syntax"
(lambda (t)
(define result `(,(car (list 1 2 3)) . (1 2 3)))
(t.is result (list 1 1 2 3))))
(test "quasiquote: create alist with values"
(lambda (t)
(define result `((1 . ,(car (list 1 2)))
(2 . ,(cadr (list 1 "foo")))))
(t.is result '((1 . 1) (2 . "foo")))
(define result `((,(car (list "foo")) . ,(car (list 1 2)))
(2 . ,(cadr (list 1 "foo")))))
(t.is result '(("foo" . 1) (2 . "foo")))))
(test "quasiquote: process nested backquote"
(lambda (t)
(define result `(1 2 3 ,(cadr `(1 ,(concat "foo" "bar") 3)) 4))
(t.is result '(1 2 3 "foobar" 4))))
(test "quasiquote: should process multiple backquote/unquote"
(lambda (t)
(define result ``(a ,,(+ 1 2) ,(+ 3 4)))
(t.is result '(quasiquote (a (unquote 3) (unquote (+ 3 4))))))))
(test "quasiquote: should ignore splice on empty list"
(lambda (t)
(define result `(list ,@(list)))
(t.is result '(list))))
(test "quote: should return literal list"
(lambda (t)
(t.is '(1 2 3 (4 5)) (list 1 2 3 (list 4 5)))))
(test "quote: should return alist"
(lambda (t)
(t.is '((foo . 1)
(bar . 2.1)
(baz . "string")
(quux . #/foo./g))
(list (cons 'foo 1)
(cons 'bar 2.1)
(cons 'baz "string")
(cons 'quux #/foo./g)))))
(test "quote: should return literal atoms"
(lambda (t)
(t.is (list '#f
'#t
'10
'10+10i
'#x10
'#x#i10
'#e#x10
'#e#o7
'#\x
'#\newline)
(list #f
#t
10
10+10i
#x10
#x#i10
#e#x10
#e#o7
#\x
#\newline))))
(test "quote: should be constant"
(lambda (t)
(define (foo)
'(1 2))
(t.is (eq? (foo) (foo)) true)))
(test "quasiquote: should be constant"
(lambda (t)
(define (foo)
`(1 2))
(t.is (eq? (foo) (foo)) true)))
(test "quasiquote: should create new pair"
(lambda (t)
(define (foo x)
`(1 2 ,@x))
(t.is (eq? (foo '(1)) (foo '(2))) false)
(define (foo x)
`(1 2 ,x))
(t.is (eq? (foo 10) (foo 20)) false)))
(test "quasiquote: should crete vector literal"
(lambda (t)
(t.is `#(,(+ 1 2) ,(+ 2 3) ,(Promise.resolve 7))
#(3 5 7))))
(test "quasiquote: should crete object literal"
(lambda (t)
(t.is `&(:foo ,(+ 1 2) :bar ,(Promise.resolve 10))
&(:foo 3 :bar 10))))
(test "quasiquote: should create vector inside list"
(lambda (t)
(t.is `(foo #(10 ,@(list 1 2 3)))
'(foo #(10 1 2 3)))))
(test "quasiquote: should create object inside list"
(lambda (t)
(t.is `(foo &(:foo ,(+ 1 2) :bar 10))
(list 'foo &(:foo 3 :bar 10)))))
(test "quasiquote: should create list from improper list"
(lambda (t)
(t.is (let ((x '(1 2 3)))
`(foo . ,x))
'(foo 1 2 3))))
(test "quasiquote: should create list with unquote-splicing and improper list"
(lambda (t)
(let ((result `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))))
(t.is result '((foo 7) . cons)))))