add macro support

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

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 {

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);

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);

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, &macro);
+  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); }

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")))