-
Notifications
You must be signed in to change notification settings - Fork 0
/
tests.crisp
241 lines (182 loc) · 6.44 KB
/
tests.crisp
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
import std
; These are some test cases which highlight and exercise functionality.
; Each logical line in this script should evaluate to pass
; Comments are prefixed by ; and continue to the end of the line
; Whitespace and newlines are ignored
; Undefined symbols evaluate to themselves
test 1 1
test '1 1
test 'a a
test '(1 . 1) (1 . 1)
test '(a . (b . (c . nil))) (a b c)
; cons evaluates its left argument immediately, then
; evaluates its right argument in the same stack frame,
; eventually storing it in the right slot of the topmost
; pair when evaluation returns. This is merely an implementation
; optimization and shouldn't affect behavior
test '(cons a cons b cons c) (a b c)
test '(apply cons (a b)) (a . b)
; The quote function returns its arguments (a list) unevaluated
; 'cdr is syntactic sugar for (quote cdr)
test '(quote cdr) 'cdr
test ''cdr (quote cdr)
test ''() '()
test ''cdr 'cdr
test ''(car cdr cons) '(car cdr cons)
; The eval function evaluates its argument
test '(eval sum 1 2) 3
test '(eval '(car (cons a b))) a
test '(not nil) true
test '(not (not true)) true
test '(and foo bar) bar
test '(not (and foo nil)) true
test '(not (and nil foo)) true
test '(not (and nil nil)) true
; ispair returns its single argument if it is a pair; otherwise nil
test '(not (ispair a)) true
test '(car (ispair (a b))) a
test '(list-equal nil nil) true
test '(list-equal (a b) (a b)) true
test '(list-equal (nil b) (nil b)) true
test '(not (list-equal (a nil) (a b))) true
test '(not (list-equal (a d f) (a f d))) true
test '(or foo nil) foo
test '(or nil foo) foo
test '(or foo foo) foo
test '(nor nil nil) true
; f is not defined here so it is left unevaluated.
test '(reduce f (1 2 3)) (f 1 (f 2 3)))
test '(map f (1 2 3)) ((f 1) (f 2) (f 3))
test '(reduce sum (1 2 3)) 6
; sum returns the sum of its arguments; it does not sum lists
test '(sum 1 2 3 4) 10
; but if we apply sum to a list, we achieve the equivalent result
test '((lambda l apply sum l) (1 2 3 4)) 10
test '(apply inc 2) 3
; now we can test map
test '(map (lambda l apply sum l) ((2 4 6) (1 3 5 7) (2 3))) (12 16 5)
test '(all (1 2 foo bar)) bar
test '(all (1 2 nil bar)) nil
test '(all (1)) 1
test '(any (1 2 foo bar)) 1
test '(any (1 2 nil bar)) 1
test '(any (nil nil nil)) nil
test '(any nil) nil
test '(none (1 2 foo bar)) nil
test '(none (1 2 nil bar)) nil
test '(none (nil nil nil)) true
test '(none (nil)) true
test '(none nil) true
; asc: return the minimum arg if args are in strictly ascending order
; otherwise nil
test '(asc 1 2 3) 1
test '(asc 3 2 1) nil
; sum: return the sum of its arguments
test '(sum 1 2 3 4) 10
test '(sum 0 . AAAAAA) 0
; product: return the product of its arguments
test '(product 1 2 3 4) 24
; (apply f '(a b c)) is equivalent to (f a b c)
test '(apply sum '(1 2 3 4)) 10
testwith test (a 1) (fail: a != 1)
testwith test ((a a) (a a)) (pass: (a a) == (a a))
; boring recursive example
(
with factorial (rec factorial x
if (equal x 0)
1
(product x (factorial (dec x))))
testwith factorial 19 121645100408832000
)
; *exciting* and slow recursive example
(
with fib (rec fib x
if (asc x 2)
x
(sum (fib (dec x)) (fib (sum x -2))))
testwith fib 10 55
)
(
with fibpair (rec fibpair x
if (asc x 2)
(1 1)
(apply (lambda (a b) b (sum a b))
(fibpair (dec x))))
with fib (lambda z car (fibpair z))
testwith fib 92 7540113804746346429
)
; some lambda regression tests
test '((lambda x x) 1) 1
test '((lambda (x) x) 1) 1
test '((lambda (x) (x)) 1) 1
test '((lambda x (x)) 1) 1
test '((lambda (x y) x) 1 2) 1
test '((lambda (x y) y) 1 2) 2
test '((lambda (a b) (a b)) 1 2) (1 2)
test '(car (cdr ((lambda (a b) a b) 1 2))) 2
test '(car (cdr ((lambda (a b) (a b)) 1 2))) 2
; the improper list argument syntax is used to implement variadic functions and macros
; in the test below, a and b are bound to the first two arguments when the lambda is
; applied. `rest` is bound to a list containing the rest of the arguments
test '((lambda (a b . rest) rest) 3 4 5 6 7) (5 6 7)
test '((lambda (a b . rest) b a) 3 4 5 6 7) (4 3)
test '(identity x) x
test '(((curry sum) 4) 2) 6
test '((papply sum 5) 4) 9
test '(((applyN uncurry 2) (lambda x lambda y lambda z sum x y z)) 1 2 3) 6
test '((((applyN uncurry 1) (lambda x lambda y lambda z sum x y z)) 1 2) 3) 6
; filter out numbers less than 1
test '(filter (lambda x (asc 0 x)) (4 -5 2 -67 0)) (4 2)
; equivalently, with papply
test '(filter (papply asc 0) (4 -5 2 -67 0)) (4 2)
; filtering an empty list yields an empty list
test '(filter sum nil) nil
; filtering with the identity function does not affect the list
test '(filter (lambda x x) (a b c)) (a b c)
test '(concat (a b c d) (x y z)) (a b c d x y z)
test '(concat nil (x y z)) (nil x y z)
test '(concat (a b c d) nil) (a b c d ())
test '(concat a (b c d)) (a b c d)
test '(concat (a b c) d) (a b c d)
test '(concat (a b c) d () (e f g) h ) (a b c d () e f g h)
test '(concat nil nil) '(() ())
test '(concat (a . b) 3 ( c d . e)) (a b 3 c d e)
test '(reverse nil) nil
test '(reverse (a b c)) (c b a)
test '(range 4) (0 1 2 3)
test '(range -1) nil
test '(repeat z 3) (z z z)
test '(repeat z 0) nil
test '(repeat nil 2) (nil nil)
test '(zip (a b c) (1 2 3)) ((a . 1) (b . 2) (c . 3))
test '(zip (a b) (1 2 3 4)) ((a . 1) (b . 2))
test '(void (sum 1 2 3)) nil
test '(with x 2 x) 2
test '(with x 2 with y 6 sum x y) 8
; check that `with` doesn't affect the outer scope
(lambda (x y) y) (with x () foo) (test '(not (ispair x)) true)
; override builtin functions as needed
test '(with sum (lambda x product x x) sum 5 5) 25
test '(sum 5 5) 10
test '(with x y) ()
test '(with 0 . 300000000000000) ()
test '(unfold inc (lambda x asc 5 x) 1) '(1 2 3 4 5)
test '(find (lambda x (equal (inc x) 13)) (4 12 45)) 12
def find-first-lt lambda (x l) find (lambda v asc v x) l
test '(find-first-lt 3 (5 4 3 2 1)) 2
test '(find-first-lt 2 (1 2 3 4 5)) 1
test '(split-at (1 2 3 4) 3) '((1 2 3) 4)
test '(split-at (1 2 3 4) 0) '(() . (1 2 3 4))
test '(split-at (1 2 3 4) 4) '((1 2 3 4) . ())
(
with libc (dlopen libc.so.6)
with glib (dlopen libglib-2.0.so)
void (libc.puts
(glib.g_base64_decode cGFzczogZ2xpYiBiYXNlNjQgd29ya3M=
(libc.malloc 4)))
)
(
with libc (dlopen libc.so.6)
with puts (lambda l void ((map libc.putchar l) (libc.putchar 0xa)))
puts (112, 97, 115, 115, 58, 32, 108, 105, 98, 99, 32, 112, 117, 116, 99, 104, 97, 114, 32, 119, 111, 114, 107, 115)
)