From 43861f9d91782d864dc9866eee1d39288bb3a76d Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Sun, 10 Oct 2021 18:03:56 +0200
Subject: Add list manipulation primitives

---
 Makefile                   |  1 +
 examples/lists.bdl         | 24 ++++++++++++++++++++++
 src/bootstrap/primitives.c | 51 ++++++++++++++++++++++++++++++++++++++--------
 tests/lists_expected.txt   | 15 ++++++++++++++
 4 files changed, 83 insertions(+), 8 deletions(-)
 create mode 100644 examples/lists.bdl
 create mode 100644 tests/lists_expected.txt

diff --git a/Makefile b/Makefile
index 1a3168b..39d2fe0 100755
--- a/Makefile
+++ b/Makefile
@@ -49,6 +49,7 @@ run: $(BIN)
 tests: $(BIN)
 	./$(BIN) examples/arithmetic.bdl | diff tests/arithmetic_expected.txt -
 	./$(BIN) examples/booleans.bdl | diff tests/booleans_expected.txt -
+	./$(BIN) examples/lists.bdl | diff tests/lists_expected.txt -
 
 # Remove build directory.
 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 @@
+;;
+;; List operations.
+;;
+
+;; List function.
+(print "(list) -> ") (list)
+(print "(list 1) -> ") (list 1)
+(print "(list 1 2) -> ") (list 1 2)
+(print "(list 1 2 3) -> ") (list 1 2 3)
+(print "(list 4 5 (+ 1 2 3)) -> ") (list 4 5 (+ 1 2 3))
+
+;; Car/cdr.
+(print "(car (list 1 2 3)) -> ") (car (list 1 2 3))
+(print "(cdr (list 1 2 3)) -> ") (cdr (list 1 2 3))
+(print "(car (list (* 10 20) (+ 1 2 3) 50 60)) -> ") (car (list (* 10 20) (+ 1 2 3) 50 60))
+(print "(cdr (list (* 10 20) (+ 1 2 3) 50 60)) -> ") (cdr (list (* 10 20) (+ 1 2 3) 50 60))
+(print "(car (cdr (list (* 10 20) (+ 1 2 3) 50 60))) -> ") (car (cdr (list (* 10 20) (+ 1 2 3) 50 60)))
+
+;; Pairs construction.
+(print "(cons 1 2) -> ") (cons 1 2)
+(print "(cons \"a\" \"b\") -> ") (cons "a" "b")
+(print "(cons \"a\" (cons \"c\" ())) -> ") (cons "a" (cons "c" ()))
+(print "(cons 1 (cons 2 (cons (+ 1 2) ()))) -> ") (cons 1 (cons 2 (cons (+ 1 2) ())))
+(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) {
 
 Object *
 proc_car(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args == obj_nil) {
+        fprintf(stderr, "error: not enough arguments\n");
+        return obj_nil;
+    }
+    Object *obj = eval(args->car);
+    if (obj->type != OBJ_TYPE_PAIR) {
+        fprintf(stderr, "error: wrong argument type\n");
+        return obj_nil;
+    }
+    return obj->car;
 }
 
 Object *
 proc_cdr(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args == obj_nil) {
+        fprintf(stderr, "error: not enough arguments\n");
+        return obj_nil;
+    }
+    Object *obj = eval(args->car);
+    if (obj->type != OBJ_TYPE_PAIR) {
+        fprintf(stderr, "error: wrong argument type\n");
+        return obj_nil;
+    }
+    return obj->cdr;
 }
 
 Object *
 proc_cons(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args == obj_nil || args->cdr == obj_nil) {
+        fprintf(stderr, "error: not enough arguments\n");
+        return obj_nil;
+    }
+    Object *a = eval(args->car);
+    Object *b = eval(args->cdr->car);
+    return make_pair(a, b);
 }
 
 Object *
 proc_list(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args == obj_nil) {
+        return obj_nil;
+    }
+    Object *head = make_pair(eval(args->car), obj_nil);
+    Object *curr = head;
+    args = args->cdr;
+    while (args != obj_nil) {
+        curr->cdr = make_pair(eval(args->car), obj_nil);
+        curr = curr->cdr;
+        args = args->cdr;
+    }
+    return head;
 }
 
 //
@@ -639,6 +670,7 @@ proc_list(Object *args) {
 Object *
 proc_equal(Object *args) {
     // TODO: stub
+    (void) args;
     return NULL;
 }
 
@@ -649,3 +681,6 @@ proc_equal(Object *args) {
 // TODO: LAMBDA
 // TODO: let
 // TODO: better error handling?
+// TODO: Revise all instances where we are returning an object, since currently
+// we may be returning a pointer to an object instead of a new one. Check also
+// 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 @@
+(list) -> ()
+(list 1) -> (1)
+(list 1 2) -> (1 2)
+(list 1 2 3) -> (1 2 3)
+(list 4 5 (+ 1 2 3)) -> (4 5 6)
+(car (list 1 2 3)) -> 1
+(cdr (list 1 2 3)) -> (2 3)
+(car (list (* 10 20) (+ 1 2 3) 50 60)) -> 200
+(cdr (list (* 10 20) (+ 1 2 3) 50 60)) -> (6 50 60)
+(car (cdr (list (* 10 20) (+ 1 2 3) 50 60))) -> 6
+(cons 1 2) -> (1 . 2)
+(cons "a" "b") -> ("a" . "b")
+(cons "a" (cons "c" ())) -> ("a" "c")
+(cons 1 (cons 2 (cons (+ 1 2) ()))) -> (1 2 3)
+(cons 1 (cons 2 (cons (+ 1 2) 4))) -> (1 2 3 . 4)
-- 
cgit v1.2.1