lobo/wl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

pass interpreter context to pair_unwrap

Browse source
This commit is contained in:
Lobo 2026-01-12 09:26:42 -03:00
parent 91714d1025
commit 5504f6b123
7 changed files with 66 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

10
include/wolflisp.h
View file

@ -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_reverse(O list);
O list_assoc(In *in, O key, O alist);
O list_reverse(In *in, O list);
int nexttoken(Lx *lex);

16
src/interp.c
View file

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

10
src/list.c
View file

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

7
src/pair.c
View file

@ -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)));
abort();
error_throw(in, "expected pair, got %s", typename(type(obj)));
}
return (Pa *)(UNBOX(obj) + 1);
}
}

68
src/prim.c
View file

@ -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;
*list = pair_unwrap(*list)->tail;
O arg = pair_unwrap(in, *list)->head;
*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 tail = nextarg(&args);
O head = nextarg(in, &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 then_expr = nextarg(&args);
O else_expr = nextarg(&args);
O cond_expr = nextarg(in, &args);
O then_expr = nextarg(in, &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);
for (O next = nextarg(&args); next != NIL; next = nextarg(&args)) {
O fst = nextarg(in, &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 snd = nextarg(&args);
O fst = nextarg(in, &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 snd = nextarg(&args);
O fst = nextarg(in, &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 val_expr = nextarg(&args);
O sym = nextarg(in, &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 params = nextarg(&args);
O sym = nextarg(in, &args);
O params = nextarg(in, &args);
O body = args;
if (type(sym) != TYPE_SYM) {

4
src/read.c
View file

@ -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;
}
}

9
src/string.c
View file

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