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.
- data/History.txt +21 -0
- data/Manifest.txt +53 -0
- data/README.txt +274 -0
- data/Rakefile +12 -0
- data/bin/heist +16 -0
- data/lib/bin_spec.rb +25 -0
- data/lib/builtin/library.scm +95 -0
- data/lib/builtin/primitives.rb +306 -0
- data/lib/builtin/syntax.rb +166 -0
- data/lib/builtin/syntax.scm +155 -0
- data/lib/heist.rb +47 -0
- data/lib/parser/nodes.rb +105 -0
- data/lib/parser/scheme.rb +1081 -0
- data/lib/parser/scheme.tt +80 -0
- data/lib/repl.rb +112 -0
- data/lib/runtime/binding.rb +31 -0
- data/lib/runtime/callable/continuation.rb +24 -0
- data/lib/runtime/callable/function.rb +55 -0
- data/lib/runtime/callable/macro.rb +170 -0
- data/lib/runtime/callable/macro/expansion.rb +15 -0
- data/lib/runtime/callable/macro/matches.rb +77 -0
- data/lib/runtime/callable/macro/splice.rb +56 -0
- data/lib/runtime/data/expression.rb +23 -0
- data/lib/runtime/data/identifier.rb +20 -0
- data/lib/runtime/data/list.rb +36 -0
- data/lib/runtime/frame.rb +118 -0
- data/lib/runtime/runtime.rb +61 -0
- data/lib/runtime/scope.rb +121 -0
- data/lib/runtime/stack.rb +60 -0
- data/lib/runtime/stackless.rb +49 -0
- data/lib/stdlib/benchmark.scm +12 -0
- data/lib/stdlib/birdhouse.scm +82 -0
- data/test/arithmetic.scm +57 -0
- data/test/benchmarks.scm +27 -0
- data/test/booleans.scm +6 -0
- data/test/closures.scm +16 -0
- data/test/conditionals.scm +55 -0
- data/test/continuations.scm +144 -0
- data/test/define_functions.scm +27 -0
- data/test/define_values.scm +28 -0
- data/test/delay.scm +8 -0
- data/test/file_loading.scm +9 -0
- data/test/hygienic.scm +39 -0
- data/test/let.scm +42 -0
- data/test/lib.scm +2 -0
- data/test/macro-helpers.scm +19 -0
- data/test/macros.scm +343 -0
- data/test/numbers.scm +19 -0
- data/test/plt-macros.txt +40 -0
- data/test/test_heist.rb +84 -0
- data/test/unhygienic.scm +11 -0
- data/test/vars.scm +2 -0
- 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,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
|
+
|
data/test/arithmetic.scm
ADDED
@@ -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
|
+
|
data/test/benchmarks.scm
ADDED
@@ -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
|
+
|
data/test/booleans.scm
ADDED
data/test/closures.scm
ADDED
@@ -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
|
+
|