aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/interp.c132
-rw-r--r--src/interp.h23
-rw-r--r--src/primitives.c14
-rw-r--r--src/sexp.h3
4 files changed, 98 insertions, 74 deletions
diff --git a/src/interp.c b/src/interp.c
index ba8ba95..f055bce 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -14,10 +14,10 @@
#define BUFSIZE 1024
-void PrimitiveEntry_show(PrimitiveEntry self, FILE *fp) { }
-VECTOR_IMPL(PrimitiveEntry);
+void TopBinding_show(TopBinding self, FILE *fp) { }
+VECTOR_IMPL(TopBinding);
-SExpRef unbound = {-1};
+#define UNBOUND ((SExpRef){-1})
void Interp_init(Interp *self) {
self->parser = malloc(sizeof(Parser));
@@ -26,7 +26,7 @@ void Interp_init(Interp *self) {
self->errmsg_buf = malloc(BUFSIZE);
SExpVector_init(&self->objs);
IntVector_init(&self->empty_space);
- PrimitiveEntryVector_init(&self->primitives);
+ TopBindingVector_init(&self->topbindings);
String2IntHashTable_init(&self->symbols);
int i = 0;
SExp sexp;
@@ -109,7 +109,6 @@ void Interp_init(Interp *self) {
Interp_add_userfunc(self, "<=", builtin_le);
Interp_add_userfunc(self, "not", builtin_not);
Interp_add_userfunc(self, "exit", builtin_exit);
- // debug functions
Interp_add_userfunc(self, "_gcstat", builtin_gcstat);
SExpRef ret = Interp_eval_string(self, bamboo_lisp_prelude);
@@ -180,7 +179,8 @@ end:
void Interp_add_userfunc(Interp *interp, const char *name, LispUserFunc fn) {
SExpRef userfunc = new_userfunc(interp, fn);
- lisp_defun(interp, name, userfunc);
+ SExpRef sym = new_symbol(interp, name);
+ lisp_defun(interp, sym, userfunc);
}
void Interp_free(Interp *self) {
@@ -198,7 +198,7 @@ void Interp_free(Interp *self) {
String2IntHashTable_free(&self->symbols);
SExpVector_free(&self->objs);
IntVector_free(&self->empty_space);
- PrimitiveEntryVector_free(&self->primitives);
+ TopBindingVector_free(&self->topbindings);
free(self->errmsg_buf);
Parser_free(self->parser);
free(self->parser);
@@ -211,10 +211,9 @@ SExp* Interp_ref(Interp *self, SExpRef ref) {
}
void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn) {
- PrimitiveEntryVector_push_back(&self->primitives, (PrimitiveEntry){
- .name = name,
- .fn = fn
- });
+ SExpRef sym = new_symbol(self, name);
+ SExpRef prim = new_primitive(self, fn);
+ lisp_defun(self, sym, prim);
}
void Interp_gc(Interp *interp, SExpRef tmproot) {
@@ -419,46 +418,48 @@ error:
return new_error(interp, "macroexpand: syntax error.\n");
}
-void lisp_defun(Interp *interp, const char *name, SExpRef val) {
+void lisp_defun(Interp *interp, SExpRef name, SExpRef val) {
SExpRef binding = REF(interp->top_level)->env.bindings;
while (REF(binding)->type != kNilSExp) {
- if (strcmp(name, REF(REF(binding)->binding.name)->str) == 0) {
+ if (name.idx == REF(binding)->binding.name.idx) {
REF(binding)->binding.func = val;
return;
}
binding = REF(binding)->binding.next;
}
binding = REF(interp->top_level)->env.bindings;
- SExpRef newbinding = new_binding(interp, new_symbol(interp, name), NIL);
+ SExpRef newbinding = new_binding(interp, name, NIL);
REF(newbinding)->binding.func = val;
- REF(newbinding)->binding.value = unbound;
+ REF(newbinding)->binding.value = UNBOUND;
REF(newbinding)->binding.next = binding;
REF(interp->top_level)->env.bindings = newbinding;
+ TopBindingVector_push_back(&interp->topbindings, (TopBinding){name, newbinding});
}
-void lisp_defvar(Interp *interp, const char *name, SExpRef val) {
+void lisp_defvar(Interp *interp, SExpRef name, SExpRef val) {
SExpRef binding = REF(interp->top_level)->env.bindings;
while (REF(binding)->type != kNilSExp) {
- if (strcmp(name, REF(REF(binding)->binding.name)->str) == 0) {
+ if (name.idx == REF(binding)->binding.name.idx) {
REF(binding)->binding.value = val;
return;
}
binding = REF(binding)->binding.next;
}
binding = REF(interp->top_level)->env.bindings;
- SExpRef newbinding = new_binding(interp, new_symbol(interp, name), NIL);
- REF(newbinding)->binding.func = unbound;
+ SExpRef newbinding = new_binding(interp, name, NIL);
+ REF(newbinding)->binding.func = UNBOUND;
REF(newbinding)->binding.value = val;
REF(newbinding)->binding.next = binding;
REF(interp->top_level)->env.bindings = newbinding;
+ TopBindingVector_push_back(&interp->topbindings, (TopBinding){name, newbinding});
}
-SExpRef lisp_setq(Interp *interp, const char *name, SExpRef val) {
+SExpRef lisp_setq(Interp *interp, SExpRef name, SExpRef val) {
SExpRef env = CAR(interp->stack);
while (REF(env)->type != kNilSExp) {
SExpRef binding = REF(env)->env.bindings;
while (REF(binding)->type != kNilSExp) {
- if (strcmp(name, REF(REF(binding)->binding.name)->str) == 0) {
+ if (name.idx == REF(binding)->binding.name.idx) {
REF(binding)->binding.value = val;
return val;
}
@@ -466,15 +467,20 @@ SExpRef lisp_setq(Interp *interp, const char *name, SExpRef val) {
}
env = REF(env)->env.parent;
}
- return new_error(interp, "Unbound variable: %s.\n", name);
+ return new_error(interp, "Unbound variable: %s.\n", REF(name)->str);
}
-SExpRef lisp_lookup(Interp *interp, const char *name) {
+SExpRef lisp_lookup_topvar(Interp *interp, SExpRef name);
+
+SExpRef lisp_lookup(Interp *interp, SExpRef name) {
SExpRef env = CAR(interp->stack);
while (REF(env)->type != kNilSExp) {
+ if (env.idx == interp->top_level.idx) {
+ return lisp_lookup_topvar(interp, name);
+ }
SExpRef binding = REF(env)->env.bindings;
while (REF(binding)->type != kNilSExp) {
- if (strcmp(name, REF(REF(binding)->binding.name)->str) == 0) {
+ if (name.idx == REF(binding)->binding.name.idx) {
SExpRef ret = REF(binding)->binding.value;
if (ret.idx < 0) goto notfound;
return ret;
@@ -484,7 +490,7 @@ SExpRef lisp_lookup(Interp *interp, const char *name) {
env = REF(env)->env.parent;
}
notfound:
- return new_error(interp, "Unbound variable: %s.\n", name);
+ return new_error(interp, "Unbound variable: %s.\n", REF(name)->str);
}
void lisp_print(Interp *interp, SExpRef obj, FILE *fp) {
@@ -493,18 +499,32 @@ void lisp_print(Interp *interp, SExpRef obj, FILE *fp) {
free((void*)str);
}
-SExpRef lisp_lookup_func(Interp *interp, const char *name) {
- SExpRef binding = REF(interp->top_level)->env.bindings;
- while (REF(binding)->type != kNilSExp) {
- if (strcmp(name, REF(REF(binding)->binding.name)->str) == 0) {
- SExpRef ret = REF(binding)->binding.func;
+SExpRef lisp_lookup_topvar(Interp *interp, SExpRef name) {
+ int topbindings_len = TopBindingVector_len(&interp->topbindings);
+ for (int i = 0; i < topbindings_len; i++) {
+ TopBinding topbinding = interp->topbindings.buffer[i];
+ if (topbinding.name.idx == name.idx) {
+ SExpRef ret = REF(topbinding.binding)->binding.value;
+ if (ret.idx < 0) goto notfound;
+ return ret;
+ }
+ }
+notfound:
+ return new_error(interp, "Unbound variable: %s.\n", REF(name)->str);
+}
+
+SExpRef lisp_lookup_func(Interp *interp, SExpRef name) {
+ int topbindings_len = TopBindingVector_len(&interp->topbindings);
+ for (int i = 0; i < topbindings_len; i++) {
+ TopBinding topbinding = interp->topbindings.buffer[i];
+ if (topbinding.name.idx == name.idx) {
+ SExpRef ret = REF(topbinding.binding)->binding.func;
if (ret.idx < 0) goto notfound;
return ret;
}
- binding = REF(binding)->binding.next;
}
notfound:
- return new_error(interp, "Unbound function: %s.\n", name);
+ return new_error(interp, "Unbound function: %s.\n", REF(name)->str);
}
bool lisp_nilp(Interp *interp, SExpRef obj) {
@@ -588,9 +608,6 @@ static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) {
}
SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail) {
- // const char *sexp_str = lisp_to_string(interp, args);
- // fprintf(stderr, "DEBUG: apply: %s, istail: %d\n", sexp_str, istail);
- // free((void*)sexp_str);
SExpRef exp, env, ret, iter;
if (istail) return new_tailcall(interp, fn, args);
if (VALTYPE(fn) == kFuncSExp) {
@@ -628,9 +645,6 @@ error:
}
SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
- // const char *sexp_str = lisp_to_string(interp, sexp);
- // fprintf(stderr, "DEBUG: eval: %s, istail: %d\n", sexp_str, istail);
- // free((void*)sexp_str);
SExpRef ret;
SExpType type;
PUSH_REG(sexp);
@@ -655,7 +669,7 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
goto end;
}
if (type == kSymbolSExp) {
- ret = lisp_lookup(interp, REF(sexp)->str);
+ ret = lisp_lookup(interp, sexp);
goto end;
}
SExpRef fn, funcallargs, args;
@@ -668,26 +682,23 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
ret = new_error(interp, "eval: first elem must be a symbol.\n");
goto end;
}
- const char *symbol = REF(CAR(sexp))->str;
- for (int i = 0; i < PrimitiveEntryVector_len(&interp->primitives); i++) {
- if (strcmp(symbol, PrimitiveEntryVector_ref(&interp->primitives, i)->name) == 0) {
- LispPrimitive primitive_fn =
- PrimitiveEntryVector_ref(&interp->primitives, i)->fn;
- ret = (*primitive_fn)(interp, CDR(sexp), istail);
- if (VALTYPE(ret) == kTailcallSExp && !istail) {
+ SExpRef symbol = CAR(sexp);
+ fn = lisp_lookup_func(interp, symbol);
+ if (CTL_FL(fn)) {
+ ret = new_error(interp, "eval: \"%s\" is not a primitive, function, "
+ "or macro.\n", REF(symbol)->str);
+ goto end;
+ }
+ if (VALTYPE(fn) == kPrimitiveSExp) {
+ LispPrimitive primitive_fn = REF(fn)->primitive;
+ ret = (*primitive_fn)(interp, CDR(sexp), istail);
+ if (VALTYPE(ret) == kTailcallSExp && !istail) {
fn = REF(ret)->tailcall.fn;
args = REF(ret)->tailcall.args;
goto tailcall;
- }
- goto end;
}
- }
- fn = lisp_lookup_func(interp, symbol);
- if (CTL_FL(fn)) {
- ret = new_error(interp, "eval: \"%s\" is not a primitive, function, or macro.\n", symbol);
goto end;
- }
- if (VALTYPE(fn) == kFuncSExp || VALTYPE(fn) == kUserFuncSExp) {
+ } else if (VALTYPE(fn) == kFuncSExp || VALTYPE(fn) == kUserFuncSExp) {
args = CDR(sexp);
funcallargs = CONS(fn, args);
PUSH_REG(funcallargs);
@@ -706,6 +717,10 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
ret = lisp_eval(interp, newast, istail);
POP_REG();
goto end;
+ } else {
+ return new_error(interp,
+ "eval: fatal binding eval, %s is not a func, prim "
+ "or macro.\n", REF(symbol)->str);
}
}
ret = new_error(interp, "eval: unknown syntax.\n");
@@ -776,7 +791,7 @@ SExpRef new_binding(Interp *interp, SExpRef sym, SExpRef val) {
REF(ret)->type = kBindingSExp;
REF(ret)->binding.name = sym;
REF(ret)->binding.value = val;
- REF(ret)->binding.func = unbound;
+ REF(ret)->binding.func = UNBOUND;
REF(ret)->binding.next = NIL;
return ret;
}
@@ -874,3 +889,10 @@ SExpRef new_continue(Interp *interp) {
return ret;
}
+SExpRef new_primitive(Interp *interp, LispPrimitive val) {
+ SExpRef ret = new_sexp(interp);
+ REF(ret)->type = kPrimitiveSExp;
+ REF(ret)->primitive = val;
+ return ret;
+}
+
diff --git a/src/interp.h b/src/interp.h
index 76a3757..74bb0dd 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -14,18 +14,16 @@ typedef struct parser Parser;
struct interp;
typedef struct interp Interp;
-typedef SExpRef (*LispPrimitive)(Interp *interp, SExpRef sexp, bool istail);
-
typedef struct {
- const char *name;
- LispPrimitive fn;
-} PrimitiveEntry;
+ SExpRef name;
+ SExpRef binding;
+} TopBinding;
-VECTOR_DEF(PrimitiveEntry);
+VECTOR_DEF(TopBinding);
struct interp {
SExpVector objs;
- PrimitiveEntryVector primitives;
+ TopBindingVector topbindings;
IntVector empty_space;
String2IntHashTable symbols;
SExpRef stack;
@@ -79,18 +77,18 @@ SExpRef Interp_load_file(Interp *interp, const char *filename);
const char* lisp_to_string(Interp *interp, SExpRef val);
SExpRef lisp_macroexpand1(Interp *interp, SExpRef macro, SExpRef args);
SExpRef lisp_reverse(Interp *interp, SExpRef lst);
-void lisp_defun(Interp *interp, const char *name, SExpRef val);
-void lisp_defvar(Interp *interp, const char *name, SExpRef val);
+void lisp_defun(Interp *interp, SExpRef name, SExpRef val);
+void lisp_defvar(Interp *interp, SExpRef name, SExpRef val);
void lisp_print(Interp *interp, SExpRef obj, FILE *fp);
-SExpRef lisp_lookup(Interp *interp, const char *name);
-SExpRef lisp_lookup_func(Interp *interp, const char *name);
+SExpRef lisp_lookup(Interp *interp, SExpRef name);
+SExpRef lisp_lookup_func(Interp *interp, SExpRef name);
SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail);
SExpRef lisp_cons(Interp *interp, SExpRef a, SExpRef b);
SExpRef lisp_dup(Interp *interp, SExpRef arg);
bool lisp_nilp(Interp *interp, SExpRef arg);
bool lisp_truep(Interp *interp, SExpRef a);
bool lisp_check_list(Interp *interp, SExpRef lst);
-SExpRef lisp_setq(Interp *interp, const char *name, SExpRef val);
+SExpRef lisp_setq(Interp *interp, SExpRef name, SExpRef val);
int lisp_length(Interp *interp, SExpRef lst);
SExpRef lisp_car(Interp *interp, SExpRef arg);
SExpRef lisp_cdr(Interp *interp, SExpRef arg);
@@ -115,6 +113,7 @@ SExpRef new_symbol(Interp *ctx, const char *val);
SExpRef new_env(Interp *ctx);
SExpRef new_binding(Interp *ctx, SExpRef name, SExpRef val);
SExpRef new_userfunc(Interp *interp, LispUserFunc val);
+SExpRef new_primitive(Interp *interp, LispPrimitive val);
SExpRef new_lambda(Interp *interp, SExpRef param, SExpRef body, SExpRef env);
SExpRef new_macro(Interp *interp, SExpRef param, SExpRef body);
SExpRef new_tailcall(Interp *interp, SExpRef fn, SExpRef args);
diff --git a/src/primitives.c b/src/primitives.c
index ca04f84..92e8110 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -136,7 +136,7 @@ SExpRef primitive_setq(Interp *interp, SExpRef args, bool istail) {
if (REF(name)->type != kSymbolSExp) goto error;
value = EVAL(exp);
if (CTL_FL(value)) return value;
- return lisp_setq(interp, REF(name)->str, value);
+ return lisp_setq(interp, name, value);
error:
return new_error(interp, "setq: syntax error.\n");
}
@@ -188,7 +188,7 @@ SExpRef primitive_let(Interp *interp, SExpRef args, bool istail) {
ret = val;
goto end;
}
- ret = lisp_setq(interp, REF(CAR(x))->str, val);
+ ret = lisp_setq(interp, CAR(x), val);
if (CTL_FL(ret)) goto end;
iter = CDR(iter);
}
@@ -275,7 +275,7 @@ SExpRef primitive_defun(Interp *interp, SExpRef args, bool istail) {
param = CADR(args);
body = CDDR(args);
function = new_lambda(interp, param, body, interp->top_level);
- lisp_defun(interp, REF(name)->str, function);
+ lisp_defun(interp, name, function);
return name;
error:
return new_error(interp, "defun: syntax error.\n");
@@ -292,7 +292,7 @@ SExpRef primitive_defmacro(Interp *interp, SExpRef args, bool istail) {
param = CADR(args);
body = CDDR(args);
macro = new_macro(interp, param, body);
- lisp_defun(interp, REF(name)->str, macro);
+ lisp_defun(interp, name, macro);
return name;
error:
return new_error(interp, "defmacro: syntax error.\n");
@@ -310,7 +310,7 @@ SExpRef primitive_defvar(Interp *interp, SExpRef args, bool istail) {
exp = CADR(args);
val = EVAL(exp);
if (CTL_FL(val)) return val;
- lisp_defvar(interp, REF(name)->str, val);
+ lisp_defvar(interp, name, val);
return name;
error:
return new_error(interp, "defvar: syntax error.\n");
@@ -319,7 +319,7 @@ error:
SExpRef primitive_function(Interp *interp, SExpRef args, bool istail) {
if (LENGTH(args) != 1) goto error;
if (VALTYPE(CAR(args)) != kSymbolSExp) goto error;
- return lisp_lookup_func(interp, REF(CAR(args))->str);
+ return lisp_lookup_func(interp, CAR(args));
error:
return new_error(interp, "function: syntax error.\n");
}
@@ -376,7 +376,7 @@ SExpRef primitive_macroexpand1(Interp *interp, SExpRef args, bool istail) {
if (LENGTH(args) != 1) goto error;
args = CAR(args);
if (VALTYPE(CAR(args)) != kSymbolSExp) goto error;
- macro = lisp_lookup_func(interp, REF(CAR(args))->str);
+ macro = lisp_lookup_func(interp, CAR(args));
if (VALTYPE(macro) != kMacroSExp) goto error;
return lisp_macroexpand1(interp, macro, CDR(args));
error:
diff --git a/src/sexp.h b/src/sexp.h
index dfd3ee6..8275dfd 100644
--- a/src/sexp.h
+++ b/src/sexp.h
@@ -27,6 +27,7 @@ typedef struct {
struct interp;
typedef struct interp Interp;
typedef SExpRef (*LispUserFunc)(Interp *interp, SExpRef args);
+typedef SExpRef (*LispPrimitive)(Interp *interp, SExpRef sexp, bool istail);
typedef struct {
SExpRef args;
@@ -63,6 +64,7 @@ typedef enum {
kPairSExp,
kFuncSExp,
kUserFuncSExp,
+ kPrimitiveSExp,
kEnvSExp,
kBindingSExp,
kMacroSExp,
@@ -86,6 +88,7 @@ struct sexp {
SExpPair pair;
SExpFunc func;
LispUserFunc userfunc;
+ LispPrimitive primitive;
SExpEnv env;
SExpBinding binding;
SExpMacro macro;
generated by cgit v1.0 at 2025-12-29 19:19:34 +0000