aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBad Diode <bd@badd10de.dev>2021-10-10 18:03:56 +0200
committerBad Diode <bd@badd10de.dev>2021-10-10 18:03:56 +0200
commit43861f9d91782d864dc9866eee1d39288bb3a76d (patch)
tree32a67e5c602f5266aeaf3723020ba9c845c3204a
parent2bbafc053adfd4af01503d3163cba71698855fb0 (diff)
downloadbdl-43861f9d91782d864dc9866eee1d39288bb3a76d.tar.gz
bdl-43861f9d91782d864dc9866eee1d39288bb3a76d.zip
Add list manipulation primitives
-rwxr-xr-xMakefile1
-rw-r--r--examples/lists.bdl24
-rw-r--r--src/bootstrap/primitives.c51
-rw-r--r--tests/lists_expected.txt15
4 files changed, 83 insertions, 8 deletions
diff --git a/Makefile b/Makefile
index 1a3168b..39d2fe0 100755
--- a/Makefile
+++ b/Makefile
@@ -49,6 +49,7 @@ run: $(BIN)
49tests: $(BIN) 49tests: $(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.
54clean: 55clean:
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
611Object * 611Object *
612proc_car(Object *args) { 612proc_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
617Object * 625Object *
618proc_cdr(Object *args) { 626proc_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
623Object * 639Object *
624proc_cons(Object *args) { 640proc_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
629Object * 650Object *
630proc_list(Object *args) { 651proc_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) {
639Object * 670Object *
640proc_equal(Object *args) { 671proc_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)