heist 0.1.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (53) hide show
  1. data/History.txt +21 -0
  2. data/Manifest.txt +53 -0
  3. data/README.txt +274 -0
  4. data/Rakefile +12 -0
  5. data/bin/heist +16 -0
  6. data/lib/bin_spec.rb +25 -0
  7. data/lib/builtin/library.scm +95 -0
  8. data/lib/builtin/primitives.rb +306 -0
  9. data/lib/builtin/syntax.rb +166 -0
  10. data/lib/builtin/syntax.scm +155 -0
  11. data/lib/heist.rb +47 -0
  12. data/lib/parser/nodes.rb +105 -0
  13. data/lib/parser/scheme.rb +1081 -0
  14. data/lib/parser/scheme.tt +80 -0
  15. data/lib/repl.rb +112 -0
  16. data/lib/runtime/binding.rb +31 -0
  17. data/lib/runtime/callable/continuation.rb +24 -0
  18. data/lib/runtime/callable/function.rb +55 -0
  19. data/lib/runtime/callable/macro.rb +170 -0
  20. data/lib/runtime/callable/macro/expansion.rb +15 -0
  21. data/lib/runtime/callable/macro/matches.rb +77 -0
  22. data/lib/runtime/callable/macro/splice.rb +56 -0
  23. data/lib/runtime/data/expression.rb +23 -0
  24. data/lib/runtime/data/identifier.rb +20 -0
  25. data/lib/runtime/data/list.rb +36 -0
  26. data/lib/runtime/frame.rb +118 -0
  27. data/lib/runtime/runtime.rb +61 -0
  28. data/lib/runtime/scope.rb +121 -0
  29. data/lib/runtime/stack.rb +60 -0
  30. data/lib/runtime/stackless.rb +49 -0
  31. data/lib/stdlib/benchmark.scm +12 -0
  32. data/lib/stdlib/birdhouse.scm +82 -0
  33. data/test/arithmetic.scm +57 -0
  34. data/test/benchmarks.scm +27 -0
  35. data/test/booleans.scm +6 -0
  36. data/test/closures.scm +16 -0
  37. data/test/conditionals.scm +55 -0
  38. data/test/continuations.scm +144 -0
  39. data/test/define_functions.scm +27 -0
  40. data/test/define_values.scm +28 -0
  41. data/test/delay.scm +8 -0
  42. data/test/file_loading.scm +9 -0
  43. data/test/hygienic.scm +39 -0
  44. data/test/let.scm +42 -0
  45. data/test/lib.scm +2 -0
  46. data/test/macro-helpers.scm +19 -0
  47. data/test/macros.scm +343 -0
  48. data/test/numbers.scm +19 -0
  49. data/test/plt-macros.txt +40 -0
  50. data/test/test_heist.rb +84 -0
  51. data/test/unhygienic.scm +11 -0
  52. data/test/vars.scm +2 -0
  53. metadata +138 -0
