From 2e7d05f7838b33109df7e40e054538566d38ff8d Mon Sep 17 00:00:00 2001 From: "Javier B. Torres" Date: Tue, 13 Jan 2026 18:27:02 -0300 Subject: [PATCH] add macro support --- README.md | 3 --- include/wolflisp.h | 23 ++++++++++++----------- src/compile.c | 33 +++++++++++++++++++++++++++------ src/disasm.c | 7 +++++++ src/vm.c | 41 +++++++++++++++++++++++++++++++++++++++++ test_macro.lisp | 8 ++++++++ 6 files changed, 95 insertions(+), 20 deletions(-) create mode 100644 test_macro.lisp diff --git a/README.md b/README.md index f05a6b1..c39c5d4 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,2 @@ # wolflisp a lisp but wolfy. right now it's very minimal... :^) - -## todo -- [ ] macros in the new bytecode interpreter/compiler diff --git a/include/wolflisp.h b/include/wolflisp.h index 1adae65..3889a43 100644 --- a/include/wolflisp.h +++ b/include/wolflisp.h @@ -61,9 +61,9 @@ typedef struct Bc { typedef struct In In; typedef struct Pr { const char *name; - O (*fn)(In *, O *, int, O); // fn(interp, args_array, argc, env) - int min_args; // Minimum number of arguments (-1 for no check) - int max_args; // Maximum number of arguments (-1 for variadic) + O (*fn)(In *, O *, int, O); + int min_args; + int max_args; } Pr; // Symbol table @@ -165,23 +165,23 @@ enum { OP_JUMP, OP_JUMP_IF_NIL, OP_CALL, + OP_TAIL_CALL, OP_RET, OP_POP, OP_CLOS, - OP_TAIL_CALL, + OP_MAC, OP_BIND, OP_BIND_REST, OP_PEEK, - OP_GET_LOCAL, // Get local variable from stack frame - OP_SET_LOCAL, // Set local variable in stack frame - OP_RESERVE, // Reserve space for local variables + OP_GET_LOCAL, + OP_SET_LOCAL, + OP_RESERVE, }; // Local variable info typedef struct Lv { - O name; // Symbol name - U16 index; // Stack slot index - int captured; // Is this variable captured by a closure? + O name; + U16 index; } Lv; // Compiler context @@ -199,6 +199,7 @@ typedef struct Cm { O quote; O iff; O fn; + O mac; O progn; O def; } specials; @@ -207,7 +208,7 @@ typedef struct Cm { Z count; Z capacity; } locals; - int use_stack_locals; // Use stack-based locals instead of env + I use_locals; } Cm; enum { diff --git a/src/compile.c b/src/compile.c index b1aa8a8..bb5a6c9 100644 --- a/src/compile.c +++ b/src/compile.c @@ -177,7 +177,7 @@ static int nested_p(Cm *c, O body) { } // Compile a closure with `args` and `body`. -static V compile_fn(Cm *c, O args, O body) { +static V compile_fn(Cm *c, O args, O body, I macro) { // Create an inner compiler context for compiling the closure's body. Cm ic; memset(&ic, 0, sizeof(Cm)); @@ -204,14 +204,14 @@ static V compile_fn(Cm *c, O args, O body) { if (rest == NIL && !nested) { // If the function has no rest argument, and has no nested closures inside // it, compile using stack locals as an optimization for tail-calls - ic.use_stack_locals = 1; + ic.use_locals = 1; curr = args; for (O next = list_next(c->in, &curr); next != NIL; next = list_next(c->in, &curr)) add_local(&ic, next); } else { // Otherwise, fallback to using environment bindings for locals - ic.use_stack_locals = 0; + ic.use_locals = 0; if (rest != NIL) { emit(&ic, OP_BIND_REST); emit16(&ic, add_constant(&ic, rest)); @@ -231,7 +231,7 @@ static V compile_fn(Cm *c, O args, O body) { Z args_idx = add_constant(c, args); // Compile pushing the closure to the stack. - emit(c, OP_CLOS); + emit(c, macro ? OP_MAC : OP_CLOS); emit16(c, code_idx); emit16(c, args_idx); @@ -256,6 +256,8 @@ static V compile_def(Cm *c, O args, I tail) { emit(c, OP_RET); } +O vm_apply(In *in, O macro, O args); + // Compile a function application/special form static V compile_apply(Cm *co, O expr, I tail) { Pa *p = pair_unwrap(co->in, expr); @@ -278,7 +280,13 @@ static V compile_apply(Cm *co, O expr, I tail) { return; } else if (head == co->specials.fn) { Pa *args = pair_unwrap(co->in, p->tail); - compile_fn(co, args->head, args->tail); + compile_fn(co, args->head, args->tail, 0); + if (tail) + emit(co, OP_RET); + return; + } else if (head == co->specials.mac) { + Pa *args = pair_unwrap(co->in, p->tail); + compile_fn(co, args->head, args->tail, 1); if (tail) emit(co, OP_RET); return; @@ -286,6 +294,17 @@ static V compile_apply(Cm *co, O expr, I tail) { compile_def(co, p->tail, tail); return; } + if (find_local(co, head) == -1) { + O obj = list_assoc(co->in, head, co->in->env); + if (obj != NIL) { + obj = pair_unwrap(co->in, obj)->tail; + if (type(obj) == TYPE_MAC) { + O exp = vm_apply(co->in, obj, p->tail); + compile(co, exp, tail); + return; + } + } + } } compile_call(co, head, p->tail, tail); } @@ -303,6 +322,8 @@ V compile(Cm *co, O expr, I tail) { co->specials.fn = symbol_make(co->in, "fn"); if (co->specials.def == NIL) co->specials.def = symbol_make(co->in, "def"); + if (co->specials.mac == NIL) + co->specials.mac = symbol_make(co->in, "mac"); switch (ty) { case TYPE_NIL: @@ -314,7 +335,7 @@ V compile(Cm *co, O expr, I tail) { emit(co, OP_RET); break; case TYPE_SYM: - if (co->use_stack_locals) { + if (co->use_locals) { int idx = find_local(co, expr); if (idx >= 0) { emit(co, OP_GET_LOCAL); diff --git a/src/disasm.c b/src/disasm.c index a166437..6174f30 100644 --- a/src/disasm.c +++ b/src/disasm.c @@ -65,6 +65,13 @@ V disassemble(Cm *co) { ofs += 4; break; } + case OP_MAC: { + U16 b = (co->code[ofs + 1] << 8) | co->code[ofs + 2]; + U16 a = (co->code[ofs + 3] << 8) | co->code[ofs + 4]; + printf("MAC %04x %04x\n", b, a); + ofs += 4; + break; + } case OP_BIND: { U16 idx = (co->code[ofs + 1] << 8) | co->code[ofs + 2]; printf("BIND %d\n", idx); diff --git a/src/vm.c b/src/vm.c index b8e4abf..b5918a8 100644 --- a/src/vm.c +++ b/src/vm.c @@ -216,6 +216,18 @@ static O vm_exec(Cm *co_in, O env_in, int argc_in) { PUSH(BOX(hdr)); break; } + case OP_MAC: { + U16 code_idx = READ16(); + U16 args_idx = READ16(); + Gh *hdr = gc_alloc(&in->gc, sizeof(Gh) + sizeof(Cl)); + hdr->type = TYPE_MAC; + Cl *cl = (Cl *)(hdr + 1); + cl->args = co->constants.data[args_idx]; + cl->body = co->constants.data[code_idx]; + cl->env = env; + PUSH(BOX(hdr)); + break; + } default: error_throw(in, "unknown opcode %d", op); } @@ -224,4 +236,33 @@ static O vm_exec(Cm *co_in, O env_in, int argc_in) { return NIL; } +O vm_apply(In *in, O macro, O args) { + I mark = gc_rootmark(&in->gc); + gc_addroot(&in->gc, ¯o); + gc_addroot(&in->gc, &args); + Gh *hdr = UNBOX(macro); + Cl *cl = (Cl *)(hdr + 1); + Bc *bc = (Bc *)(UNBOX(cl->body) + 1); + int argc = 0; + O list = args; + while (list != NIL) { + if (type(list) != TYPE_PAIR) + error_throw(in, "vm_apply: arguments must be a proper list"); + Pa *p = pair_unwrap(in, list); + *in->sp++ = p->head; // PUSH + list = p->tail; + argc++; + } + Cm co = {0}; + co.in = in; + co.code = bc->data; + co.count = bc->len; + co.constants.data = bc->constants; + co.constants.count = bc->constant_count; + co.constants.capacity = bc->constant_count; + O result = vm_exec(&co, cl->env, argc); + gc_rootreset(&in->gc, mark); + return result; +} + O vm_run(Cm *co) { return vm_exec(co, co->in->env, 0); } diff --git a/test_macro.lisp b/test_macro.lisp new file mode 100644 index 0000000..67c93a6 --- /dev/null +++ b/test_macro.lisp @@ -0,0 +1,8 @@ +(def twice (mac (x) + (list 'progn x x))) + +(def when (mac (cond . body) + (list 'if cond (cons 'progn body)))) + +(when (= 1 1) + (twice (write "ok\n")))