add more funcs

4 files changed, 158 insertions, 5 deletions

diff --git a/src/builtins.c b/src/builtins.c
index 9dcf497..591dc97 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -7,6 +7,127 @@
 #include <float.h>
 #include <math.h>
 
+SExpRef builtin_setnth(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 3) {
+        return new_error(interp, "set-nth: args num error.\n");
+    }
+    SExpRef n = CAR(args), lst = CADR(args), elem = CADDR(args);
+    if (VALTYPE(n) != kIntegerSExp) return new_error(interp, "set-nth: type error.\n");
+    if (VALTYPE(lst) == kPairSExp) {
+        if (REF(n)->integer >= LENGTH(lst)) {
+            return new_error(interp, "nth: out of bound.\n");
+        }
+        for (int i = 0; i < REF(n)->integer; i++) {
+            lst = CDR(lst);
+        }
+        return REF(lst)->pair.car = elem;
+        return NIL;
+    } else if (VALTYPE(lst) == kStringSExp) {
+        if (REF(n)->integer >= strlen(REF(lst)->str)) {
+            return new_error(interp, "nth: out of bound\n");
+        }
+        if (VALTYPE(elem) != kCharSExp) {
+            return new_error(interp, "set-nth: type error.\n");
+        }
+        ((char*)REF(lst)->str)[REF(n)->integer] = REF(elem)->character;
+        return NIL;
+    } else {
+        return new_error(interp, "nth: type error.\n");
+    }
+}
+
+SExpRef builtin_setnthcdr(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 3) {
+        return new_error(interp, "set-nthcdr: args num error.\n");
+    }
+    SExpRef n = CAR(args), lst = CADR(args), elem = CADDR(args);
+    if (VALTYPE(n) != kIntegerSExp) return new_error(interp, "set-nthcdr: type error.\n");
+    if (VALTYPE(lst) == kPairSExp) {
+        if (REF(n)->integer >= LENGTH(lst)) {
+            return new_error(interp, "set-nthcdr: out of bound.\n");
+        }
+        for (int i = 0; i < REF(n)->integer; i++) {
+            lst = CDR(lst);
+        }
+        return REF(lst)->pair.cdr = elem;
+        return NIL;
+    }
+    return new_error(interp, "set-nthcdr: type error.\n");
+
+}
+
+SExpRef builtin_foldl(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 3) {
+        return new_error(interp, "foldl: args num error.\n");
+    }
+    SExpRef fn = CAR(args), init = CADR(args), lst = CADDR(args);
+    SExpRef ret = init;
+    if (VALTYPE(fn) != kUserFuncSExp && VALTYPE(fn) != kFuncSExp) {
+        return new_error(interp, "foldl: type error.\n");
+    }
+    if (!lisp_check_list(interp, lst)) {
+        return new_error(interp, "foldl: type error.\n");
+    }
+    for (SExpRef i = lst ; !NILP(i); i = CDR(i)) {
+        SExpRef x = CAR(i);
+        ret = lisp_call(interp, fn, new_list2(interp, ret, x));
+        if (CTL_FL(ret)) {
+            return ret;
+        }
+    }
+    return ret;
+}
+
+SExpRef builtin_append(Interp *interp, SExpRef args) {
+    for (SExpRef l = args; !NILP(l); l = CDR(l)) {
+        if (!lisp_check_list(interp, l)) {
+            return new_error(interp, "append: type error.\n");
+        }
+    }
+    SExpRef newlst = NIL;
+    for (SExpRef i = args; !NILP(i); i = CDR(i)) {
+        for (SExpRef j = CAR(i); !NILP(j); j = CDR(j)) {
+            newlst = CONS(CAR(j), newlst);
+        }
+    }
+    return lisp_nreverse(interp, newlst);
+}
+
+SExpRef builtin_nconc(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) {
+        return new_error(interp, "nconc: args num error.\n");
+    }
+    SExpRef l1 = CAR(args), l2= CADR(args);
+    if (!lisp_check_list(interp, l1) || !lisp_check_list(interp, l2)) {
+        return new_error(interp, "nconc: type error.\n");
+    }
+    SExpRef last = NIL;
+    for (SExpRef i = l1; !NILP(i); i = CDR(i)) {
+        if (NILP(CDR(i))) {
+            last = i;
+        }
+    }
+    if (NILP(last)) return l2;
+    REF(last)->pair.cdr = l2;
+    return l1;
+}
+
+SExpRef builtin_logand(Interp *interp, SExpRef args) {
+    if (LENGTH(args) < 1) {
+        return new_error(interp, "nconc: args num error.\n");
+    }
+    for (SExpRef l = args; !NILP(l); l = CDR(l)) {
+        if (VALTYPE(CAR(l)) != kIntegerSExp) {
+            return new_error(interp, "append: type error.\n");
+        }
+    }
+    uint64_t res = 0xffffffffffffffffULL;
+    for (SExpRef l = args; !NILP(l); l = CDR(l)) {
+        res = res & (REF(CAR(l))->integer);
+    }
+    return new_integer(interp, res);
+}
+
 SExpRef builtin_charp(Interp *interp, SExpRef args) {
     if (LENGTH(args) != 1) return new_error(interp, "char?: arg num error.\n");
     return new_boolean(interp, VALTYPE(CAR(args)) == kCharSExp);
@@ -151,7 +272,7 @@ SExpRef builtin_floatp(Interp *interp, SExpRef args) {
 }
 
 SExpRef builtin_nreverse(Interp *interp, SExpRef args) {
-    if (LENGTH(args) != 1) return new_error(interp, "number?: arg num error.\n");
+    if (LENGTH(args) != 1) return new_error(interp, "nreverse: arg num error.\n");
     SExpRef lst = CAR(args);
     if (lisp_check_list(interp, lst)) {
         return lisp_nreverse(interp, lst);        
@@ -160,12 +281,12 @@ SExpRef builtin_nreverse(Interp *interp, SExpRef args) {
 }
 
 SExpRef builtin_reverse(Interp *interp, SExpRef args) {
-    if (LENGTH(args) != 1) return new_error(interp, "number?: arg num error.\n");
+    if (LENGTH(args) != 1) return new_error(interp, "reverse: arg num error.\n");
     SExpRef lst = CAR(args);
     if (lisp_check_list(interp, lst)) {
         return lisp_reverse(interp, lst);        
     }
-    return new_error(interp, "nreverse: type error.\n");
+    return new_error(interp, "reverse: type error.\n");
 }
 
 SExpRef builtin_last(Interp *interp, SExpRef args) {
diff --git a/src/builtins.h b/src/builtins.h
index 673db23..0d3c5cc 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -3,6 +3,12 @@
 
 #include "interp.h"
 
+SExpRef builtin_setnth(Interp *interp, SExpRef args);
+SExpRef builtin_setnthcdr(Interp *interp, SExpRef args);
+SExpRef builtin_foldl(Interp *interp, SExpRef args);
+SExpRef builtin_append(Interp *interp, SExpRef args);
+SExpRef builtin_nconc(Interp *interp, SExpRef args);
+SExpRef builtin_logand(Interp *interp, SExpRef args);
 SExpRef builtin_charp(Interp *interp, SExpRef args);
 SExpRef builtin_char_eq(Interp *interp, SExpRef args);
 SExpRef builtin_char_gt(Interp *interp, SExpRef args);
diff --git a/src/interp.c b/src/interp.c
index 5a4c9b6..e6e9f2a 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -215,6 +215,12 @@ void Interp_init(Interp *self) {
     Interp_add_userfunc(self, "alphabetic?", builtin_alphabeticp);
     Interp_add_userfunc(self, "numeric?", builtin_numericp);
     Interp_add_userfunc(self, "alphanum?", builtin_alphanump);
+    Interp_add_userfunc(self, "set-nth", builtin_setnth);
+    Interp_add_userfunc(self, "set-nthcdr", builtin_setnthcdr);
+    Interp_add_userfunc(self, "foldl", builtin_foldl);
+    Interp_add_userfunc(self, "append", builtin_append);
+    Interp_add_userfunc(self, "nconc", builtin_nconc);
+    Interp_add_userfunc(self, "logand", builtin_logand);
 
     Interp_add_userfunc(self, "_gcstat", builtin_gcstat);
     Interp_add_userfunc(self, "_alwaysgc", builtin_alwaysgc);
@@ -752,6 +758,11 @@ SExpRef lisp_call(Interp *interp, SExpRef fn, SExpRef args) {
         POP_REG();
         if (CTL_FL(ret)) break;
     }
+    if (VALTYPE(ret) == kBreakSignal
+            || VALTYPE(ret) == kContinueSignal
+            || VALTYPE(ret) == kReturnSignal) {
+        return new_error(interp, "call: unexpected control flow signal.\n");
+    }
     return ret;
 }
 
@@ -1062,3 +1073,10 @@ SExpRef new_primitive(Interp *interp, LispPrimitive val) {
     return ret;
 }
 
+SExpRef new_list2(Interp *interp, SExpRef e1, SExpRef e2) {
+    return CONS(e1, CONS(e2, NIL));
+}
+SExpRef new_list3(Interp *interp, SExpRef e1, SExpRef e2, SExpRef e3);
+SExpRef new_list4(Interp *interp, SExpRef e1, SExpRef e2, SExpRef e3, SExpRef e4);
+SExpRef new_list5(Interp *interp, SExpRef e1, SExpRef e2, SExpRef e3, SExpRef e4, SExpRef e5);
+
diff --git a/src/parser.c b/src/parser.c
index d8fda82..ec21b44 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -350,12 +350,20 @@ static ParseResult parse_token(Parser *parser, const char *token) {
         if (len < 2) return ParseErr(parser, "Expect boolean or character.\n");
         if (token[1] == '\'') {
             if (len < 3) return ParseErr(parser, "Expect a symbol.\n");
+            if (len == 3) {
+                if (token[2] == '+' || token[2] == '-') {
+                    goto funcmacro;
+                }
+            }
             if (!is_symbol_init(token[2])) return ParseErr(parser, "Expect a symbol.\n");
             for (int i = 3; i < len; i++) {
                 if (!is_symbol_subsequent(token[i])) return ParseErr(parser, "Expect a symbol.\n");
             }
-            SExpRef funcsym = new_symbol(parser->ctx, "function");
-            SExpRef sym = new_symbol(parser->ctx, token+2);
+            SExpRef funcsym;
+            SExpRef sym;
+        funcmacro:
+            funcsym = new_symbol(parser->ctx, "function");
+            sym = new_symbol(parser->ctx, token+2);
             return ParseOk(lisp_cons(parser->ctx, funcsym, lisp_cons(parser->ctx, sym, parser->ctx->nil)));
         }
         if (token[1] == 't') return ParseOk(new_boolean(parser->ctx, true));