aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/builtins.c127
-rw-r--r--src/builtins.h6
-rw-r--r--src/interp.c18
-rw-r--r--src/parser.c12
-rw-r--r--tests/bitwise.lisp2
-rw-r--r--tests/list.lisp23
-rw-r--r--tests/test.lisp2
7 files changed, 185 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));
diff --git a/tests/bitwise.lisp b/tests/bitwise.lisp
new file mode 100644
index 0000000..7371058
--- /dev/null
+++ b/tests/bitwise.lisp
@@ -0,0 +1,2 @@
+(assert (= 16 (logand 31 16)))
+(assert (= 24 (logand 31 25 24)))
diff --git a/tests/list.lisp b/tests/list.lisp
index 07fd08c..7826afb 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -55,3 +55,26 @@
(assert (not (member? nil (list 1 2))))
(assert (not (member? 3 (list 1 2))))
+ ;;Interp_add_userfunc(self, "nconc", builtin_reverse);
+
+(let ((lst '(1 2 999 4)))
+ (set-nth 2 lst 3)
+ (assert (equal? '(1 2 3 4) lst)))
+
+(let ((lst '(1 2 999 4)))
+ (set-nthcdr 2 lst '(1000 1001))
+ (assert (equal? '(1 2 999 1000 1001) lst)))
+
+(assert (= 10 (foldl #'+ 0 '(1 2 3 4))))
+
+(let ((a '(1 2 3))
+ (b '(4 5 6))
+ (c '(7 8 9)))
+ (assert (equal? '(1 2 3 4 5 6 7 8 9) (append a b c)))
+ (assert (equal? '(1 2 3) a))
+ (assert (equal? '(4 5 6) b))
+ (assert (equal? '(7 8 9) c)))
+
+(let ((a '(1 2 3))
+ (b '(4 5 6)))
+ (assert (equal? '(1 2 3 4 5 6) (nconc a b))))
diff --git a/tests/test.lisp b/tests/test.lisp
index 5d5d807..4013888 100644
--- a/tests/test.lisp
+++ b/tests/test.lisp
@@ -21,6 +21,7 @@
(test-module list)
(test-module type)
(test-module char)
+(test-module bitwise)
(princ "\n\nTest with intensive GC:\n\n")
(_alwaysgc #t)
@@ -41,5 +42,6 @@
(test-module list)
(test-module type)
(test-module char)
+(test-module bitwise)
(exit)
generated by cgit v1.0 at 2025-12-29 13:57:25 +0000