diff --git a/lisp/kernel.gl b/lisp/kernel.gl index 23cd3ff..b6dbac5 100644 --- a/lisp/kernel.gl +++ b/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)) - '(1 2 3))) +(princln (nconc '(1 2) '(4 . 6) '(3 4))) diff --git a/src/lisp_string.c b/src/lisp_string.c index c4d3be0..d5c87a8 100644 --- a/src/lisp_string.c +++ b/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); +} diff --git a/src/lisp_string.h b/src/lisp_string.h index f34fce6..eaab070 100644 --- a/src/lisp_string.h +++ b/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 diff --git a/src/list.c b/src/list.c index 5336f68..029565d 100644 --- a/src/list.c +++ b/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; diff --git a/src/list.h b/src/list.h index 9f5467a..a77d2fb 100644 --- a/src/list.h +++ b/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)); diff --git a/src/print.c b/src/print.c index ccefa32..8ee8529 100644 --- a/src/print.c +++ b/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); - break; + first = true; + ++level; } } } @@ -327,7 +328,9 @@ static void print_cons(struct PrintContext *restrict pc, LispVal *val) { break; } } - print_char(pc, ')'); + for (size_t i = 0; i < level; ++i) { + print_char(pc, ')'); + } } static void print_readable_string(struct PrintContext *restrict pc,