diff options
-rwxr-xr-x | Makefile | 1 | ||||
-rw-r--r-- | examples/lists.bdl | 24 | ||||
-rw-r--r-- | src/bootstrap/primitives.c | 51 | ||||
-rw-r--r-- | tests/lists_expected.txt | 15 |
4 files changed, 83 insertions, 8 deletions
@@ -49,6 +49,7 @@ run: $(BIN) | |||
49 | tests: $(BIN) | 49 | 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 | 53 | ||
53 | # Remove build directory. | 54 | # Remove build directory. |
54 | clean: | 55 | clean: |
diff --git a/examples/lists.bdl b/examples/lists.bdl new file mode 100644 index 0000000..4a27005 --- /dev/null +++ b/examples/lists.bdl | |||
@@ -0,0 +1,24 @@ | |||
1 | ;; | ||
2 | ;; List operations. | ||
3 | ;; | ||
4 | |||
5 | ;; List function. | ||
6 | (print "(list) -> ") (list) | ||
7 | (print "(list 1) -> ") (list 1) | ||
8 | (print "(list 1 2) -> ") (list 1 2) | ||
9 | (print "(list 1 2 3) -> ") (list 1 2 3) | ||
10 | (print "(list 4 5 (+ 1 2 3)) -> ") (list 4 5 (+ 1 2 3)) | ||
11 | |||
12 | ;; Car/cdr. | ||
13 | (print "(car (list 1 2 3)) -> ") (car (list 1 2 3)) | ||
14 | (print "(cdr (list 1 2 3)) -> ") (cdr (list 1 2 3)) | ||
15 | (print "(car (list (* 10 20) (+ 1 2 3) 50 60)) -> ") (car (list (* 10 20) (+ 1 2 3) 50 60)) | ||
16 | (print "(cdr (list (* 10 20) (+ 1 2 3) 50 60)) -> ") (cdr (list (* 10 20) (+ 1 2 3) 50 60)) | ||
17 | (print "(car (cdr (list (* 10 20) (+ 1 2 3) 50 60))) -> ") (car (cdr (list (* 10 20) (+ 1 2 3) 50 60))) | ||
18 | |||
19 | ;; Pairs construction. | ||
20 | (print "(cons 1 2) -> ") (cons 1 2) | ||
21 | (print "(cons \"a\" \"b\") -> ") (cons "a" "b") | ||
22 | (print "(cons \"a\" (cons \"c\" ())) -> ") (cons "a" (cons "c" ())) | ||
23 | (print "(cons 1 (cons 2 (cons (+ 1 2) ()))) -> ") (cons 1 (cons 2 (cons (+ 1 2) ()))) | ||
24 | (print "(cons 1 (cons 2 (cons (+ 1 2) 4))) -> ") (cons 1 (cons 2 (cons (+ 1 2) 4))) | ||
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index f6b354e..6300067 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c | |||
@@ -610,26 +610,57 @@ proc_num_equal(Object *args) { | |||
610 | 610 | ||
611 | Object * | 611 | Object * |
612 | proc_car(Object *args) { | 612 | proc_car(Object *args) { |
613 | // TODO: stub | 613 | if (args == obj_nil) { |
614 | return NULL; | 614 | fprintf(stderr, "error: not enough arguments\n"); |
615 | return obj_nil; | ||
616 | } | ||
617 | Object *obj = eval(args->car); | ||
618 | if (obj->type != OBJ_TYPE_PAIR) { | ||
619 | fprintf(stderr, "error: wrong argument type\n"); | ||
620 | return obj_nil; | ||
621 | } | ||
622 | return obj->car; | ||
615 | } | 623 | } |
616 | 624 | ||
617 | Object * | 625 | Object * |
618 | proc_cdr(Object *args) { | 626 | proc_cdr(Object *args) { |
619 | // TODO: stub | 627 | if (args == obj_nil) { |
620 | return NULL; | 628 | fprintf(stderr, "error: not enough arguments\n"); |
629 | return obj_nil; | ||
630 | } | ||
631 | Object *obj = eval(args->car); | ||
632 | if (obj->type != OBJ_TYPE_PAIR) { | ||
633 | fprintf(stderr, "error: wrong argument type\n"); | ||
634 | return obj_nil; | ||
635 | } | ||
636 | return obj->cdr; | ||
621 | } | 637 | } |
622 | 638 | ||
623 | Object * | 639 | Object * |
624 | proc_cons(Object *args) { | 640 | proc_cons(Object *args) { |
625 | // TODO: stub | 641 | if (args == obj_nil || args->cdr == obj_nil) { |
626 | return NULL; | 642 | fprintf(stderr, "error: not enough arguments\n"); |
643 | return obj_nil; | ||
644 | } | ||
645 | Object *a = eval(args->car); | ||
646 | Object *b = eval(args->cdr->car); | ||
647 | return make_pair(a, b); | ||
627 | } | 648 | } |
628 | 649 | ||
629 | Object * | 650 | Object * |
630 | proc_list(Object *args) { | 651 | proc_list(Object *args) { |
631 | // TODO: stub | 652 | if (args == obj_nil) { |
632 | return NULL; | 653 | return obj_nil; |
654 | } | ||
655 | Object *head = make_pair(eval(args->car), obj_nil); | ||
656 | Object *curr = head; | ||
657 | args = args->cdr; | ||
658 | while (args != obj_nil) { | ||
659 | curr->cdr = make_pair(eval(args->car), obj_nil); | ||
660 | curr = curr->cdr; | ||
661 | args = args->cdr; | ||
662 | } | ||
663 | return head; | ||
633 | } | 664 | } |
634 | 665 | ||
635 | // | 666 | // |
@@ -639,6 +670,7 @@ proc_list(Object *args) { | |||
639 | Object * | 670 | Object * |
640 | proc_equal(Object *args) { | 671 | proc_equal(Object *args) { |
641 | // TODO: stub | 672 | // TODO: stub |
673 | (void) args; | ||
642 | return NULL; | 674 | return NULL; |
643 | } | 675 | } |
644 | 676 | ||
@@ -649,3 +681,6 @@ proc_equal(Object *args) { | |||
649 | // TODO: LAMBDA | 681 | // TODO: LAMBDA |
650 | // TODO: let | 682 | // TODO: let |
651 | // TODO: better error handling? | 683 | // TODO: better error handling? |
684 | // TODO: Revise all instances where we are returning an object, since currently | ||
685 | // we may be returning a pointer to an object instead of a new one. Check also | ||
686 | // on eval function and everytime we do make_xxx(obj). | ||
diff --git a/tests/lists_expected.txt b/tests/lists_expected.txt new file mode 100644 index 0000000..9030886 --- /dev/null +++ b/tests/lists_expected.txt | |||
@@ -0,0 +1,15 @@ | |||
1 | (list) -> () | ||
2 | (list 1) -> (1) | ||
3 | (list 1 2) -> (1 2) | ||
4 | (list 1 2 3) -> (1 2 3) | ||
5 | (list 4 5 (+ 1 2 3)) -> (4 5 6) | ||
6 | (car (list 1 2 3)) -> 1 | ||
7 | (cdr (list 1 2 3)) -> (2 3) | ||
8 | (car (list (* 10 20) (+ 1 2 3) 50 60)) -> 200 | ||
9 | (cdr (list (* 10 20) (+ 1 2 3) 50 60)) -> (6 50 60) | ||
10 | (car (cdr (list (* 10 20) (+ 1 2 3) 50 60))) -> 6 | ||
11 | (cons 1 2) -> (1 . 2) | ||
12 | (cons "a" "b") -> ("a" . "b") | ||
13 | (cons "a" (cons "c" ())) -> ("a" "c") | ||
14 | (cons 1 (cons 2 (cons (+ 1 2) ()))) -> (1 2 3) | ||
15 | (cons 1 (cons 2 (cons (+ 1 2) 4))) -> (1 2 3 . 4) | ||