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

Compare commits

base: lobo:5504f6b1235c05ab201d9ebe6e91db1f1207fd0b
Branches Tags
lobo:trunk
..
compare: lobo:83fce464496a3550e6edd2ee708b65abb873ae16
Branches Tags
lobo:trunk

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

11 changed files with 58 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

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

16
include/wolflisp.h
View file

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

1
meson.build
View file

@ -18,7 +18,6 @@ src = [
'src/prim.c',
'src/print.c',
'src/read.c',
'src/string.c',
'src/symbol.c',
'src/type.c',
]

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

10
src/list.c
View file

@ -2,16 +2,16 @@
#include <wolflisp.h>
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;

5
src/pair.c
View file

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

68
src/prim.c
View file

@ -2,11 +2,11 @@
#include <stdlib.h>
#include <wolflisp.h>
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) {

5
src/print.c
View file

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

6
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(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:

24
src/string.c
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);
}

1
src/type.c
View file

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