From 815b972460fb83267a719f82afd79c2abaac80cd Mon Sep 17 00:00:00 2001 From: Mistivia Date: Fri, 20 Jun 2025 15:11:20 +0800 Subject: defun --- src/interp.c | 23 ++++++++++++++++++++--- src/interp.h | 3 ++- src/primitives.c | 38 +++++++++++++++++++++++++++++++++++--- src/primitives.h | 3 +++ 4 files changed, 60 insertions(+), 7 deletions(-) diff --git a/src/interp.c b/src/interp.c index 016f3a4..38e9d2d 100644 --- a/src/interp.c +++ b/src/interp.c @@ -15,6 +15,8 @@ void PrimitiveEntry_show(PrimitiveEntry self, FILE *fp) { } VECTOR_IMPL(PrimitiveEntry); +SExpRef unbound = {-1}; + void Interp_init(Interp *self) { self->errmsg_buf = malloc(BUFSIZE); SExpVector_init(&self->objs); @@ -46,6 +48,9 @@ void Interp_init(Interp *self) { Interp_add_primitive(self, "setq", primitive_setq); Interp_add_primitive(self, "let", primitive_let); Interp_add_primitive(self, "while", primitive_while); + Interp_add_primitive(self, "lambda", primitive_lambda); + Interp_add_primitive(self, "function", primitive_function); + Interp_add_primitive(self, "defun", primitive_defun); Interp_add_userfunc(self, "car", builtin_car); Interp_add_userfunc(self, "list", builtin_list); @@ -62,7 +67,7 @@ void Interp_init(Interp *self) { void Interp_add_userfunc(Interp *interp, const char *name, LispUserFunc fn) { SExpRef userfunc = new_userfunc(interp, fn); - lisp_setfun(interp, name, userfunc); + lisp_defun(interp, name, userfunc); } void Interp_free(Interp *self) { @@ -211,7 +216,7 @@ const char* lisp_to_string(Interp *interp, SExpRef val) { return sb.buf; } -void lisp_setfun(Interp *interp, const char *name, SExpRef val) { +void lisp_defun(Interp *interp, const char *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) { @@ -249,12 +254,15 @@ SExpRef lisp_lookup(Interp *interp, const char *name) { SExpRef binding = REF(env)->env.bindings; while (REF(binding)->type != kNilSExp) { if (strcmp(name, REF(REF(binding)->binding.name)->str) == 0) { - return REF(binding)->binding.value; + SExpRef ret = REF(binding)->binding.value; + if (ret.idx < 0) goto notfound; + return ret; } binding = REF(binding)->binding.next; } env = REF(env)->env.parent; } +notfound: return new_error(interp, "Unbound variable: %s.\n", name); } @@ -401,6 +409,15 @@ SExpRef new_env(Interp *interp) { return ret; } +SExpRef new_lambda(Interp *interp, SExpRef param, SExpRef body, SExpRef env) { + SExpRef ret = new_sexp(interp); + REF(ret)->type = kFuncSExp; + REF(ret)->func.args = param; + REF(ret)->func.body = body; + REF(ret)->func.env = env; + return ret; +} + SExpRef new_binding(Interp *interp, SExpRef sym, SExpRef val) { SExpRef ret = new_sexp(interp); REF(ret)->type = kBindingSExp; diff --git a/src/interp.h b/src/interp.h index 15a8851..c794ed9 100644 --- a/src/interp.h +++ b/src/interp.h @@ -60,7 +60,7 @@ void Interp_add_userfunc(Interp *self, const char *name, LispUserFunc fn); #define PUSH_REG(_x) { interp->reg = CONS((_x), interp->reg); } #define POP_REG() { interp->reg = CDR(interp->reg); } -void lisp_setfun(Interp *interp, const char *name, SExpRef val); +void lisp_defun(Interp *interp, const char *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); @@ -91,6 +91,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_lambda(Interp *interp, SExpRef param, SExpRef body, SExpRef env); SExpRef new_list1(Interp *ctx, SExpRef e1); SExpRef new_list2(Interp *ctx, SExpRef e1, SExpRef e2); SExpRef new_list3(Interp *ctx, SExpRef e1, SExpRef e2, SExpRef e3); diff --git a/src/primitives.c b/src/primitives.c index 9554fb6..f423a6b 100644 --- a/src/primitives.c +++ b/src/primitives.c @@ -138,10 +138,42 @@ SExpRef primitive_while(Interp *interp, SExpRef args) { error: return new_error(interp, "while: syntax error.\n"); } + +SExpRef primitive_lambda(Interp *interp, SExpRef args) { + if (lisp_length(interp, args) < 2) goto error; + SExpRef env = CAR(interp->stack); + SExpRef param = CAR(args); + SExpRef body = CDR(args); + return new_lambda(interp, param, body, env); +error: + return new_error(interp, "lambda: syntax error.\n"); +} + +SExpRef primitive_defun(Interp *interp, SExpRef args) { + if (lisp_length(interp, args) < 3) goto error; + if (CAR(interp->stack).idx != interp->top_level.idx) { + return new_error(interp, "defun: functions can only be defined in top level.\n"); + } + SExpRef name = CAR(args); + if (VALTYPE(name) != kSymbolSExp) goto error; + SExpRef param = CADR(args); + SExpRef body = CDDR(args); + SExpRef function = new_lambda(interp, param, body, interp->top_level); + lisp_defun(interp, REF(name)->str, function); + return name; +error: + return new_error(interp, "defun: syntax error.\n"); +} + +SExpRef primitive_function(Interp *interp, SExpRef args) { + if (lisp_length(interp, args) != 1) goto error; + if (VALTYPE(CAR(args)) != kSymbolSExp) goto error; + return lisp_lookup_func(interp, REF(CAR(args))->str); +error: + return new_error(interp, "function: syntax error.\n"); +} + // TODO: -// - while -// - lambda -// - defun // - funcall // - apply // - defvar diff --git a/src/primitives.h b/src/primitives.h index 1bfe710..787327b 100644 --- a/src/primitives.h +++ b/src/primitives.h @@ -9,5 +9,8 @@ SExpRef primitive_progn(Interp *interp, SExpRef sexp); SExpRef primitive_setq(Interp *interp, SExpRef sexp); SExpRef primitive_let(Interp *interp, SExpRef sexp); SExpRef primitive_while(Interp *interp, SExpRef sexp); +SExpRef primitive_lambda(Interp *interp, SExpRef sexp); +SExpRef primitive_defun(Interp *interp, SExpRef sexp); +SExpRef primitive_function(Interp *interp, SExpRef sexp); #endif -- cgit v1.0