aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/builtins.c105
-rw-r--r--src/builtins.h5
-rw-r--r--src/interp.c20
-rw-r--r--src/sexp.h14
4 files changed, 135 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
generated by cgit v1.0 at 2025-12-29 17:46:52 +0000