Compare commits
No commits in common. "5504f6b1235c05ab201d9ebe6e91db1f1207fd0b" and "83fce464496a3550e6edd2ee708b65abb873ae16" have entirely different histories.
5504f6b123
...
83fce46449
11 changed files with 58 additions and 97 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -3,4 +3,3 @@ wscm
|
||||||
compile_commands.json
|
compile_commands.json
|
||||||
.cache
|
.cache
|
||||||
.envrc
|
.envrc
|
||||||
test.lisp
|
|
||||||
|
|
|
||||||
|
|
@ -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);
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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',
|
||||||
]
|
]
|
||||||
|
|
|
||||||
16
src/interp.c
16
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");
|
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);
|
||||||
|
|
||||||
|
|
|
||||||
10
src/list.c
10
src/list.c
|
|
@ -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;
|
||||||
|
|
|
||||||
|
|
@ -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);
|
||||||
}
|
}
|
||||||
68
src/prim.c
68
src/prim.c
|
|
@ -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) {
|
||||||
|
|
|
||||||
|
|
@ -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 ");
|
||||||
|
|
|
||||||
|
|
@ -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:
|
||||||
|
|
|
||||||
24
src/string.c
24
src/string.c
|
|
@ -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);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
@ -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",
|
||||||
};
|
};
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue