defun

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