diff options
| -rw-r--r-- | src/interp.c | 18 | ||||
| -rw-r--r-- | src/interp.h | 1 | ||||
| -rw-r--r-- | src/primitives.c | 16 | ||||
| -rw-r--r-- | src/primitives.h | 1 |
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 |