pass interpreter context to pair_unwrap

include/wolflisp.h

@@ -35,12 +35,12 @@ typedef struct Pa {
 typedef struct Sy {
   U32 hash;
   Z len;
-  U8 *data;
+  char *data;
 } Sy;
 
 typedef struct Ss {
   Z len;
-  char data[];
+  char *data;
 } Ss;
 
 // Closure
@@ -201,7 +201,7 @@ Sy *intern(St *tab, const char *str, Z len);
 // Create a pair
 O pair_make(In *in, O head, O tail);
 // Unwrap a pair
-Pa *pair_unwrap(O obj);
+Pa *pair_unwrap(In *in, O obj);
 
 O string_make(In *in, const char *cstr, I len);
 
@@ -211,8 +211,8 @@ V println(O obj);
 O symbol_make(In *in, const char *str);
 O prim_make(In *in, const char *name, O (*fn)(In *, O, O));
 
-O list_assoc(O key, O alist);
+O list_assoc(In *in, O key, O alist);
-O list_reverse(O list);
+O list_reverse(In *in, O list);
 
 int nexttoken(Lx *lex);
 

src/interp.c

@@ -68,7 +68,7 @@ static O bind(In *in, O params, O args, O env) {
       error_throw(in, "expected proper list or symbol for parameters");
     }
 
-    Pa *p = pair_unwrap(params);
+    Pa *p = pair_unwrap(in, params);
     O sym = p->head;
 
     O val = NIL;
@@ -76,7 +76,7 @@ static O bind(In *in, O params, O args, O env) {
       if (type(args) != TYPE_PAIR) {
         error_throw(in, "too many parameters for arguments");
       }
-      Pa *a = pair_unwrap(args);
+      Pa *a = pair_unwrap(in, args);
       val = a->head;
       args = a->tail;
     }
@@ -106,13 +106,13 @@ static O eval_list(In *in, O list, O env) {
   gc_addroot(&in->gc, &curr);
 
   while (curr != NIL) {
-    Pa *p = pair_unwrap(curr);
+    Pa *p = pair_unwrap(in, curr);
     O obj = eval(in, p->head, env);
     head = pair_make(in, obj, head);
     curr = p->tail;
   }
 
-  O result = list_reverse(head);
+  O result = list_reverse(in, head);
   gc_rootreset(&in->gc, mark);
   return result;
 }
@@ -163,15 +163,15 @@ static O eval(In *in, O obj, O env) {
   I ty = type(obj);
 
   if (ty == TYPE_SYM) {
-    O pair = list_assoc(obj, env);
+    O pair = list_assoc(in, obj, env);
     if (pair == NIL) {
-      pair = list_assoc(obj, in->env);
+      pair = list_assoc(in, obj, in->env);
     }
     if (pair == NIL) {
       Sy *s = (Sy *)UNTAG(obj);
       error_throw(in, "undefined symbol '%.*s'", (int)s->len, s->data);
     }
-    return pair_unwrap(pair)->tail;
+    return pair_unwrap(in, pair)->tail;
   } else if (ty != TYPE_PAIR) {
     return obj;
   }
@@ -180,7 +180,7 @@ static O eval(In *in, O obj, O env) {
   gc_addroot(&in->gc, &obj);
   gc_addroot(&in->gc, &env);
 
-  Pa *c = pair_unwrap(obj);
+  Pa *c = pair_unwrap(in, obj);
   O fn = eval(in, c->head, env);
   gc_addroot(&in->gc, &fn);
 

src/list.c

@@ -2,16 +2,16 @@
 
 #include <wolflisp.h>
 
-O list_assoc(O key, O alist) {
+O list_assoc(In *in, O key, O alist) {
   while (type(alist) == TYPE_PAIR) {
-    Pa *c = pair_unwrap(alist);
+    Pa *c = pair_unwrap(in, alist);
     O pair = c->head;
     if (pair == NIL) {
       alist = c->tail;
       continue;
     }
     if (type(pair) == TYPE_PAIR) {
-      Pa *kv = pair_unwrap(pair);
+      Pa *kv = pair_unwrap(in, pair);
       if (kv->head == key)
         return pair;
     }
@@ -20,13 +20,13 @@ O list_assoc(O key, O alist) {
   return NIL;
 }
 
-O list_reverse(O list) {
+O list_reverse(In *in, O list) {
   O prev = NIL;
   O curr = list;
   O next;
 
   while (curr != NIL) {
-    Pa *c = pair_unwrap(curr);
+    Pa *c = pair_unwrap(in, curr);
     next = c->tail;
     c->tail = prev;
     prev = curr;

src/pair.c

@@ -19,10 +19,9 @@ O pair_make(In *in, O head, O tail) {
   return BOX(hdr);
 }
 
-Pa *pair_unwrap(O obj) {
+Pa *pair_unwrap(In *in, O obj) {
   if (type(obj) != TYPE_PAIR) {
-    fprintf(stderr, "expected pair, got %s\n", typename(type(obj)));
+    error_throw(in, "expected pair, got %s", typename(type(obj)));
-    abort();
   }
   return (Pa *)(UNBOX(obj) + 1);
 }

src/prim.c

@@ -2,11 +2,11 @@
 #include <stdlib.h>
 #include <wolflisp.h>
 
-static O nextarg(O *list) {
+static O nextarg(In *in, O *list) {
   if (*list == NIL)
     return NIL;
-  O arg = pair_unwrap(*list)->head;
+  O arg = pair_unwrap(in, *list)->head;
-  *list = pair_unwrap(*list)->tail;
+  *list = pair_unwrap(in, *list)->tail;
   return arg;
 }
 
@@ -28,8 +28,8 @@ O prim_make(In *in, const char *name, O (*fn)(In *, O, O)) {
 
 O prim_cons(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  O head = nextarg(&args);
+  O head = nextarg(in, &args);
-  O tail = nextarg(&args);
+  O tail = nextarg(in, &args);
   return pair_make(in, head, tail);
 }
 
@@ -37,23 +37,23 @@ O prim_list(In *in, O args, O env) { return interp_eval_list(in, args, env); }
 
 O prim_head(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  return pair_unwrap(nextarg(&args))->head;
+  return pair_unwrap(in, nextarg(in, &args))->head;
 }
 
 O prim_tail(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  return pair_unwrap(nextarg(&args))->tail;
+  return pair_unwrap(in, nextarg(in, &args))->tail;
 }
 
 O prim_print(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  print(nextarg(&args));
+  print(nextarg(in, &args));
   return NIL;
 }
 
 O prim_println(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  O arg = nextarg(&args);
+  O arg = nextarg(in, &args);
   println(arg);
   return NIL;
 }
@@ -61,13 +61,13 @@ O prim_println(In *in, O args, O env) {
 O prim_quote(In *in, O args, O env) {
   (void)in;
   (void)env;
-  return nextarg(&args);
+  return nextarg(in, &args);
 }
 
 O prim_if(In *in, O args, O env) {
-  O cond_expr = nextarg(&args);
+  O cond_expr = nextarg(in, &args);
-  O then_expr = nextarg(&args);
+  O then_expr = nextarg(in, &args);
-  O else_expr = nextarg(&args);
+  O else_expr = nextarg(in, &args);
 
   if (cond_expr == NIL || then_expr == NIL) {
     fprintf(stderr, "if: expected at least 2 arguments\n");
@@ -83,20 +83,20 @@ O prim_if(In *in, O args, O env) {
 
 O prim_progn(In *in, O args, O env) {
   O result = NIL;
-  for (O expr = nextarg(&args); expr != NIL; expr = nextarg(&args))
+  for (O expr = nextarg(in, &args); expr != NIL; expr = nextarg(in, &args))
     result = interp_eval(in, expr, env);
   return result;
 }
 
 O prim_add(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  I result = nextarg(&args);
+  I result = nextarg(in, &args);
   if (result == NIL) {
     return NUM(0);
   } else {
     result = ORD(result);
   }
-  for (O arg = nextarg(&args); arg != NIL; arg = nextarg(&args)) {
+  for (O arg = nextarg(in, &args); arg != NIL; arg = nextarg(in, &args)) {
     if (!IMM(arg)) {
       error_throw(in, "+: non numeric argument");
     }
@@ -107,13 +107,13 @@ O prim_add(In *in, O args, O env) {
 
 O prim_sub(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  I result = nextarg(&args);
+  I result = nextarg(in, &args);
   if (result == NIL) {
     return NUM(0);
   } else {
     result = ORD(result);
   }
-  for (O arg = nextarg(&args); arg != NIL; arg = nextarg(&args)) {
+  for (O arg = nextarg(in, &args); arg != NIL; arg = nextarg(in, &args)) {
     if (!IMM(arg)) {
       error_throw(in, "-: non numeric argument");
     }
@@ -124,13 +124,13 @@ O prim_sub(In *in, O args, O env) {
 
 O prim_mul(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  I result = nextarg(&args);
+  I result = nextarg(in, &args);
   if (result == NIL) {
     return NUM(1);
   } else {
     result = ORD(result);
   }
-  for (O arg = nextarg(&args); arg != NIL; arg = nextarg(&args)) {
+  for (O arg = nextarg(in, &args); arg != NIL; arg = nextarg(in, &args)) {
     if (!IMM(arg)) {
       error_throw(in, "*: non numeric argument");
     }
@@ -141,13 +141,13 @@ O prim_mul(In *in, O args, O env) {
 
 O prim_div(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  I result = nextarg(&args);
+  I result = nextarg(in, &args);
   if (result == NIL) {
     return NUM(1);
   } else {
     result = ORD(result);
   }
-  for (O arg = nextarg(&args); arg != NIL; arg = nextarg(&args)) {
+  for (O arg = nextarg(in, &args); arg != NIL; arg = nextarg(in, &args)) {
     if (!IMM(arg)) {
       error_throw(in, "/: non numeric argument");
     }
@@ -163,8 +163,8 @@ O prim_equal(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
   I result = NIL;
 
-  O fst = nextarg(&args);
+  O fst = nextarg(in, &args);
-  for (O next = nextarg(&args); next != NIL; next = nextarg(&args)) {
+  for (O next = nextarg(in, &args); next != NIL; next = nextarg(in, &args)) {
     if (fst == next) {
       result = in->t;
     } else {
@@ -177,8 +177,8 @@ O prim_equal(In *in, O args, O env) {
 
 O prim_lt(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  O fst = nextarg(&args);
+  O fst = nextarg(in, &args);
-  O snd = nextarg(&args);
+  O snd = nextarg(in, &args);
   if (IMM(fst) && IMM(snd)) {
     return bool(in, ORD(fst) < ORD(snd));
   } else {
@@ -189,8 +189,8 @@ O prim_lt(In *in, O args, O env) {
 
 O prim_gt(In *in, O args, O env) {
   args = interp_eval_list(in, args, env);
-  O fst = nextarg(&args);
+  O fst = nextarg(in, &args);
-  O snd = nextarg(&args);
+  O snd = nextarg(in, &args);
   if (IMM(fst) && IMM(snd)) {
     return bool(in, ORD(fst) > ORD(snd));
   } else {
@@ -200,7 +200,7 @@ O prim_gt(In *in, O args, O env) {
 }
 
 O prim_fn(In *in, O args, O env) {
-  O params = nextarg(&args);
+  O params = nextarg(in, &args);
   O body = args;
 
   I mark = gc_rootmark(&in->gc);
@@ -224,7 +224,7 @@ O prim_fn(In *in, O args, O env) {
 }
 
 O prim_mac(In *in, O args, O env) {
-  O params = nextarg(&args);
+  O params = nextarg(in, &args);
   O body = args;
 
   I mark = gc_rootmark(&in->gc);
@@ -256,8 +256,8 @@ O prim_gc(In *in, O args, O env) {
 }
 
 O prim_def(In *in, O args, O env) {
-  O sym = nextarg(&args);
+  O sym = nextarg(in, &args);
-  O val_expr = nextarg(&args);
+  O val_expr = nextarg(in, &args);
 
   if (type(sym) != TYPE_SYM) {
     error_throw(in, "def: expected symbol");
@@ -280,8 +280,8 @@ O prim_def(In *in, O args, O env) {
 }
 
 O prim_defn(In *in, O args, O env) {
-  O sym = nextarg(&args);
+  O sym = nextarg(in, &args);
-  O params = nextarg(&args);
+  O params = nextarg(in, &args);
   O body = args;
 
   if (type(sym) != TYPE_SYM) {

src/read.c

@@ -39,7 +39,7 @@ int read_expr(In *in, Lx *lex, O *result) {
         read_expr(in, lex, &last);
         nexttoken(lex);
 
-        pair_unwrap(tail)->tail = last;
+        pair_unwrap(in, tail)->tail = last;
 
         if (lex->kind != TOK_RPAREN)
           error_throw(in, "expected closing parenthesis");
@@ -55,7 +55,7 @@ int read_expr(In *in, Lx *lex, O *result) {
       if (list == NIL) {
         list = tail = cell;
       } else {
-        pair_unwrap(tail)->tail = cell;
+        pair_unwrap(in, tail)->tail = cell;
         tail = cell;
       }
     }

src/string.c

@@ -9,7 +9,16 @@ O string_make(In *in, const char *cstr, I len) {
   hdr->type = TYPE_STR;
   Ss *s = (Ss *)(hdr + 1);
   s->len = len;
+  s->data = (char *)(s + 1);
   memcpy(s->data, cstr, len);
   s->data[len] = 0;
   return BOX(hdr);
 }
+
+Ss *string_unwrap(In *in, O str) {
+  if (type(str) != TYPE_STR) {
+    error_throw(in, "expected string, got %s", typename(type(str)));
+  }
+  return (Ss *)(UNBOX(str) + 1);
+}
+