diff options
author | Bad Diode <bd@badd10de.dev> | 2021-10-10 18:41:31 +0200 |
---|---|---|
committer | Bad Diode <bd@badd10de.dev> | 2021-10-10 18:41:31 +0200 |
commit | 581116c655df4eb753098e013dd5854df95f7865 (patch) | |
tree | 5439c196d27ef7d6fe93f96b006f2cca24d8170f | |
parent | 43861f9d91782d864dc9866eee1d39288bb3a76d (diff) | |
download | bdl-581116c655df4eb753098e013dd5854df95f7865.tar.gz bdl-581116c655df4eb753098e013dd5854df95f7865.zip |
Add type introspection functions and tests
-rwxr-xr-x | Makefile | 1 | ||||
-rw-r--r-- | examples/booleans.bdl | 9 | ||||
-rw-r--r-- | examples/types.bdl | 73 | ||||
-rw-r--r-- | src/bootstrap/primitives.c | 57 | ||||
-rw-r--r-- | tests/booleans_expected.txt | 7 | ||||
-rw-r--r-- | tests/types_expected.txt | 53 |
6 files changed, 167 insertions, 33 deletions
@@ -50,6 +50,7 @@ tests: $(BIN) | |||
50 | ./$(BIN) examples/arithmetic.bdl | diff tests/arithmetic_expected.txt - | 50 | ./$(BIN) examples/arithmetic.bdl | diff tests/arithmetic_expected.txt - |
51 | ./$(BIN) examples/booleans.bdl | diff tests/booleans_expected.txt - | 51 | ./$(BIN) examples/booleans.bdl | diff tests/booleans_expected.txt - |
52 | ./$(BIN) examples/lists.bdl | diff tests/lists_expected.txt - | 52 | ./$(BIN) examples/lists.bdl | diff tests/lists_expected.txt - |
53 | ./$(BIN) examples/types.bdl | diff tests/types_expected.txt - | ||
53 | 54 | ||
54 | # Remove build directory. | 55 | # Remove build directory. |
55 | clean: | 56 | clean: |
diff --git a/examples/booleans.bdl b/examples/booleans.bdl index 8828ac2..e38fb1f 100644 --- a/examples/booleans.bdl +++ b/examples/booleans.bdl | |||
@@ -2,15 +2,6 @@ | |||
2 | ;; Boolean primitives. | 2 | ;; Boolean primitives. |
3 | ;; | 3 | ;; |
4 | 4 | ||
5 | ;; Boolean test. | ||
6 | (print "(boolean? true) -> ") (boolean? true) | ||
7 | (print "(boolean? false) -> ") (boolean? false) | ||
8 | (print "(boolean? 1) -> ") (boolean? 1) | ||
9 | (print "(boolean? 5) -> ") (boolean? 5) | ||
10 | (print "(boolean? \"string\") -> ") (boolean? "string") | ||
11 | (print "(boolean? (+ 1 2 3)) -> ") (boolean? (+ 1 2 3)) | ||
12 | (print "(boolean? (not 1)) -> ") (boolean? (not 1)) | ||
13 | |||
14 | ;; Not. | 5 | ;; Not. |
15 | (print "(not true) -> ") (not true) | 6 | (print "(not true) -> ") (not true) |
16 | (print "(not false) -> ") (not false) | 7 | (print "(not false) -> ") (not false) |
diff --git a/examples/types.bdl b/examples/types.bdl new file mode 100644 index 0000000..43b7be9 --- /dev/null +++ b/examples/types.bdl | |||
@@ -0,0 +1,73 @@ | |||
1 | ;; | ||
2 | ;; Type testing. | ||
3 | ;; | ||
4 | |||
5 | ;; Boolean. | ||
6 | (print "(boolean? true) -> ") (boolean? true) | ||
7 | (print "(boolean? false) -> ") (boolean? false) | ||
8 | (print "(boolean? 1) -> ") (boolean? 1) | ||
9 | (print "(boolean? 5) -> ") (boolean? 5) | ||
10 | (print "(boolean? \"string\") -> ") (boolean? "string") | ||
11 | (print "(boolean? (+ 1 2 3)) -> ") (boolean? (+ 1 2 3)) | ||
12 | (print "(boolean? (not 1)) -> ") (boolean? (not 1)) | ||
13 | |||
14 | ;; Empty list/null. | ||
15 | (print "(null? true) -> ") (null? true) | ||
16 | (print "(null? false) -> ") (null? false) | ||
17 | (print "(null? 1) -> ") (null? 1) | ||
18 | (print "(null? 5) -> ") (null? 5) | ||
19 | (print "(null? \"string\") -> ") (null? "string") | ||
20 | (print "(null? (+ 1 2 3)) -> ") (null? (+ 1 2 3)) | ||
21 | (print "(null? (not 1)) -> ") (null? (not 1)) | ||
22 | (print "(null? ()) -> ") (null? ()) | ||
23 | |||
24 | ;; String. | ||
25 | (print "(string? true) -> ") (string? true) | ||
26 | (print "(string? false) -> ") (string? false) | ||
27 | (print "(string? 1) -> ") (string? 1) | ||
28 | (print "(string? 5) -> ") (string? 5) | ||
29 | (print "(string? \"string\") -> ") (string? "string") | ||
30 | (print "(string? (+ 1 2 3)) -> ") (string? (+ 1 2 3)) | ||
31 | (print "(string? (not 1)) -> ") (string? (not 1)) | ||
32 | |||
33 | ;; Fixnum. | ||
34 | (print "(fixnum? true) -> ") (fixnum? true) | ||
35 | (print "(fixnum? false) -> ") (fixnum? false) | ||
36 | (print "(fixnum? 1) -> ") (fixnum? 1) | ||
37 | (print "(fixnum? 5) -> ") (fixnum? 5) | ||
38 | (print "(fixnum? \"string\") -> ") (fixnum? "string") | ||
39 | (print "(fixnum? (+ 1 2 3)) -> ") (fixnum? (+ 1 2 3)) | ||
40 | (print "(fixnum? (not 1)) -> ") (fixnum? (not 1)) | ||
41 | |||
42 | ;; Symbol | ||
43 | ;; TODO: We need quotation to test for symbols. | ||
44 | (print "(symbol? true) -> ") (symbol? true) | ||
45 | (print "(symbol? false) -> ") (symbol? false) | ||
46 | (print "(symbol? 1) -> ") (symbol? 1) | ||
47 | (print "(symbol? +) -> ") (symbol? +) | ||
48 | (print "(symbol? \"string\") -> ") (symbol? "string") | ||
49 | (print "(symbol? (+ 1 2 3)) -> ") (symbol? (+ 1 2 3)) | ||
50 | (print "(symbol? (not 1)) -> ") (symbol? (not 1)) | ||
51 | ; (print "(symbol? 'a) -> ") (symbol? 'a) | ||
52 | ; (print "(symbol? 'c) -> ") (symbol? 'c) | ||
53 | |||
54 | ;; Pair. | ||
55 | (print "(pair? false) -> ") (pair? false) | ||
56 | (print "(pair? 1) -> ") (pair? 1) | ||
57 | (print "(pair? 5) -> ") (pair? 5) | ||
58 | (print "(pair? \"string\") -> ") (pair? "string") | ||
59 | (print "(pair? (+ 1 2 3)) -> ") (pair? (+ 1 2 3)) | ||
60 | (print "(pair? (not 1)) -> ") (pair? (not 1)) | ||
61 | (print "(pair? (cons 1 2)) -> ") (pair? (cons 1 2)) | ||
62 | (print "(pair? (list 1 2 3)) -> ") (pair? (list 1 2 3)) | ||
63 | |||
64 | ; ;; Procedure. | ||
65 | (print "(procedure? false) -> ") (procedure? false) | ||
66 | (print "(procedure? 1) -> ") (procedure? 1) | ||
67 | (print "(procedure? 5) -> ") (procedure? 5) | ||
68 | (print "(procedure? \"string\") -> ") (procedure? "string") | ||
69 | (print "(procedure? (+ 1 2 3)) -> ") (procedure? (+ 1 2 3)) | ||
70 | (print "(procedure? (not 1)) -> ") (procedure? (not 1)) | ||
71 | (print "(procedure? +) -> ") (procedure? +) | ||
72 | (print "(procedure? -) -> ") (procedure? -) | ||
73 | (print "(procedure? procedure?) -> ") (procedure? procedure?) | ||
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 6300067..806656e 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c | |||
@@ -300,49 +300,72 @@ proc_print(Object *args) { | |||
300 | 300 | ||
301 | Object * | 301 | Object * |
302 | proc_is_boolean(Object *args) { | 302 | proc_is_boolean(Object *args) { |
303 | Object *obj = NULL; | 303 | if (args->type != OBJ_TYPE_PAIR) { |
304 | if (args->type == OBJ_TYPE_PAIR) { | 304 | fprintf(stderr, "error: wrong number of arguments.\n"); |
305 | obj = eval(args->car); | 305 | return NULL; |
306 | } else { | ||
307 | obj = eval(args); | ||
308 | } | 306 | } |
307 | Object *obj = eval(args->car); | ||
309 | return (obj == obj_true || obj == obj_false) ? obj_true : obj_false; | 308 | return (obj == obj_true || obj == obj_false) ? obj_true : obj_false; |
310 | } | 309 | } |
311 | 310 | ||
312 | Object * | 311 | Object * |
313 | proc_is_null(Object *args) { | 312 | proc_is_null(Object *args) { |
314 | // TODO: stub | 313 | if (args->type != OBJ_TYPE_PAIR) { |
315 | return NULL; | 314 | fprintf(stderr, "error: wrong number of arguments.\n"); |
315 | return NULL; | ||
316 | } | ||
317 | Object *obj = eval(args->car); | ||
318 | return obj == obj_nil ? obj_true : obj_false; | ||
316 | } | 319 | } |
317 | 320 | ||
318 | Object * | 321 | Object * |
319 | proc_is_symbol(Object *args) { | 322 | proc_is_symbol(Object *args) { |
320 | // TODO: stub | 323 | if (args->type != OBJ_TYPE_PAIR) { |
321 | return NULL; | 324 | fprintf(stderr, "error: wrong number of arguments.\n"); |
325 | return NULL; | ||
326 | } | ||
327 | Object *obj = eval(args->car); | ||
328 | return obj->type == OBJ_TYPE_SYMBOL ? obj_true : obj_false; | ||
322 | } | 329 | } |
323 | 330 | ||
324 | Object * | 331 | Object * |
325 | proc_is_string(Object *args) { | 332 | proc_is_string(Object *args) { |
326 | // TODO: stub | 333 | if (args->type != OBJ_TYPE_PAIR) { |
327 | return NULL; | 334 | fprintf(stderr, "error: wrong number of arguments.\n"); |
335 | return NULL; | ||
336 | } | ||
337 | Object *obj = eval(args->car); | ||
338 | return obj->type == OBJ_TYPE_STRING ? obj_true : obj_false; | ||
328 | } | 339 | } |
329 | 340 | ||
330 | Object * | 341 | Object * |
331 | proc_is_fixnum(Object *args) { | 342 | proc_is_fixnum(Object *args) { |
332 | // TODO: stub | 343 | if (args->type != OBJ_TYPE_PAIR) { |
333 | return NULL; | 344 | fprintf(stderr, "error: wrong number of arguments.\n"); |
345 | return NULL; | ||
346 | } | ||
347 | Object *obj = eval(args->car); | ||
348 | return obj->type == OBJ_TYPE_FIXNUM ? obj_true : obj_false; | ||
334 | } | 349 | } |
335 | 350 | ||
336 | Object * | 351 | Object * |
337 | proc_is_pair(Object *args) { | 352 | proc_is_pair(Object *args) { |
338 | // TODO: stub | 353 | if (args->type != OBJ_TYPE_PAIR) { |
339 | return NULL; | 354 | fprintf(stderr, "error: wrong number of arguments.\n"); |
355 | return NULL; | ||
356 | } | ||
357 | Object *obj = eval(args->car); | ||
358 | return obj->type == OBJ_TYPE_PAIR ? obj_true : obj_false; | ||
340 | } | 359 | } |
341 | 360 | ||
342 | Object * | 361 | Object * |
343 | proc_is_procedure(Object *args) { | 362 | proc_is_procedure(Object *args) { |
344 | // TODO: stub | 363 | if (args->type != OBJ_TYPE_PAIR) { |
345 | return NULL; | 364 | fprintf(stderr, "error: wrong number of arguments.\n"); |
365 | return NULL; | ||
366 | } | ||
367 | Object *obj = eval(args->car); | ||
368 | return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false; | ||
346 | } | 369 | } |
347 | 370 | ||
348 | // | 371 | // |
diff --git a/tests/booleans_expected.txt b/tests/booleans_expected.txt index 5919767..f47d32f 100644 --- a/tests/booleans_expected.txt +++ b/tests/booleans_expected.txt | |||
@@ -1,10 +1,3 @@ | |||
1 | (boolean? true) -> true | ||
2 | (boolean? false) -> true | ||
3 | (boolean? 1) -> false | ||
4 | (boolean? 5) -> false | ||
5 | (boolean? "string") -> false | ||
6 | (boolean? (+ 1 2 3)) -> false | ||
7 | (boolean? (not 1)) -> true | ||
8 | (not true) -> false | 1 | (not true) -> false |
9 | (not false) -> true | 2 | (not false) -> true |
10 | (not (not true)) -> true | 3 | (not (not true)) -> true |
diff --git a/tests/types_expected.txt b/tests/types_expected.txt new file mode 100644 index 0000000..3a5a2de --- /dev/null +++ b/tests/types_expected.txt | |||
@@ -0,0 +1,53 @@ | |||
1 | (boolean? true) -> true | ||
2 | (boolean? false) -> true | ||
3 | (boolean? 1) -> false | ||
4 | (boolean? 5) -> false | ||
5 | (boolean? "string") -> false | ||
6 | (boolean? (+ 1 2 3)) -> false | ||
7 | (boolean? (not 1)) -> true | ||
8 | (null? true) -> false | ||
9 | (null? false) -> false | ||
10 | (null? 1) -> false | ||
11 | (null? 5) -> false | ||
12 | (null? "string") -> false | ||
13 | (null? (+ 1 2 3)) -> false | ||
14 | (null? (not 1)) -> false | ||
15 | (null? ()) -> true | ||
16 | (string? true) -> false | ||
17 | (string? false) -> false | ||
18 | (string? 1) -> false | ||
19 | (string? 5) -> false | ||
20 | (string? "string") -> true | ||
21 | (string? (+ 1 2 3)) -> false | ||
22 | (string? (not 1)) -> false | ||
23 | (fixnum? true) -> false | ||
24 | (fixnum? false) -> false | ||
25 | (fixnum? 1) -> true | ||
26 | (fixnum? 5) -> true | ||
27 | (fixnum? "string") -> false | ||
28 | (fixnum? (+ 1 2 3)) -> true | ||
29 | (fixnum? (not 1)) -> false | ||
30 | (symbol? true) -> false | ||
31 | (symbol? false) -> false | ||
32 | (symbol? 1) -> false | ||
33 | (symbol? +) -> false | ||
34 | (symbol? "string") -> false | ||
35 | (symbol? (+ 1 2 3)) -> false | ||
36 | (symbol? (not 1)) -> false | ||
37 | (pair? false) -> false | ||
38 | (pair? 1) -> false | ||
39 | (pair? 5) -> false | ||
40 | (pair? "string") -> false | ||
41 | (pair? (+ 1 2 3)) -> false | ||
42 | (pair? (not 1)) -> false | ||
43 | (pair? (cons 1 2)) -> true | ||
44 | (pair? (list 1 2 3)) -> true | ||
45 | (procedure? false) -> false | ||
46 | (procedure? 1) -> false | ||
47 | (procedure? 5) -> false | ||
48 | (procedure? "string") -> false | ||
49 | (procedure? (+ 1 2 3)) -> false | ||
50 | (procedure? (not 1)) -> false | ||
51 | (procedure? +) -> true | ||
52 | (procedure? -) -> true | ||
53 | (procedure? procedure?) -> true | ||