aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/interp.c38
-rw-r--r--src/interp.h2
-rw-r--r--src/primitives.c27
-rw-r--r--src/primitives.h2
4 files changed, 63 insertions, 6 deletions
diff --git a/src/interp.c b/src/interp.c
index e5e9167..5e181a8 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -52,10 +52,12 @@ void Interp_init(Interp *self) {
Interp_add_primitive(self, "function", primitive_function);
Interp_add_primitive(self, "defun", primitive_defun);
Interp_add_primitive(self, "defvar", primitive_defvar);
+ Interp_add_primitive(self, "defmacro", primitive_defmacro);
Interp_add_primitive(self, "funcall", primitive_funcall);
Interp_add_primitive(self, "apply", primitive_apply);
Interp_add_primitive(self, "quote", primitive_quote);
Interp_add_primitive(self, "quasiquote", primitive_quasi);
+ Interp_add_primitive(self, "macroexpand-1", primitive_macroexpand1);
Interp_add_userfunc(self, "eval", lisp_eval);
Interp_add_userfunc(self, "show", builtin_show);
@@ -223,6 +225,16 @@ const char* lisp_to_string(Interp *interp, SExpRef val) {
return sb.buf;
}
+SExpRef lisp_macroexpand1(Interp *interp, SExpRef macro, SExpRef args) {
+ SExpRef fn = new_lambda(interp, REF(macro)->macro.args, REF(macro)->macro.body, interp->top_level);
+ PUSH_REG(fn);
+ SExpRef ret = lisp_apply(interp, fn, args);
+ POP_REG();
+ return ret;
+error:
+ return new_error(interp, "macroexpand: syntax error.\n");
+}
+
void lisp_defun(Interp *interp, const char *name, SExpRef val) {
SExpRef binding = REF(interp->top_level)->env.bindings;
while (REF(binding)->type != kNilSExp) {
@@ -264,7 +276,7 @@ SExpRef lisp_setq(Interp *interp, const char *name, SExpRef val) {
while (REF(binding)->type != kNilSExp) {
if (strcmp(name, REF(REF(binding)->binding.name)->str) == 0) {
REF(binding)->binding.value = val;
- return NIL;
+ return val;
}
binding = REF(binding)->binding.next;
}
@@ -455,14 +467,22 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
}
}
SExpRef fn = lisp_lookup_func(interp, symbol);
- if (!ERRORP(fn)) {
+ if (ERRORP(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) {
SExpRef args = CDR(sexp);
ret = primitive_funcall(interp, CONS(fn, args));
goto end;
+ } else if (VALTYPE(fn) == kMacroSExp) {
+ SExpRef args = CDR(sexp);
+ SExpRef newast = lisp_macroexpand1(interp, fn, args);
+ PUSH_REG(newast);
+ ret = EVAL(newast);
+ POP_REG();
+ goto end;
}
- // TODO: macro / func
- ret = new_error(interp, "eval: \"%s\" is not a primitive, function, or macro.\n", symbol);
- goto end;
}
ret = new_error(interp, "eval: unknown syntax.\n");
end:
@@ -500,6 +520,14 @@ SExpRef new_lambda(Interp *interp, SExpRef param, SExpRef body, SExpRef env) {
return ret;
}
+SExpRef new_macro(Interp *interp, SExpRef param, SExpRef body) {
+ SExpRef ret = new_sexp(interp);
+ REF(ret)->type = kMacroSExp;
+ REF(ret)->macro.args = param;
+ REF(ret)->macro.body = body;
+ 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 1eaa920..b7b3025 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -60,6 +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); }
+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);
@@ -95,6 +96,7 @@ 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_macro(Interp *interp, SExpRef param, SExpRef body);
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 8290a01..266a8b7 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -165,6 +165,21 @@ SExpRef primitive_defun(Interp *interp, SExpRef args) {
error:
return new_error(interp, "defun: syntax error.\n");
}
+SExpRef primitive_defmacro(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, "defmacro: macros 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 macro = new_macro(interp, param, body);
+ lisp_defun(interp, REF(name)->str, macro);
+ return name;
+error:
+ return new_error(interp, "defmacro: syntax error.\n");
+}
SExpRef primitive_defvar(Interp *interp, SExpRef args) {
if (lisp_length(interp, args) != 2) goto error;
@@ -231,6 +246,17 @@ SExpRef primitive_quote(Interp *interp, SExpRef args) {
return CAR(args);
}
+SExpRef primitive_macroexpand1(Interp *interp, SExpRef args) {
+ if (lisp_length(interp, args) != 1) goto error;
+ args = CAR(args);
+ if (VALTYPE(CAR(args)) != kSymbolSExp) goto error;
+ SExpRef macro = lisp_lookup_func(interp, REF(CAR(args))->str);
+ if (VALTYPE(macro) != kMacroSExp) goto error;
+ return lisp_macroexpand1(interp, macro, CDR(args));
+error:
+ return new_error(interp, "macroexpand-1: syntax error.\n");
+}
+
SExpRef primitive_apply(Interp *interp, SExpRef args) {
if (lisp_length(interp, args) != 2) goto error;
args = lisp_eval_args(interp, args);
@@ -293,7 +319,6 @@ static SExpRef quasi_on_list(Interp *interp, SExpRef lst) {
return lisp_reverse(interp, newlst);
}
-
SExpRef primitive_quasi(Interp *interp, SExpRef args) {
if (lisp_length(interp, args) != 1) return new_error(interp, "quasiquote: syntax error.\n");
bool slicing;
diff --git a/src/primitives.h b/src/primitives.h
index 4f481af..0e6f061 100644
--- a/src/primitives.h
+++ b/src/primitives.h
@@ -12,7 +12,9 @@ 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_defmacro(Interp *interp, SExpRef sexp);
SExpRef primitive_function(Interp *interp, SExpRef sexp);
+SExpRef primitive_macroexpand1(Interp *interp, SExpRef sexp);
SExpRef primitive_funcall(Interp *interp, SExpRef sexp);
SExpRef primitive_apply(Interp *interp, SExpRef sexp);
SExpRef primitive_quote(Interp *interp, SExpRef sexp);
generated by cgit v1.0 at 2025-12-29 19:12:35 +0000