Compare commits

..

No commits in common. "5504f6b1235c05ab201d9ebe6e91db1f1207fd0b" and "83fce464496a3550e6edd2ee708b65abb873ae16" have entirely different histories.

11 changed files with 58 additions and 97 deletions

1
.gitignore vendored
View file

@ -3,4 +3,3 @@ wscm
compile_commands.json compile_commands.json
.cache .cache
.envrc .envrc
test.lisp

View file

@ -35,14 +35,9 @@ typedef struct Pa {
typedef struct Sy { typedef struct Sy {
U32 hash; U32 hash;
Z len; Z len;
char *data; U8 *data;
} Sy; } Sy;
typedef struct Ss {
Z len;
char *data;
} Ss;
// Closure // Closure
typedef struct Cl { typedef struct Cl {
O args, body, env; O args, body, env;
@ -78,7 +73,6 @@ enum {
TYPE_SYM = 2, TYPE_SYM = 2,
TYPE_PRIM = 4, TYPE_PRIM = 4,
TYPE_PAIR, TYPE_PAIR,
TYPE_STR,
TYPE_CLOS, TYPE_CLOS,
TYPE_MAC, TYPE_MAC,
TYPE_FWD, TYPE_FWD,
@ -201,9 +195,7 @@ Sy *intern(St *tab, const char *str, Z len);
// Create a pair // Create a pair
O pair_make(In *in, O head, O tail); O pair_make(In *in, O head, O tail);
// Unwrap a pair // Unwrap a pair
Pa *pair_unwrap(In *in, O obj); Pa *pair_unwrap(O obj);
O string_make(In *in, const char *cstr, I len);
V print(O obj); V print(O obj);
V println(O obj); V println(O obj);
@ -211,8 +203,8 @@ V println(O obj);
O symbol_make(In *in, const char *str); O symbol_make(In *in, const char *str);
O prim_make(In *in, const char *name, O (*fn)(In *, O, O)); O prim_make(In *in, const char *name, O (*fn)(In *, O, O));
O list_assoc(In *in, O key, O alist); O list_assoc(O key, O alist);
O list_reverse(In *in, O list); O list_reverse(O list);
int nexttoken(Lx *lex); int nexttoken(Lx *lex);

View file

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

View file

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

View file

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

View file

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

View file

@ -55,11 +55,6 @@ void print(O obj) {
case TYPE_PAIR: case TYPE_PAIR:
print_pair(obj); print_pair(obj);
break; break;
case TYPE_STR: {
Ss *s = (Ss *)(h + 1);
printf("%.*s", (int)s->len, s->data);
break;
}
case TYPE_CLOS: { case TYPE_CLOS: {
Cl *cl = (Cl *)(h + 1); Cl *cl = (Cl *)(h + 1);
printf("<#fn "); printf("<#fn ");

View file

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

View file

@ -1,24 +0,0 @@
#include <string.h>
#include <wolflisp.h>
O string_make(In *in, const char *cstr, I len) {
if (len < 0)
len = strlen(cstr);
Z size = sizeof(Gh) + sizeof(Ss) + len + 1;
Gh *hdr = gc_alloc(&in->gc, size);
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);
}

View file

@ -10,7 +10,6 @@ static const char *typenames[] = {
[TYPE_SYM] = "symbol", [TYPE_SYM] = "symbol",
[TYPE_PRIM] = "primitive", [TYPE_PRIM] = "primitive",
[TYPE_PAIR] = "pair", [TYPE_PAIR] = "pair",
[TYPE_STR] = "string",
[TYPE_CLOS] = "closure", [TYPE_CLOS] = "closure",
[TYPE_MAC] = "macro", [TYPE_MAC] = "macro",
}; };