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,60 @@
1
+ module Heist
2
+ class Runtime
3
+
4
+ class Stack < Array
5
+ attr_reader :value
6
+
7
+ def <<(frame)
8
+ super
9
+ clear!(size - 1)
10
+ end
11
+
12
+ def copy(keep_last = true)
13
+ copy = self.class.new
14
+ range = keep_last ? 0..-1 : 0...-1
15
+ self[range].each do |frame|
16
+ copy[copy.size] = frame.dup
17
+ end
18
+ copy
19
+ end
20
+
21
+ def fill!(subexpr, value)
22
+ return self[size] = value if Frame === value
23
+ return @value = value if empty?
24
+ last.fill!(subexpr, value)
25
+ end
26
+
27
+ def clear!(limit = 0)
28
+ process! while size > limit
29
+ @value
30
+ rescue Exception => ex
31
+ restack!
32
+ raise ex
33
+ end
34
+
35
+ def value=(value)
36
+ @value = value
37
+ @unwind = (Stack === @value)
38
+ @tail = (Frame === @value)
39
+ restack!(value) if @unwind
40
+ end
41
+
42
+ private
43
+
44
+ def process!
45
+ self.value = last.process!
46
+ return if empty? or @unwind or not last.complete?
47
+ @value.replaces(last.target) if @tail
48
+ fill!(pop.target, @value)
49
+ end
50
+
51
+ def restack!(stack = [])
52
+ pop while not empty?
53
+ stack.each_with_index { |frame, i| self[i] = frame }
54
+ @value = stack.value if Stack === stack
55
+ end
56
+ end
57
+
58
+ end
59
+ end
60
+
@@ -0,0 +1,49 @@
1
+ module Heist
2
+ class Runtime
3
+
4
+ class Stackless
5
+ def <<(frame)
6
+ @current = frame
7
+ @current = process! while incomplete?
8
+ @current
9
+ end
10
+
11
+ private
12
+
13
+ def process!
14
+ expression, scope = @current.expression,
15
+ @current.scope
16
+
17
+ if Body === @current
18
+ expression[0...-1].each { |expr| Heist.evaluate(expr, scope) }
19
+ return Frame.new(expression.last, scope)
20
+ end
21
+
22
+ case expression
23
+
24
+ when List then
25
+ first = Heist.evaluate(expression.first, scope)
26
+ raise SyntaxError.new("Invalid expression: #{expression}") unless Function === first
27
+
28
+ value = first.call(scope, expression.rest)
29
+ return value unless Macro::Expansion === value
30
+
31
+ expression.replace(value.expression)
32
+ return Frame.new(value.expression, scope)
33
+
34
+ when Identifier then
35
+ scope[expression]
36
+
37
+ else
38
+ expression
39
+ end
40
+ end
41
+
42
+ def incomplete?
43
+ (Frame === @current) or (Binding === @current)
44
+ end
45
+ end
46
+
47
+ end
48
+ end
49
+
@@ -0,0 +1,12 @@
1
+ (define benchmark (lambda (n fn)
2
+ (begin
3
+ (define start (runtime))
4
+ (define iter (lambda (n)
5
+ (begin
6
+ (if (> n 0)
7
+ (begin (fn)
8
+ (iter (- n 1)))))))
9
+ (iter n)
10
+ (display (+ n " iterations: " (- (runtime) start)))
11
+ (newline))))
12
+
@@ -0,0 +1,82 @@
1
+ ; A library of combinators, partly inspired by Raymond
2
+ ; Smullyan's "To Mock A Mockingbird".
3
+ ;
4
+ ; http://en.wikipedia.org/wiki/To_Mock_a_Mockingbird
5
+ ;
6
+ ; Each bird is a higher-order function that takes a single
7
+ ; function as input and returns a function.
8
+ ;
9
+ ; A bird A 'is fond of' bird B if AB = B, that is to say
10
+ ; that B is the fixed point of A such that YA = B.
11
+ ;
12
+ ; Rule C1: for any pair of birds (A,B) there is some bird
13
+ ; C that composes them such that Cf = A(Bf) for all f.
14
+ ;
15
+ ; Rule C2: there exists a Mockingbird M where Mf = ff.
16
+ ;
17
+ ; These can be used to show every higher-order function
18
+ ; has at least one fixed point:
19
+ ;
20
+ ; * For any A there is a C where Cf = A(Mf) for all f
21
+ ;
22
+ ; Cf = A(Mf) for all f. Let f = C
23
+ ; -> CC = A(MC) = A(CC) -> A is fond of CC
24
+ ;
25
+ ; If C composes A and M, CC is a fixed point of A and
26
+ ; therefore YA = CC = MC where Cf = A(Mf) for all f.
27
+ ;
28
+ ; Instead of rule C2, assume this:
29
+ ;
30
+ ; Rule C3: a bird is said to be 'agreeable' if, for every
31
+ ; other bird B, there exists an f such that Af = Bf.
32
+ ; We are given that there exists an agreeable bird A.
33
+ ;
34
+ ; * C1: For any y there exists H such that Hf = y(Af) for all f
35
+ ; * C3: A must agree with H for some input x
36
+ ; * Let f = x
37
+ ;
38
+ ; -> Hx = y(Ax), and Hx = Ax -> y(Ax) = Ax
39
+ ;
40
+ ; So any bird y is fond of Ax where A is the agreeable
41
+ ; bird, Ax = Hx and H composes y with A.
42
+
43
+ ; B combinator (Bluebird) -- Bfgh = f(gh)
44
+ ; Returns a function that composes two others (rule C1)
45
+ (define (B f)
46
+ (lambda (g)
47
+ (lambda (h)
48
+ (f (g h)))))
49
+
50
+ ; M combinator (Mockingbird) -- Mf = ff
51
+ ; Returns a function's response to itself (rule C2)
52
+ (define (M f) (f f))
53
+
54
+ ; K combinator (Kestrel) -- Kfg = f
55
+ ; Returns its first input
56
+ (define (K f)
57
+ (lambda (g)
58
+ (begin g f)))
59
+
60
+ ; Y combinator -- Yf = MC = M(BfM)
61
+ ; Returns fixed points of higher order functions, that
62
+ ; is to say Yf = f(Yf). It's often used to implement
63
+ ; anonymous recursion.
64
+ ;
65
+ ; Interestingly, using a lazy evaluator you can write
66
+ ; this simply as
67
+ ;
68
+ ; (define (Y f)
69
+ ; (f (Y f)))
70
+ ;
71
+ ; and it will work correctly. The following form assumes
72
+ ; lazy evaluation but is expressed in terms of results
73
+ ; derived above. If using applicative order, the following
74
+ ; form should be used:
75
+ ;
76
+ ; (define (Y f)
77
+ ; (M (lambda (g)
78
+ ; (lambda (h)
79
+ ; ((((B f) M) g) h)))))
80
+ (define (Y f)
81
+ (M ((B f) M)))
82
+
@@ -0,0 +1,57 @@
1
+ (assert-equal 486 (+ 137 349))
2
+ (assert-equal 666 (- 1000 334))
3
+ (assert-equal 495 (* 5 99))
4
+ (assert-equal 2 (/ 10 5))
5
+ (assert-equal 12.7 (+ 2.7 10))
6
+ (assert-equal 75 (+ 21 35 12 7))
7
+ (assert-equal 1200 (* 25 4 12))
8
+ (assert-equal 19 (+ (* 3 5) (- 10 6)))
9
+ (assert-equal 57 (+ (* 3 (+ (* 2 4) (+ 3 5))) (+ (- 10 7) 6)))
10
+ (assert-equal 8 (expt 2 3))
11
+ (assert-equal 2 (expt 4 1/2))
12
+
13
+ (define (sqrt x)
14
+ (define (square x)
15
+ (* x x))
16
+ (define (average x y)
17
+ (/ (+ x y) 2))
18
+ (define (good-enough? guess)
19
+ (< (abs (- (square guess) x)) 0.001))
20
+ (define (improve guess)
21
+ (average guess (/ x guess)))
22
+ (define (sqrt-iter guess)
23
+ (if (good-enough? guess)
24
+ guess
25
+ (sqrt-iter (improve guess))))
26
+ (sqrt-iter 1.0))
27
+
28
+ (assert (< (abs (- (sqrt 9) 3)) 0.0001))
29
+
30
+ ; http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-9.html#%_idx_288
31
+ (assert-equal 1 (modulo 13 4))
32
+ (assert-equal 1 (remainder 13 4))
33
+ (assert-equal 3 (modulo -13 4))
34
+ (assert-equal -1 (remainder -13 4))
35
+ (assert-equal -3 (modulo 13 -4))
36
+ (assert-equal 1 (remainder 13 -4))
37
+ (assert-equal -1 (modulo -13 -4))
38
+ (assert-equal -1 (remainder -13 -4))
39
+ (assert-equal -1.0 (remainder -13 -4.0)) ; inexact
40
+
41
+ (assert-equal 4 (gcd 32 -36))
42
+ (assert-equal 288 (lcm 32 -36))
43
+ (assert-equal 288.0 (lcm 32.0 -36)) ; inexact
44
+
45
+ (assert-equal -5.0 (floor -4.3))
46
+ (assert-equal -4.0 (ceiling -4.3))
47
+ (assert-equal -4.0 (truncate -4.3))
48
+ (assert-equal -4.0 (round -4.3))
49
+
50
+ (assert-equal 3.0 (floor 3.5))
51
+ (assert-equal 4.0 (ceiling 3.5))
52
+ (assert-equal 3.0 (truncate 3.5))
53
+ (assert-equal 4.0 (round 3.5)) ; inexact
54
+
55
+ (assert-equal 4 (round 7/2)) ; exact
56
+ (assert-equal 7 (round 7))
57
+
@@ -0,0 +1,27 @@
1
+ (load "benchmark")
2
+
3
+ (define-syntax swap
4
+ (syntax-rules ()
5
+ [(swap x y)
6
+ (let ([temp x])
7
+ (set! x y)
8
+ (set! y temp))]))
9
+
10
+ (define-syntax rotate
11
+ (syntax-rules ()
12
+ [(rotate x y)
13
+ (swap x y)]
14
+ [(rotate x y z ...)
15
+ (begin
16
+ (swap x y)
17
+ (rotate y z ...))]))
18
+
19
+ (define-syntax p-let
20
+ (syntax-rules ()
21
+ [(p-let (name ...) (value ...) body ...)
22
+ (let ([name value] ...)
23
+ body ...)]))
24
+
25
+ (p-let (a b c d e) (1 2 3 4 5)
26
+ (benchmark 50 (lambda () (rotate a b c d e))))
27
+
@@ -0,0 +1,6 @@
1
+ (assert (boolean? #t))
2
+ (assert (not (boolean? "Hello, World!")))
3
+ (assert (not #f))
4
+ (assert (not (not #t)))
5
+ (assert (not (not "Hello, World!")))
6
+
@@ -0,0 +1,16 @@
1
+ (define (add n)
2
+ (lambda (x) (+ x n)))
3
+
4
+ (define add4 (add 4))
5
+ (define add7 (add 7))
6
+
7
+ (assert-equal 15 (add4 11))
8
+
9
+ (define (weird x y)
10
+ (begin
11
+ (define (+ x y)
12
+ (* x y))
13
+ (+ x y)))
14
+ (assert-equal 7 (+ 3 4))
15
+ (assert-equal 12 (weird 3 4))
16
+
@@ -0,0 +1,55 @@
1
+ (define (abs x)
2
+ (cond ((> x 0) x)
3
+ ((= x 0) (define zero 0) zero)
4
+ ((< x 0) (- x))))
5
+
6
+ (assert-equal 4 (abs 4))
7
+ (assert-equal 0 (abs 0))
8
+ (assert-equal 13 (abs -13))
9
+
10
+ (define (abs x)
11
+ (cond ((< x 0) (- x))
12
+ (else x)))
13
+
14
+ (assert-equal 4 (abs 4))
15
+ (assert-equal 0 (abs 0))
16
+ (assert-equal 13 (abs -13))
17
+
18
+ (define (abs x)
19
+ (if (< x 0)
20
+ (- x)
21
+ x))
22
+
23
+ (assert-equal 4 (abs 4))
24
+ (assert-equal 0 (abs 0))
25
+ (assert-equal 13 (abs -13))
26
+
27
+ (define (a-plus-abs-b a b)
28
+ ((if (> b 0) + -) a b))
29
+
30
+ (assert-equal 7 (a-plus-abs-b 3 4))
31
+ (assert-equal 11 (a-plus-abs-b 3 (- 8)))
32
+
33
+ (define (fact x)
34
+ (if (= x 0)
35
+ 1
36
+ (* x
37
+ (fact (- x 1)))))
38
+
39
+ (assert-equal 720 (fact 6))
40
+
41
+ (define x 7)
42
+ (assert-equal #t (and (> x 5) (<= x 10)))
43
+ (assert-equal #t (or (>= x 5) (< x 3)))
44
+
45
+ (assert-equal 720 (cond ((- 9 3) => fact)))
46
+
47
+ (assert-equal 'composite (case (* 2 3)
48
+ ((2 3 5 7) 'prime)
49
+ ((1 4 6 8 9) 'composite)))
50
+
51
+ (assert-equal 'consonant (case 'c
52
+ ((a e i o u) 'vowel)
53
+ ((w y) 'semivowel)
54
+ (else 'consonant)))
55
+
@@ -0,0 +1,144 @@
1
+ (define r)
2
+ (define value)
3
+
4
+ ; call/cc returning normally
5
+ (set! value (+ 3 (call/cc (lambda (k) (+ 2 7)))))
6
+ (assert-equal 12 value)
7
+
8
+ ; calling the continuation abandons the current expression
9
+ (set! value (+ 3 (call/cc
10
+ (lambda (k)
11
+ (set! r k)
12
+ (+ 2 (k 7))))))
13
+ (assert-equal 10 value)
14
+
15
+ ; calling a stored continuation aborts the current stack
16
+ (define called #f)
17
+ (begin
18
+ (r 5)
19
+ (set! called #t))
20
+ (assert (not called))
21
+
22
+ ; calling call/cc does not unwind the stack
23
+ (begin
24
+ (call/cc (lambda (k) 3))
25
+ (set! called #t))
26
+ (assert called)
27
+
28
+ ; expressions before the call/cc have their values fixed
29
+ (define y 2)
30
+ (set! value (+ 1 y (call/cc
31
+ (lambda (k)
32
+ (set! r k)
33
+ (k 1)))))
34
+ (assert-equal 4 value)
35
+ (set! y 5)
36
+ (r 3)
37
+ (assert-equal 6 value)
38
+
39
+ ; expressions after the call/cc are re-evaluated
40
+ (set! y 2)
41
+ (set! value (+ 1 (call/cc
42
+ (lambda (k)
43
+ (set! r k)
44
+ (k 1)))
45
+ y))
46
+ (assert-equal 4 value)
47
+ (set! y 5)
48
+ (r 3)
49
+ (assert-equal 9 value)
50
+
51
+ ; more checks for re-evaluation
52
+ (define count-calls 0)
53
+ (begin
54
+ (set! count-calls (+ count-calls 1))
55
+ (call/cc
56
+ (lambda (k)
57
+ (set! r k)
58
+ 4)))
59
+ (r #t) (r #t) (r #t)
60
+ (assert-equal 1 count-calls)
61
+ (begin
62
+ (call/cc
63
+ (lambda (k)
64
+ (set! r k)
65
+ 4))
66
+ (set! count-calls (+ count-calls 1)))
67
+ (r #t) (r #t) (r #t)
68
+ (assert-equal 5 count-calls)
69
+
70
+ ; multiple call/cc in the same expression
71
+ ; http://sanjaypande.blogspot.com/2004/06/understanding-scheme-continuations.html
72
+
73
+ (define r1 #f)
74
+ (define r2 #f)
75
+
76
+ (define (somefunc x y)
77
+ (+ (* 2 (expt x 2)) (* 3 y) 1))
78
+
79
+ (set! value
80
+ (somefunc (call/cc
81
+ (lambda (c1)
82
+ (set! r1 c1)
83
+ (c1 1)))
84
+ (call/cc
85
+ (lambda (c2)
86
+ (set! r2 c2)
87
+ (c2 1)))))
88
+ (assert-equal 6 value)
89
+ (r1 5)
90
+ (assert-equal 54 value)
91
+ (r2 5)
92
+ (assert-equal 66 value)
93
+
94
+ ; test that primitive values can be thrown into (if), (and)
95
+ (set! value (if (call/cc
96
+ (lambda (k)
97
+ (set! r k)
98
+ #t))
99
+ "bees"
100
+ "honey"))
101
+ (r #t)
102
+ (assert-equal "bees" value)
103
+ (r #f)
104
+ (assert-equal "honey" value)
105
+
106
+ ; test saving the continuation inside a function
107
+ (define before 0)
108
+ (define after 0)
109
+ (define (foo)
110
+ (set! before (+ before 1))
111
+ (set! y (call/cc
112
+ (lambda (k)
113
+ (set! r k)
114
+ 2)))
115
+ (set! after (+ after 1))
116
+ (+ 3 y))
117
+ (set! value (* 5 (foo)))
118
+ (assert-equal 25 value)
119
+ (r 7)
120
+ (assert-equal 50 value)
121
+ (assert-equal 1 before)
122
+ (assert-equal 2 after)
123
+
124
+ ; test integration with macros
125
+ (define-syntax cc-macro
126
+ (syntax-rules ()
127
+ [(_ (name ...) (value ...) body ...)
128
+ (let ((name value) ...)
129
+ body ...)]))
130
+
131
+ (define (call-macro)
132
+ (define not-tail #t)
133
+ (cc-macro (foo bar) (7 4)
134
+ (* bar (+ (call/cc
135
+ (lambda (k)
136
+ (set! r k)
137
+ foo))
138
+ foo))))
139
+ (set! value (/ (call-macro)
140
+ 2))
141
+ (assert-equal 28 value)
142
+ (r 3)
143
+ (assert-equal 20 value)
144
+