implement macros and dotted pairs

include/wolflisp.h

@@ -69,13 +69,13 @@ enum {
 
 enum {
   TYPE_NIL = 0,
-  TYPE_NUM = 1,
+  TYPE_NUM = 1, // These three are the same as their tags.
   TYPE_SYM = 2,
   TYPE_PRIM = 4,
-  TYPE_PAIR, // = 5,
-  TYPE_CLOS, // = 6,
-  TYPE_CODE, // = 7,
-  TYPE_FWD,  // = 8,
+  TYPE_PAIR,
+  TYPE_CLOS,
+  TYPE_MAC,
+  TYPE_FWD,
   TYPE__MAX,
 };
 

src/interp.c

@@ -10,9 +10,11 @@ V interp_init(In *in) {
   gc_addroot(&in->gc, &in->env);
   in->t = symbol_make(in, "t");
   in->env = NIL;
+
+  // Add T symbol
   in->env = pair_make(in, pair_make(in, in->t, in->t), in->env);
 
-#define PRIM(name, prim)                                                       \
+#define PRIM(name, prim) \
   in->env = pair_make(in, prim_make(in, name, prim), in->env)
 
   PRIM("progn", prim_progn);
@@ -35,6 +37,7 @@ V interp_init(In *in) {
 
   PRIM("=", prim_equal);
   PRIM("fn", prim_fn);
+  PRIM("mac", prim_mac);
   PRIM("gc", prim_gc);
 #undef PRIM
 }
@@ -135,8 +138,20 @@ static O apply(In *in, O fn, O args, O env) {
     O nenv = bind(in, cl->args, args, cl->env);
     // `bind' may have moved the closure if a GC was triggered
     cl = (Cl *)(UNBOX(fn) + 1);
+    O res = eval(in, cl->body, nenv);
     gc_rootreset(&in->gc, mark);
-    return eval(in, cl->body, nenv);
+    return res;
+  }
+  case TYPE_MAC: {
+    Gh *hdr = UNBOX(fn);
+    Cl *cl = (Cl *)(hdr + 1);
+    O nenv = bind(in, cl->args, args, cl->env);
+    cl = (Cl *)(UNBOX(fn) + 1);
+    O exp = eval(in, cl->body, nenv);
+    gc_addroot(&in->gc, &exp);
+    O res = eval(in, exp, env);
+    gc_rootreset(&in->gc, mark);
+    return res;
   }
   default:
     error_throw(in, "tried to call non-function value");

src/list.c

@@ -1,3 +1,5 @@
+/* List utilities. */
+
 #include <wolflisp.h>
 
 O list_assoc(O key, O alist) {

src/prim.c

@@ -223,6 +223,30 @@ O prim_fn(In *in, O args, O env) {
   return BOX(hdr);
 }
 
+O prim_mac(In *in, O args, O env) {
+  O params = nextarg(&args);
+  O body = args;
+
+  I mark = gc_rootmark(&in->gc);
+  gc_addroot(&in->gc, &params);
+  gc_addroot(&in->gc, &env);
+  gc_addroot(&in->gc, &body);
+
+  O progn = symbol_make(in, "progn");
+  O body_form = pair_make(in, progn, body);
+  gc_addroot(&in->gc, &body_form);
+
+  Gh *hdr = gc_alloc(&in->gc, sizeof(Gh) + sizeof(Cl));
+  hdr->type = TYPE_MAC;
+  Cl *cl = (Cl *)(hdr + 1);
+  cl->args = params;
+  cl->env = env;
+  cl->body = body_form;
+
+  gc_rootreset(&in->gc, mark);
+  return BOX(hdr);
+}
+
 O prim_gc(In *in, O args, O env) {
   (void)in;
   (void)args;

src/prim.h

@@ -17,6 +17,7 @@ O prim_equal(In *in, O args, O env);
 O prim_lt(In *in, O args, O env);
 O prim_gt(In *in, O args, O env);
 O prim_fn(In *in, O args, O env);
+O prim_mac(In *in, O args, O env);
 O prim_gc(In *in, O args, O env);
 O prim_def(In *in, O args, O env);
 O prim_defn(In *in, O args, O env);

src/read.c

@@ -30,7 +30,23 @@ int read_expr(In *in, Lx *lex, O *result) {
     gc_addroot(&in->gc, &tail);
 
     while (lex->kind != TOK_RPAREN && lex->kind != TOK_EOF) {
-      O elem;
+      if (lex->kind == TOK_DOT) {
+        if (list == NIL)
+          error_throw(in, "unexpected .");
+        nexttoken(lex);
+
+        O last = NIL;
+        read_expr(in, lex, &last);
+        nexttoken(lex);
+
+        pair_unwrap(tail)->tail = last;
+
+        if (lex->kind != TOK_RPAREN)
+          error_throw(in, "expected closing parenthesis");
+        break;
+      }
+
+      O elem = NIL;
       read_expr(in, lex, &elem);
       nexttoken(lex);
 

src/type.c

@@ -11,7 +11,7 @@ static const char *typenames[] = {
   [TYPE_PRIM] = "primitive",
   [TYPE_PAIR] = "pair",
   [TYPE_CLOS] = "closure",
-  [TYPE_CODE] = "code",
+  [TYPE_MAC] = "macro",
 };
 // clang-format on
 

test.lisp

@@ -1,3 +0,0 @@
-(defn fib (n)
-  (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
-(println (fib 10))