add list funcs

5 files changed, 139 insertions, 9 deletions

diff --git a/src/builtins.c b/src/builtins.c
index 04afbcb..d6db48a 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -6,6 +6,111 @@
 #include <float.h>
 #include <math.h>
 
+SExpRef builtin_map(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) return new_error(interp, "map: wrong arg num.\n");
+    SExpRef fn = CAR(args), lst = CADR(args);
+    if (VALTYPE(fn) != kFuncSExp && VALTYPE(fn) != kUserFuncSExp) {
+        return new_error(interp, "map: type error.\n");
+    }
+    if (!lisp_check_list(interp, lst)) {
+        return new_error(interp, "map: type error.");
+    }
+    SExpRef newlst = NIL;
+    for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
+        SExpRef x = CAR(i);
+        PUSH_REG(newlst);
+        SExpRef newx = lisp_apply(interp, fn, CONS(x, NIL), false);
+        POP_REG();
+        if (CTL_FL(newx)) return newx;
+        newlst = CONS(newx, newlst);
+    }
+    return lisp_nreverse(interp, newlst);
+}
+
+SExpRef builtin_filter(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) return new_error(interp, "map: wrong arg num.\n");
+    SExpRef fn = CAR(args), lst = CADR(args);
+    if (VALTYPE(fn) != kFuncSExp && VALTYPE(fn) != kUserFuncSExp) {
+        return new_error(interp, "map: type error.\n");
+    }
+    if (!lisp_check_list(interp, lst)) {
+        return new_error(interp, "map: type error.");
+    }
+    SExpRef newlst = NIL;
+    for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
+        SExpRef x = CAR(i);
+        PUSH_REG(newlst);
+        SExpRef pred = lisp_apply(interp, fn, CONS(x, NIL), false);
+        POP_REG();
+        if (CTL_FL(pred)) return pred;
+        if (TRUEP(pred)) {
+            newlst = CONS(pred, newlst);
+        }
+    }
+    return lisp_nreverse(interp, newlst);
+}
+
+SExpRef builtin_remove(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) return new_error(interp, "remove: wrong arg num.\n");
+    SExpRef fn = CAR(args), lst = CADR(args);
+    if (VALTYPE(fn) != kFuncSExp && VALTYPE(fn) != kUserFuncSExp) {
+        return new_error(interp, "remove: type error.\n");
+    }
+    if (!lisp_check_list(interp, lst)) {
+        return new_error(interp, "remove: type error.");
+    }
+    SExpRef newlst = NIL;
+    for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
+        SExpRef x = CAR(i);
+        PUSH_REG(newlst);
+        SExpRef pred = lisp_apply(interp, fn, CONS(x, NIL), false);
+        POP_REG();
+        if (CTL_FL(pred)) return pred;
+        if (!TRUEP(pred)) {
+            newlst = CONS(pred, newlst);
+        }
+    }
+    return lisp_nreverse(interp, newlst);
+}
+
+SExpRef builtin_count(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) return new_error(interp, "count: wrong arg num.\n");
+    SExpRef fn = CAR(args), lst = CADR(args);
+    if (VALTYPE(fn) != kFuncSExp && VALTYPE(fn) != kUserFuncSExp) {
+        return new_error(interp, "count: type error.\n");
+    }
+    if (!lisp_check_list(interp, lst)) {
+        return new_error(interp, "count: type error.");
+    }
+    int count = 0;
+    for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
+        SExpRef x = CAR(i);
+        SExpRef pred = lisp_apply(interp, fn, CONS(x, NIL), false);
+        if (CTL_FL(pred)) return pred;
+        if (TRUEP(pred)) {
+            count++;
+        }
+    }
+    return new_integer(interp, count);
+}
+
+SExpRef builtin_foreach(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) return new_error(interp, "foreach: wrong arg num.\n");
+    SExpRef fn = CAR(args), lst = CADR(args);
+    if (VALTYPE(fn) != kFuncSExp && VALTYPE(fn) != kUserFuncSExp) {
+        return new_error(interp, "foreach: type error.\n");
+    }
+    if (!lisp_check_list(interp, lst)) {
+        return new_error(interp, "foreach: type error.");
+    }
+    for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
+        SExpRef x = CAR(i);
+        SExpRef newx = lisp_apply(interp, fn, CONS(x, NIL), false);
+        if (CTL_FL(newx)) return newx;
+    }
+    return NIL;
+}
+
 SExpRef builtin_set_car(Interp *interp, SExpRef args) {
     if (LENGTH(args) != 2) {
         return new_error(interp, "set-car: args num error.\n");
diff --git a/src/builtins.h b/src/builtins.h
index 3832afb..e7712d4 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -3,6 +3,11 @@
 
 #include "interp.h"
 
+SExpRef builtin_map(Interp *interp, SExpRef args);
+SExpRef builtin_filter(Interp *interp, SExpRef args);
+SExpRef builtin_remove(Interp *interp, SExpRef args);
+SExpRef builtin_count(Interp *interp, SExpRef args);
+SExpRef builtin_foreach(Interp *interp, SExpRef args);
 SExpRef builtin_set_car(Interp *interp, SExpRef args);
 SExpRef builtin_set_cdr(Interp *interp, SExpRef args);
 SExpRef builtin_length(Interp *interp, SExpRef args);
diff --git a/src/interp.c b/src/interp.c
index 65eeaff..3d7b318 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -88,6 +88,11 @@ void Interp_init(Interp *self) {
     Interp_add_primitive(self, "assert-error", primitive_assert_error);
     Interp_add_primitive(self, "load", primitive_load);
 
+    Interp_add_userfunc(self, "map", builtin_map);
+    Interp_add_userfunc(self, "filter", builtin_filter);
+    Interp_add_userfunc(self, "remove", builtin_remove);
+    Interp_add_userfunc(self, "count", builtin_count);
+    Interp_add_userfunc(self, "foreach", builtin_foreach);
     Interp_add_userfunc(self, "symbol->string", builtin_symbol2string);
     Interp_add_userfunc(self, "intern", builtin_intern);
     Interp_add_userfunc(self, "gensym", builtin_gensym);
@@ -478,13 +483,6 @@ SExpRef lisp_macroexpand1(Interp *interp, SExpRef macro, SExpRef args) {
     PUSH_REG(fn);
     SExpRef ret = lisp_apply(interp, fn, args, false);
     POP_REG();
-    while (VALTYPE(ret) == kTailcallSExp) {
-        fn = REF(ret)->tailcall.fn;
-        args = REF(ret)->tailcall.args;
-        PUSH_REG(ret);
-        ret = lisp_apply(interp, fn, args, false);
-        POP_REG();
-    }
     return ret;
 error:
     return new_error(interp, "macroexpand: syntax error.\n");
@@ -736,6 +734,14 @@ end:
     if (VALTYPE(ret) == kReturnSignal) {
         ret = REF(ret)->ret;
     }
+    if (VALTYPE(ret) == kTailcallSExp && !istail) {
+        fn = REF(ret)->tailcall.fn;
+        args = REF(ret)->tailcall.args;
+        PUSH_REG(ret);
+        ret = lisp_apply(interp, fn, args, false);
+        POP_REG();
+        goto end;
+    }
     interp->stack = CDR(interp->stack);
     interp->recursion_depth--;
     return ret;
diff --git a/src/sexp.h b/src/sexp.h
index 8275dfd..2923088 100644
--- a/src/sexp.h
+++ b/src/sexp.h
@@ -75,6 +75,14 @@ typedef enum {
     kTailcallSExp,
 } SExpType;
 
+VECTOR_DEF(SExpRef);
+
+typedef struct {
+    SExpRef type;
+    void (*free)(void *self);
+    void (*gcmark)(SExpRefVector *gcstack, void *self);
+} LispUserdataMeta;
+
 struct sexp {
     bool marked;
     SExpType type;
@@ -84,7 +92,10 @@ struct sexp {
         bool boolean;
         char character;
         const char *str;
-        const void *userdata;
+        struct {
+            const void *userdata;
+            LispUserdataMeta *userdata_meta;
+        };
         SExpPair pair;
         SExpFunc func;
         LispUserFunc userfunc;
@@ -101,7 +112,6 @@ void SExp_show(SExp self, FILE* fp);
 void SExpRef_show(SExpRef self, FILE* fp);
 
 VECTOR_DEF(SExp);
-VECTOR_DEF(SExpRef);
 
 #endif
 
diff --git a/tests/list.lisp b/tests/list.lisp
index 168ccf2..e154458 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -15,9 +15,13 @@
 (assert-error (set-cdr (list 1) (list 2) (list 3)))
 (assert-error (set-cdr ""))
 
+
 (assert (= 3 (length (list 1 2 3))))
 (assert (= 0 (length nil)))
 
 (assert (= 3 (nth 2 (list 1 2 3))))
 (assert (equal? nil (nthcdr 2 (list 1 2 3))))
 (assert (equal? (list 3) (nthcdr 1 (list 1 2 3))))
+
+(assert (equal? (list 1 2 3 4)
+                (map (lambda (x) (+ 1 x)) (list 0 1 2 3))))