@@ -0,0 +1,27 @@
1
+ (define (square x) (* x x))
2
+ (assert-equal 441 (square 21))
3
+ (assert-equal 49 (square (+ 2 5)))
4
+ (assert-equal 81 (square (square 3)))
5
+
6
+ (define (sum-of-squares x y)
7
+ (+ (square x) (square y)))
8
+ (assert-equal 25 (sum-of-squares 3 4))
9
+
10
+ (define (f a)
11
+ (sum-of-squares (+ a 1) (* a 2)))
12
+ (assert-equal 136 (f 5))
13
+
14
+ (assert-equal (f 5)
15
+ ((lambda (a)
16
+ ((lambda (x y)
17
+ (+ (square x) (square y)))
18
+ (+ a 1) (* a 2)))
19
+ 5))
20
+
21
+ (define (1+ x)
22
+ (+ 1 x))
23
+
24
+ (assert-equal 3 (1+ 2))
25
+
26
+ (assert-raise SyntaxError (2 2))
27
+
@@ -0,0 +1,28 @@
1
+ (define size 2)
2
+ (assert-equal 2 size)
3
+
4
+ (define pi 3.14159)
5
+ (define radius 10)
6
+ (assert-equal 314.159 (* pi (* radius radius)))
7
+
8
+ (assert-equal PI pi)
9
+ (assert-equal Pi pI)
10
+
11
+ (define circumference (* 2 pi radius))
12
+ (assert-equal 62.8318 circumference)
13
+
14
+ (let* ([x 6]
15
+ [y 7]
16
+ [pi 12])
17
+ (set! size 4)
18
+ (set! pi 3))
19
+
20
+ (assert-equal 4 size)
21
+ (assert-equal 3.14159 pi)
22
+
23
+ (assert-raise UndefinedVariable (set! undef-var 10))
24
+ (assert-raise UndefinedVariable (no-fun 13))
25
+
26
+ (define 3k 9)
27
+ (assert-equal 9 3k)
28
+
@@ -0,0 +1,8 @@
1
+ (define k 1)
2
+ (define p (delay (set! k (+ k 1))))
3
+ (assert-equal 1 k)
4
+ (force p)
5
+ (assert-equal 2 k)
6
+ (force p)
7
+ (assert-equal 2 k)
8
+
@@ -0,0 +1,9 @@
1
+ (define (my-loader)
2
+ (cond ((> 5 2) (load "lib"))))
3
+
4
+ (my-loader)
5
+ (assert-equal 42 secret-rule-you-didnt-know)
6
+
7
+ (load "vars")
8
+ (assert-equal 1/137 alpha)
9
+
@@ -0,0 +1,39 @@
1
+ (load "macro-helpers")
2
+
3
+ (assert-equal 100 (let ([first 9])
4
+ (square-sum 1 first)))
5
+
6
+ (assert-equal 'outer
7
+ (let ((x 'outer))
8
+ (let-syntax ((m (syntax-rules () [(m) x])))
9
+ (let ((x 'inner))
10
+ (m)))))
11
+
12
+ (assert-equal 'now
13
+ (let ((if #t))
14
+ (when if (set! if 'now))
15
+ if))
16
+
17
+ (let ([temp 5]
18
+ [other 6])
19
+ (swap temp other)
20
+ (assert-equal 6 temp)
21
+ (assert-equal 5 other))
22
+
23
+ (let ([set! 5]
24
+ [other 6])
25
+ (swap set! other)
26
+ (assert-equal 6 set!)
27
+ (assert-equal 5 other))
28
+
29
+ (define plus +)
30
+ (define-syntax dyn-plus (syntax-rules ()
31
+ [(_ x y)
32
+ (plus x y)]))
33
+ (define (dyn-plus-call)
34
+ (dyn-plus 7 8))
35
+
36
+ (assert-equal 15 (dyn-plus-call))
37
+ (set! plus -)
38
+ (assert-equal -1 (dyn-plus-call))
39
+
@@ -0,0 +1,42 @@
1
+ (define (let-test)
2
+ (define x 4)
3
+ (let ([x 3]
4
+ [y (lambda () x)] ; 4
5
+ [z 5])
6
+ (+ x (y) z)))
7
+
8
+ (assert-equal 12 (let-test))
9
+
10
+
11
+ (define (let*-test)
12
+ (define y 50)
13
+ (let* ([x (lambda () y)] ; 50
14
+ [y 4]
15
+ [z (lambda () y)]) ; 4
16
+ (define y 7) ; Make sure (z) is correctly scoped
17
+ (+ (x) y (z))))
18
+
19
+ (assert-equal 61 (let*-test))
20
+
21
+ (define (letrec-test)
22
+ (define z 13)
23
+ (letrec ([x 3]
24
+ [y (lambda () z)] ; 5
25
+ [z 5])
26
+ (+ x (y) z)))
27
+
28
+ (assert-equal 13 (letrec-test))
29
+
30
+
31
+ (assert-equal 1024 (do ([x 1]
32
+ [i 0 (+ i 1)])
33
+ [(= i 10) x]
34
+ (set! x (* x 2))))
35
+
36
+ (define (do-factorial x)
37
+ (do ([y x (- y 1)]
38
+ [acc 1 (* y acc)])
39
+ ((zero? y) acc)))
40
+
41
+ (assert-equal 720 (do-factorial 6))
42
+
@@ -0,0 +1,2 @@
1
+ (define secret-rule-you-didnt-know 42)
2
+
@@ -0,0 +1,19 @@
1
+ (define-syntax when (syntax-rules ()
2
+ [(when test stmt1 stmt2 ...)
3
+ (if test
4
+ (begin stmt1
5
+ stmt2 ...))]))
6
+
7
+ (define-syntax swap (syntax-rules ()
8
+ [(swap x y)
9
+ (let ([temp x])
10
+ (set! x y)
11
+ (set! y temp))]))
12
+
13
+ (define-syntax square-sum (syntax-rules ()
14
+ [(_ x y)
15
+ (let* ([first x]
16
+ [second y]
17
+ [sum (+ first second)])
18
+ (* sum sum))]))
19
+
@@ -0,0 +1,343 @@
1
+ (load "macro-helpers")
2
+
3
+ ; Basic test: no subpatterns or ellipses
4
+
5
+ (define-syntax while
6
+ (syntax-rules ()
7
+ [(while condition expression)
8
+ (let loop ()
9
+ (if condition
10
+ (begin
11
+ expression
12
+ (loop))))]))
13
+
14
+ (define i 5)
15
+ (while (> i 0)
16
+ (set! i (- i 1)))
17
+
18
+ (assert-equal 0 i)
19
+
20
+
21
+ ; Test keywords
22
+
23
+ (define-syntax assign
24
+ (syntax-rules (values to)
25
+ [(assign values (value ...) to (name ...))
26
+ (begin
27
+ (define name value)
28
+ ...)]))
29
+
30
+ (assign values (9 7 6) to (foo bar baz))
31
+ (assert-equal 9 foo)
32
+ (assert-equal 7 bar)
33
+ (assert-equal 6 baz)
34
+
35
+ (assert-raise SyntaxError (assign stuff (3 2) to (foo bar)))
36
+ (assert-equal 9 foo)
37
+ (assert-equal 7 bar)
38
+
39
+ (define-syntax dont-rename-else (syntax-rules ()
40
+ [(foo test cons alt)
41
+ (cond (test cons)
42
+ (else alt))]))
43
+
44
+ (assert-equal 8 (dont-rename-else #f 6 8))
45
+
46
+
47
+ ; Test literal matching
48
+
49
+ (define-syntax iffy
50
+ (syntax-rules ()
51
+ [(iffy x #t y) x]
52
+ [(iffy x #f y) y]))
53
+
54
+ (assert-equal 7 (iffy 7 #t 3))
55
+ (assert-equal 3 (iffy 7 #f 3))
56
+
57
+
58
+ ; Test input execution - example from R5RS
59
+
60
+ (define-syntax my-or
61
+ (syntax-rules ()
62
+ ((my-or) #f)
63
+ ((my-or e) e)
64
+ ((my-or e1 e2 ...)
65
+ (let ((temp e1))
66
+ (if temp
67
+ temp
68
+ (my-or e2 ...))))))
69
+
70
+ (define e 1)
71
+ (define (inc)
72
+ (set! e (+ e 1))
73
+ e)
74
+ (my-or (> 0 (inc)) ; false
75
+ (> 0 (inc)) ; false
76
+ (> 9 6) ; true - should not evaluate further
77
+ (> 0 (inc))
78
+ (> 0 (inc)))
79
+
80
+ (assert-equal 3 e)
81
+
82
+
83
+ ; Test ellipses
84
+ (when true
85
+ (set! i (+ i 1))
86
+ (set! i (+ i 1))
87
+ (set! i (+ i 1))
88
+ (set! i (+ i 1)))
89
+
90
+ (assert-equal 4 i)
91
+
92
+
93
+ ; Test that ellipses match ZERO or more inputs
94
+
95
+ (define-syntax one-or-more
96
+ (syntax-rules ()
97
+ [(one-or-more stmt1 stmt2 ...)
98
+ (begin
99
+ stmt1
100
+ stmt2
101
+ ...)]))
102
+
103
+ (assert-equal 6 (one-or-more (+ 2 4)))
104
+ (assert-equal 11 (one-or-more (+ 2 4) (+ 3 8)))
105
+ (assert-equal 13 (one-or-more (+ 2 4) (+ 3 8) (+ 7 6)))
106
+
107
+
108
+ ; Test execution scope using (swap)
109
+ (define a 4)
110
+ (define b 7)
111
+ (swap a b)
112
+
113
+ (assert-equal 7 a)
114
+ (assert-equal 4 b)
115
+
116
+
117
+ ; More ellipsis tests from PLT docs
118
+
119
+ (define-syntax rotate
120
+ (syntax-rules ()
121
+ [(rotate a) a]
122
+ [(rotate a b c ...) (begin
123
+ (swap a b)
124
+ (rotate b c ...))]))
125
+
126
+ (define a 1) (define d 4)
127
+ (define b 2) (define e 5)
128
+ (define c 3)
129
+ (rotate a b c d e)
130
+
131
+ (assert-equal 2 a) (assert-equal 5 d)
132
+ (assert-equal 3 b) (assert-equal 1 e)
133
+ (assert-equal 4 c)
134
+
135
+
136
+ ; Check repeated macro use doesn't eat the parse tree
137
+ (letrec
138
+ ([loop (lambda (count)
139
+ (rotate a b c d e)
140
+ (if (> count 1) (loop (- count 1))))])
141
+ (loop 3))
142
+
143
+ (assert-equal 5 a) (assert-equal 3 d)
144
+ (assert-equal 1 b) (assert-equal 4 e)
145
+ (assert-equal 2 c)
146
+
147
+
148
+ ; Test subpatterns
149
+
150
+ (define-syntax p-swap
151
+ (syntax-rules ()
152
+ [(swap (x y))
153
+ (let ([temp x])
154
+ (set! x y)
155
+ (set! y temp))]))
156
+
157
+ (define m 3)
158
+ (define n 8)
159
+ (p-swap (m n))
160
+ (assert-equal 8 m)
161
+ (assert-equal 3 n)
162
+
163
+
164
+ (define-syntax parallel-set!
165
+ (syntax-rules ()
166
+ [(_ (symbol ...) (value ...))
167
+ (begin
168
+ (set! symbol value)
169
+ ...)]))
170
+
171
+ (parallel-set! (a b c) (74 56 19))
172
+ (assert-equal 74 a)
173
+ (assert-equal 56 b)
174
+ (assert-equal 19 c)
175
+
176
+
177
+ ; Test that ellipses are correctly matched
178
+ ; to numbers of splices in subexpressions
179
+
180
+ (define-syntax p-let*
181
+ (syntax-rules ()
182
+ [(_ (name ...) (value ...) stmt ...)
183
+ (let* ([name value] ...)
184
+ stmt
185
+ ...)]))
186
+
187
+ (define indicator #f)
188
+
189
+ (p-let* (k l m) (3 4 5)
190
+ (assert-equal 5 m)
191
+ (define temp m)
192
+ (set! m (+ l k))
193
+ (set! k (- l temp))
194
+ (set! l (* 6 (+ k m)))
195
+ (rotate k l m)
196
+ (assert-equal 7 l)
197
+ (assert-equal -1 m)
198
+ (assert-equal 36 k)
199
+ (set! indicator #t))
200
+
201
+ (assert indicator)
202
+
203
+
204
+ (define-syntax sum-lists
205
+ (syntax-rules ()
206
+ [(_ (value1 ...) (value2 ...))
207
+ (+ value1 ... value2 ...)]))
208
+
209
+ (assert-equal 21 (sum-lists (1 2) (3 4 5 6)))
210
+ (assert-equal 21 (sum-lists (1 2 3 4 5) (6)))
211
+
212
+
213
+ (define-syntax do-this
214
+ (syntax-rules (times)
215
+ [(_ n times body ...)
216
+ (letrec ([loop (lambda (count)
217
+ body ...
218
+ (if (> count 1)
219
+ (loop (- count 1))))])
220
+ (loop n))]))
221
+
222
+ (define myvar 0)
223
+ (do-this 7 times
224
+ (set! myvar (+ myvar 1)))
225
+ (assert-equal 7 myvar)
226
+
227
+
228
+ ; Test that ellipsis expressions can be reused
229
+
230
+ (define-syntax weird-add
231
+ (syntax-rules ()
232
+ [(_ (name ...) (value ...))
233
+ (let ([name value] ...)
234
+ (+ name ...))]))
235
+
236
+ (assert-equal 15 (weird-add (a b c d e) (1 2 3 4 5)))
237
+
238
+ (define-syntax double-up
239
+ (syntax-rules ()
240
+ [(double-up value ...)
241
+ '((value value) ...)]))
242
+
243
+ (assert-equal '((5 5)) (double-up 5))
244
+ (assert-equal '((3 3) (9 9) (2 2) (7 7)) (double-up 3 9 2 7))
245
+ (assert-equal '() (double-up))
246
+
247
+
248
+ ; R5RS version of (let), uses ellipsis after lists in patterns
249
+
250
+ (define-syntax r5rs-let
251
+ (syntax-rules ()
252
+ ((let ((name val) ...) body1 body2 ...)
253
+ ((lambda (name ...) body1 body2 ...)
254
+ val ...))
255
+ ((let tag ((name val) ...) body1 body2 ...)
256
+ ((letrec ((tag (lambda (name ...)
257
+ body1 body2 ...)))
258
+ tag)
259
+ val ...))))
260
+
261
+ (define let-with-macro #f)
262
+
263
+ (r5rs-let ([x 45] [y 89])
264
+ (assert-equal 45 x)
265
+ (assert-equal 89 y)
266
+ (set! let-with-macro #t))
267
+
268
+ (assert let-with-macro)
269
+
270
+
271
+ ; Non-standard extension to R5RS, not quite R6RS
272
+ ; Allow ellipses before the end of a list as long
273
+ ; as, in the expression (A ... B), B is a less specific
274
+ ; pattern than A
275
+ (define-syntax infix-ellip
276
+ (syntax-rules ()
277
+ [(_ (name value) ... fn)
278
+ (let ([name value] ...)
279
+ (fn name ...))]))
280
+
281
+ (assert-equal 24 (infix-ellip (a 1) (b 2) (c 3) (d 4) *))
282
+
283
+
284
+ ; Test nested splicings
285
+
286
+ (define-syntax nest1
287
+ (syntax-rules ()
288
+ [(_ (value ...) ... name ...)
289
+ '((name (value) ...) ...)]))
290
+
291
+ (assert-equal '((foo (1) (2)) (bar (3)) (baz) (whizz (4) (5) (6) (7)))
292
+ (nest1 (1 2) (3) () (4 5 6 7) foo bar baz whizz))
293
+
294
+
295
+ (define-syntax triple-deep
296
+ (syntax-rules ()
297
+ [(_ (((name ...) ...) ...) ((value ...) ...) ...)
298
+ '((((value (name)) ...) ...) ...)]))
299
+
300
+ (assert-equal '((((5 (foo)) (6 (bar))) ((2 (it)))) (((4 (wont))) ((8 (matter)) (7 (really)) (2 (anyway)))))
301
+ (triple-deep (((foo bar) (it)) ((wont) (matter really anyway)))
302
+ ((5 6) (2)) ((4) (8 7 2))))
303
+
304
+ (define-syntax triple-deep2
305
+ (syntax-rules ()
306
+ [(_ (((name ...) ...) ...) ((value ...) ...) ...)
307
+ '(((((value (name)) ...) ((value (name)) ...)) ...) ...)]))
308
+
309
+ (assert-equal '(((((5 (foo)) (6 (bar))) ((5 (foo)) (6 (bar)))))
310
+ ((((4 (wont))) ((4 (wont))))
311
+ (((8 (matter)) (7 (really)) (2 (anyway))) ((8 (matter)) (7 (really)) (2 (anyway))))))
312
+ (triple-deep2 (((foo bar)) ((wont) (matter really anyway)))
313
+ ((5 6)) ((4) (8 7 2))))
314
+
315
+
316
+ ; Really nasty nested repetition. PLT won't run this in its entirity
317
+ ; due to overuse of infix ellipses, but comparison output for
318
+ ; subsets of this macro can be seen in plt-macros.txt
319
+
320
+ (define-syntax convoluted
321
+ (syntax-rules (with)
322
+ [(_ (with (value ...) ...) ... thing ((name ...) ...) obj ...)
323
+ '((obj ((value ...) (value value) ...) ... (obj obj)) ...
324
+ (((name name) ... obj obj (obj (name ...))) ...))]))
325
+
326
+ (assert-equal '((foo ((a u) (a a) (u u)) ((j e n k l) (j j) (e e) (n n) (k k) (l l))
327
+ (()) ((q c y n) (q q) (c c) (y y) (n n)) (foo foo))
328
+ (bar (bar bar))
329
+ (baz ((b) (b b)) ((d f) (d d) (f f)) (baz baz))
330
+ (what ((k l e) (k k) (l l) (e e)) ((s) (s s)) ((u n) (u u) (n n))
331
+ ((f i k w) (f f) (i i) (k k) (w w)) ((p) (p p)) (what what))
332
+ (((8 8) (3 3) (2 2) (9 9) foo foo (foo (8 3 2 9)))
333
+ ((2 2) (3 3) bar bar (bar (2 3)))
334
+ ((1 1) (0 0) (4 4) baz baz (baz (1 0 4)))
335
+ ((8 8) (3 3) (2 2) (1 1) (7 7) what what (what (8 3 2 1 7)))))
336
+ (convoluted (with (a u) (j e n k l) () (q c y n)) (with)
337
+ (with (b) (d f)) (with (k l e) (s) (u n) (f i k w) (p))
338
+ thing ((8 3 2 9) (2 3) (1 0 4) (8 3 2 1 7))
339
+ foo bar baz what))
340
+
341
+ (assert-raise MacroTemplateMismatch (convoluted (with (a)) (with (b)) thing () foo))
342
+ (assert-raise SyntaxError (convoluted nothing))
343
+