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
|
#lang zuo
(require "harness.zuo")
(alert "kernel eval")
(define bad-kernel-stx "bad kernel syntax")
(check (kernel-eval 1) 1)
(check (kernel-eval 'cons) cons)
(check (kernel-eval '(cons 1 2)) '(1 . 2))
(check-fail (kernel-eval '(cons 1 . 2)) bad-kernel-stx)
(check-fail (kernel-eval '(cons . 2)) bad-kernel-stx)
(check (procedure? (kernel-eval '(lambda (x) x))) #t)
(check (procedure? (kernel-eval '(lambda (x x) x))) #t)
(check (procedure? (kernel-eval '(lambda (x . x) x))) #t)
(check (procedure? (kernel-eval '(lambda (x x) "name" x))) #t)
(check ((kernel-eval '(lambda (x x) x)) #f 2) 2)
(check ((kernel-eval '(lambda (x x . x) x)) #f 2 3 4) '(3 4))
(check-fail (kernel-eval '(lambda)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda . x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda (x x))) bad-kernel-stx)
(check-fail (kernel-eval '(lambda (x x . x) . x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda (x y . x) . x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda (x x . 5) x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda 5 x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda x #f 2)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda x #f . 2)) bad-kernel-stx)
(check-fail (kernel-eval 'lambda) "undefined: 'lambda")
(check (((kernel-eval '(lambda (lambda) (lambda x x))) 1) 2) '(2))
(check (kernel-eval '(quote cons)) 'cons)
(check-fail (kernel-eval '(quote)) bad-kernel-stx)
(check-fail (kernel-eval '(quote cons list)) bad-kernel-stx)
(check-fail (kernel-eval '(quote . cons)) bad-kernel-stx)
(check-fail (kernel-eval '(quote cons . list)) bad-kernel-stx)
(check-fail (kernel-eval 'quote) "undefined: 'quote")
(check (kernel-eval '(if #t 1 2)) 1)
(check (kernel-eval '(if 0 1 2)) 1)
(check (kernel-eval '(if #f 1 2)) 2)
(check-fail (kernel-eval '(if)) bad-kernel-stx)
(check-fail (kernel-eval '(if . 1)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 . 2)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 2)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 2 . 3)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 2 3 . 4)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 2 3 4)) bad-kernel-stx)
(check-fail (kernel-eval 'if) "undefined: 'if")
(check (kernel-eval '(let ([x 1]) x)) 1)
(check (kernel-eval '(let ([x 1]) (let ([x 2]) x))) 2)
(check (kernel-eval '(let ([x 1]) (list (let ([x 2]) x) x))) '(2 1))
(check-fail (kernel-eval '(let)) bad-kernel-stx)
(check-fail (kernel-eval '(let . x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ())) bad-kernel-stx)
(check-fail (kernel-eval '(let () x)) bad-kernel-stx)
(check-fail (kernel-eval '(let (x) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x . 1]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 1 . 2]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 1 2]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([1 2]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2] . y) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2] y) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2]))) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2]) . x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2]) x . x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2]) x x)) bad-kernel-stx)
(check-fail (kernel-eval 'let) "undefined: 'let")
(check (kernel-eval '(begin 1)) 1)
(check (kernel-eval '(begin 1 2)) 2)
(check (kernel-eval '(begin 1 2 3 4)) 4)
(check-fail (kernel-eval '(begin)) bad-kernel-stx)
(check-fail (kernel-eval '(begin . 1)) bad-kernel-stx)
(check-fail (kernel-eval '(begin 1 2 3 . 4)) bad-kernel-stx)
(check-fail (kernel-eval 'begin) "undefined: 'begin")
(check (andmap (lambda (k)
(eq? (kernel-eval k) (hash-ref (kernel-env) k #f)))
(hash-keys (kernel-env))))
(check (kernel-eval
(let loop ([i 10000])
(if (= i 0)
"ok"
`(kernel-eval ',(loop (- i 1))))))
"ok")
|
