Fix printing

lisp/kernel.gl

@@ -113,5 +113,4 @@ Spec is of the form (VARIABLE LIST &optional RETURN-FORM)."
   (princ datum print-char-fun)
   (terpri print-char-fun))
 
-(princln (mapc (lambda (x) (+ x 1))
+(princln (nconc '(1 2) '(4 . 6) '(3 4)))
-                 '(1 2 3)))

src/lisp_string.c

@@ -170,3 +170,56 @@ DEFUN(aset, "aset", (LispVal * arr, LispVal *idx, LispVal *data),
     v->data[i] = data;
     return data;
 }
+
+DEFUN(concat, "concat", (LispVal * strings), "(&rest strings)", "") {
+    char *out = lisp_malloc(1);
+    size_t out_size = 0;
+    DOLIST(cur, strings) {
+        if (STRINGP(cur)) {
+            LispString *s = cur;
+            out = lisp_realloc(out, out_size + s->length + 1);
+            memcpy(out + out_size, s->data, s->length);
+            out_size += s->length;
+            out[out_size] = '\0';
+        } else if (VECTORP(cur)) {
+            LispVector *v = cur;
+            out = lisp_realloc(out, out_size + v->length + 1);
+            for (size_t i = 0; i < v->length; ++i) {
+                if (NILP(Fcharp(v->data[i]))) {
+                    free(out);
+                    signal_type_error(v->data[i], Qchar);
+                }
+                out[out_size + i] = XFIXNUM(v->data[i]);
+            }
+            out_size += v->length;
+            out[out_size] = '\0';
+        } else if (CONSP(cur)) {
+            size_t len = list_length(cur);
+            if (len == -1) {
+                free(out);
+                lisp_signal(Qcircular_list_error, Qnil);
+            }
+            out = lisp_realloc(out, out_size + len + 1);
+            size_t i = 0;
+            DOTAILS(rest, cur) {
+                if (!CONSP(rest)) {
+                    free(out);
+                    signal_type_error(rest, Qlist);
+                }
+                LispVal *c = XCAR(rest);
+                if (NILP(Fcharp(c))) {
+                    free(out);
+                    signal_type_error(c, Qchar);
+                }
+                out[out_size + i] = XFIXNUM(c);
+            }
+            out_size += len;
+            out[out_size] = '\0';
+        } else if (!NILP(cur)) {
+            // empty list is a noop
+            free(out);
+            signal_type_error(cur, LIST(Qstring, Qvector, Qlist));
+        }
+    }
+    return make_lisp_string(out, out_size, true, false);
+}

src/lisp_string.h

@@ -47,5 +47,6 @@ DECLARE_FUNCTION(vectorp, (LispVal * data));
 // ########
 DECLARE_FUNCTION(aref, (LispVal * arr, LispVal *idx));
 DECLARE_FUNCTION(aset, (LispVal * arr, LispVal *idx, LispVal *data));
+DECLARE_FUNCTION(concat, (LispVal * strings));
 
 #endif

src/list.c

@@ -1,7 +1,6 @@
 #include "list.h"
 
 #include "function.h"
-#include "stack.h"
 
 DEFINE_SYMBOL(circular_list_error, "circular-list-error");
 DEFINE_CONDITION_CLASS(circular_list_error, error);
@@ -85,6 +84,41 @@ DEFUN(nreverse, "nreverse", (LispVal * list), "(list)", "") {
     return rev;
 }
 
+DEFUN(reverse, "reverse", (LispVal * list), "(list)", "") {
+    LispVal *out = Qnil;
+    DOLIST_SAFE(cur, list) {
+        out = CONS(cur, out);
+    }
+    return out;
+}
+
+DEFUN(append, "append", (LispVal * lists), "(&rest lists)", "") {
+    return Qnil;
+}
+
+DEFUN(nconc, "nconc", (LispVal * lists), "(&rest lists)", "") {
+    LispVal *out = Qnil;
+    LispVal *end = Qnil;
+    DOTAILS(rest, lists) {
+        LispVal *cur = XCAR(rest);
+        CHECK_LISTP(cur);
+        if (NILP(cur)) {
+            continue;
+        }
+        if (NILP(out)) {
+            out = cur;
+            end = Flast(cur);
+        } else {
+            RPLACD(end, cur);
+            end = Flast(cur);
+        }
+        if (!NILP(XCDR(end)) && !NILP(XCDR(rest))) {
+            signal_type_error(cur, Qlist);
+        }
+    }
+    return out;
+}
+
 DEFUN(last, "last", (LispVal * list), "(list)", "") {
     if (NILP(list)) {
         return Qnil;

src/list.h

@@ -129,6 +129,9 @@ DECLARE_FUNCTION(rplaca, (LispVal * cons, LispVal *newcar));
 DECLARE_FUNCTION(rplacd, (LispVal * cons, LispVal *newcdr));
 DECLARE_FUNCTION(length_eq, (LispVal * list, LispVal *length));
 DECLARE_FUNCTION(nreverse, (LispVal * list));
+DECLARE_FUNCTION(reverse, (LispVal * list));
+DECLARE_FUNCTION(append, (LispVal * lists));
+DECLARE_FUNCTION(nconc, (LispVal * lists));
 DECLARE_FUNCTION(last, (LispVal * list));
 DECLARE_FUNCTION(listp, (LispVal * obj));
 DECLARE_FUNCTION(proper_list_p, (LispVal * obj));

src/print.c

@@ -296,6 +296,7 @@ static void print_cons(struct PrintContext *restrict pc, LispVal *val) {
         print_driver(pc, SECOND(val));
         return;
     }
+    size_t level = 1;
     bool first = true;
     DOTAILS(rest, val) {
         if (recursive_object_p(pc, rest)) {
@@ -309,8 +310,8 @@ static void print_cons(struct PrintContext *restrict pc, LispVal *val) {
                 print_numbered_reference(pc, rest, '=');
                 mark_object_printed(pc, rest);
                 if (!first) {
-                    print_cons(pc, rest);
+                    first = true;
-                    break;
+                    ++level;
                 }
             }
         }
@@ -327,8 +328,10 @@ static void print_cons(struct PrintContext *restrict pc, LispVal *val) {
             break;
         }
     }
+    for (size_t i = 0; i < level; ++i) {
         print_char(pc, ')');
     }
+}
 
 static void print_readable_string(struct PrintContext *restrict pc,
                                   LispVal *val) {