defvar

4 files changed, 36 insertions, 0 deletions

diff --git a/src/interp.c b/src/interp.c
index 38e9d2d..dbc2357 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -51,6 +51,7 @@ void Interp_init(Interp *self) {
     Interp_add_primitive(self, "lambda", primitive_lambda);
     Interp_add_primitive(self, "function", primitive_function);
     Interp_add_primitive(self, "defun", primitive_defun);
+    Interp_add_primitive(self, "defvar", primitive_defvar);
 
     Interp_add_userfunc(self, "car", builtin_car);
     Interp_add_userfunc(self, "list", builtin_list);
@@ -232,6 +233,23 @@ void lisp_defun(Interp *interp, const char *name, SExpRef val) {
     REF(interp->top_level)->env.bindings = newbinding;
 }
 
+void lisp_defvar(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) {
+            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;
+    REF(newbinding)->binding.value = val;
+    REF(newbinding)->binding.next = binding;
+    REF(interp->top_level)->env.bindings = newbinding;
+}
+
 SExpRef lisp_setq(Interp *interp, const char *name, SExpRef val) {
     SExpRef env = CAR(interp->stack);
     while (REF(env)->type != kNilSExp) {
diff --git a/src/interp.h b/src/interp.h
index c794ed9..e8b3980 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -61,6 +61,7 @@ void Interp_add_userfunc(Interp *self, const char *name, LispUserFunc fn);
 #define POP_REG() { interp->reg = CDR(interp->reg);  }
 
 void lisp_defun(Interp *interp, const char *name, SExpRef val);
+void lisp_defvar(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);
diff --git a/src/primitives.c b/src/primitives.c
index f423a6b..25be771 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -165,6 +165,22 @@ error:
     return new_error(interp, "defun: syntax error.\n");
 }
 
+SExpRef primitive_defvar(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 2) goto error;
+    if (CAR(interp->stack).idx != interp->top_level.idx) {
+        return new_error(interp, "defvar: functions can only be defined in top level.\n");
+    }
+    SExpRef name = CAR(args);
+    if (VALTYPE(name) != kSymbolSExp) goto error;
+    SExpRef exp = CADR(args);
+    SExpRef val = EVAL(exp);
+    if (ERRORP(val)) return val;
+    lisp_defvar(interp, REF(name)->str, val);
+    return name;
+error:
+    return new_error(interp, "defvar: 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;
diff --git a/src/primitives.h b/src/primitives.h
index 787327b..dfd8d2e 100644
--- a/src/primitives.h
+++ b/src/primitives.h
@@ -11,6 +11,7 @@ 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_defvar(Interp *interp, SExpRef sexp);
 SExpRef primitive_function(Interp *interp, SExpRef sexp);
 
 #endif