diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | src/interp.c | 132 | ||||
| -rw-r--r-- | src/interp.h | 23 | ||||
| -rw-r--r-- | src/primitives.c | 14 | ||||
| -rw-r--r-- | src/sexp.h | 3 |
5 files changed, 100 insertions, 74 deletions
@@ -5,3 +5,5 @@ bamboo-lisp compile_commands.json .cache +todo +fibo.lisp 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: @@ -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; |