diff --git a/.gitignore b/.gitignore index 7dd96ee..d654e30 100644 --- a/.gitignore +++ b/.gitignore @@ -3,4 +3,3 @@ wscm compile_commands.json .cache .envrc -test.lisp diff --git a/include/wolflisp.h b/include/wolflisp.h index 4b77e53..14c1c79 100644 --- a/include/wolflisp.h +++ b/include/wolflisp.h @@ -35,14 +35,9 @@ typedef struct Pa { typedef struct Sy { U32 hash; Z len; - char *data; + U8 *data; } Sy; -typedef struct Ss { - Z len; - char *data; -} Ss; - // Closure typedef struct Cl { O args, body, env; @@ -78,7 +73,6 @@ enum { TYPE_SYM = 2, TYPE_PRIM = 4, TYPE_PAIR, - TYPE_STR, TYPE_CLOS, TYPE_MAC, TYPE_FWD, @@ -201,9 +195,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(In *in, O obj); - -O string_make(In *in, const char *cstr, I len); +Pa *pair_unwrap(O obj); V print(O obj); V println(O obj); @@ -211,8 +203,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(In *in, O key, O alist); -O list_reverse(In *in, O list); +O list_assoc(O key, O alist); +O list_reverse(O list); int nexttoken(Lx *lex); diff --git a/meson.build b/meson.build index f807883..a22f9ca 100644 --- a/meson.build +++ b/meson.build @@ -18,7 +18,6 @@ src = [ 'src/prim.c', 'src/print.c', 'src/read.c', - 'src/string.c', 'src/symbol.c', 'src/type.c', ] diff --git a/src/interp.c b/src/interp.c index f84d6b5..8c2dad9 100644 --- a/src/interp.c +++ b/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(in, params); + Pa *p = pair_unwrap(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(in, args); + Pa *a = pair_unwrap(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(in, curr); + Pa *p = pair_unwrap(curr); O obj = eval(in, p->head, env); head = pair_make(in, obj, head); curr = p->tail; } - O result = list_reverse(in, head); + O result = list_reverse(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(in, obj, env); + O pair = list_assoc(obj, env); if (pair == NIL) { - pair = list_assoc(in, obj, in->env); + pair = list_assoc(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(in, pair)->tail; + return pair_unwrap(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(in, obj); + Pa *c = pair_unwrap(obj); O fn = eval(in, c->head, env); gc_addroot(&in->gc, &fn); diff --git a/src/list.c b/src/list.c index d3fb118..b1fa297 100644 --- a/src/list.c +++ b/src/list.c @@ -2,16 +2,16 @@ #include -O list_assoc(In *in, O key, O alist) { +O list_assoc(O key, O alist) { while (type(alist) == TYPE_PAIR) { - Pa *c = pair_unwrap(in, alist); + Pa *c = pair_unwrap(alist); O pair = c->head; if (pair == NIL) { alist = c->tail; continue; } if (type(pair) == TYPE_PAIR) { - Pa *kv = pair_unwrap(in, pair); + Pa *kv = pair_unwrap(pair); if (kv->head == key) return pair; } @@ -20,13 +20,13 @@ O list_assoc(In *in, O key, O alist) { return NIL; } -O list_reverse(In *in, O list) { +O list_reverse(O list) { O prev = NIL; O curr = list; O next; while (curr != NIL) { - Pa *c = pair_unwrap(in, curr); + Pa *c = pair_unwrap(curr); next = c->tail; c->tail = prev; prev = curr; diff --git a/src/pair.c b/src/pair.c index 147a071..cd24e5b 100644 --- a/src/pair.c +++ b/src/pair.c @@ -19,9 +19,10 @@ O pair_make(In *in, O head, O tail) { return BOX(hdr); } -Pa *pair_unwrap(In *in, O obj) { +Pa *pair_unwrap(O obj) { 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); -} +} \ No newline at end of file diff --git a/src/prim.c b/src/prim.c index 87f2645..4d3bc06 100644 --- a/src/prim.c +++ b/src/prim.c @@ -2,11 +2,11 @@ #include #include -static O nextarg(In *in, O *list) { +static O nextarg(O *list) { if (*list == NIL) return NIL; - O arg = pair_unwrap(in, *list)->head; - *list = pair_unwrap(in, *list)->tail; + O arg = pair_unwrap(*list)->head; + *list = pair_unwrap(*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(in, &args); - O tail = nextarg(in, &args); + O head = nextarg(&args); + O tail = nextarg(&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(in, nextarg(in, &args))->head; + return pair_unwrap(nextarg(&args))->head; } O prim_tail(In *in, O args, O 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) { args = interp_eval_list(in, args, env); - print(nextarg(in, &args)); + print(nextarg(&args)); return NIL; } O prim_println(In *in, O args, O env) { args = interp_eval_list(in, args, env); - O arg = nextarg(in, &args); + O arg = nextarg(&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(in, &args); + return nextarg(&args); } O prim_if(In *in, O args, O env) { - O cond_expr = nextarg(in, &args); - O then_expr = nextarg(in, &args); - O else_expr = nextarg(in, &args); + O cond_expr = nextarg(&args); + O then_expr = nextarg(&args); + O else_expr = nextarg(&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(in, &args); expr != NIL; expr = nextarg(in, &args)) + for (O expr = nextarg(&args); expr != NIL; expr = nextarg(&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(in, &args); + I result = nextarg(&args); if (result == NIL) { return NUM(0); } else { 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)) { 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(in, &args); + I result = nextarg(&args); if (result == NIL) { return NUM(0); } else { 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)) { 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(in, &args); + I result = nextarg(&args); if (result == NIL) { return NUM(1); } else { 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)) { 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(in, &args); + I result = nextarg(&args); if (result == NIL) { return NUM(1); } else { 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)) { 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(in, &args); - for (O next = nextarg(in, &args); next != NIL; next = nextarg(in, &args)) { + O fst = nextarg(&args); + for (O next = nextarg(&args); next != NIL; next = nextarg(&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(in, &args); - O snd = nextarg(in, &args); + O fst = nextarg(&args); + O snd = nextarg(&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(in, &args); - O snd = nextarg(in, &args); + O fst = nextarg(&args); + O snd = nextarg(&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(in, &args); + O params = nextarg(&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(in, &args); + O params = nextarg(&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(in, &args); - O val_expr = nextarg(in, &args); + O sym = nextarg(&args); + O val_expr = nextarg(&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(in, &args); - O params = nextarg(in, &args); + O sym = nextarg(&args); + O params = nextarg(&args); O body = args; if (type(sym) != TYPE_SYM) { diff --git a/src/print.c b/src/print.c index 8b8ce53..884b8cd 100644 --- a/src/print.c +++ b/src/print.c @@ -55,11 +55,6 @@ void print(O obj) { case TYPE_PAIR: print_pair(obj); break; - case TYPE_STR: { - Ss *s = (Ss *)(h + 1); - printf("%.*s", (int)s->len, s->data); - break; - } case TYPE_CLOS: { Cl *cl = (Cl *)(h + 1); printf("<#fn "); diff --git a/src/read.c b/src/read.c index 82d7c19..06f09ac 100644 --- a/src/read.c +++ b/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(in, tail)->tail = last; + pair_unwrap(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(in, tail)->tail = cell; + pair_unwrap(tail)->tail = cell; tail = cell; } } @@ -76,7 +76,7 @@ int read_expr(In *in, Lx *lex, O *result) { } case TOK_STRING: - *result = string_make(in, lex->buffer, -1); + *result = symbol_make(in, lex->buffer); break; case TOK_WORD: diff --git a/src/string.c b/src/string.c index c2253fa..e69de29 100644 --- a/src/string.c +++ b/src/string.c @@ -1,24 +0,0 @@ -#include -#include - -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); -} - diff --git a/src/type.c b/src/type.c index 7d9ada6..3305bd0 100644 --- a/src/type.c +++ b/src/type.c @@ -10,7 +10,6 @@ static const char *typenames[] = { [TYPE_SYM] = "symbol", [TYPE_PRIM] = "primitive", [TYPE_PAIR] = "pair", - [TYPE_STR] = "string", [TYPE_CLOS] = "closure", [TYPE_MAC] = "macro", };