commit 340fa4b70555fe29c3d0db26bdf58c2021cd7d79
parent 56064fb6d382250e9067beb303ba52b82aa3ca63
Author: Ed van Bruggen <edvb@uw.edu>
Date: Mon, 12 Oct 2020 19:10:13 -0700
Seperate primitive type into special form
Special forms behave like primitives used to but now primitives have
all their arguments evaluated by default. The C equilivent of functions
and macros
Diffstat:
| tib/io.c | | | 74 | +++++++++++++++++++++++++++++++------------------------------------------- |
| tib/math.c | | | 143 | +++++++++++++++++++++++++++++++++++++++++-------------------------------------- |
| tib/os.c | | | 25 | ++++++++++++------------- |
| tib/string.c | | | 29 | +++++++++++------------------ |
| tisp.c | | | 142 | ++++++++++++++++++++++++++++++++++--------------------------------------------- |
| tisp.h | | | 37 | ++++++++++++++++++++----------------- |
6 files changed, 209 insertions(+), 241 deletions(-)
diff --git a/tib/io.c b/tib/io.c
@@ -30,31 +30,28 @@
static Val
prim_write(Tsp st, Hash env, Val args)
{
- Val v;
FILE *f;
const char *mode = "w";
tsp_arg_min(args, "write", 2);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
/* if second argument is true, append file don't write over */
- if (!nilp(cadr(v)))
+ if (!nilp(cadr(args)))
mode = "a";
/* first argument can either be the symbol stdout or stderr,
* or the file as a string */
- if (car(v)->t == TSP_SYM)
- f = !strncmp(car(v)->v.s, "stdout", 7) ? stdout : stderr;
- else if (car(v)->t != TSP_STR)
+ if (car(args)->t == TSP_SYM)
+ f = !strncmp(car(args)->v.s, "stdout", 7) ? stdout : stderr;
+ else if (car(args)->t != TSP_STR)
tsp_warnf("write: expected file name as string, received %s",
- type_str(car(v)->t));
- else if (!(f = fopen(car(v)->v.s, mode)))
- tsp_warnf("write: could not load file '%s'", car(v)->v.s);
- if (f == stderr && strncmp(car(v)->v.s, "stderr", 7))
+ type_str(car(args)->t));
+ else if (!(f = fopen(car(args)->v.s, mode)))
+ tsp_warnf("write: could not load file '%s'", car(args)->v.s);
+ if (f == stderr && strncmp(car(args)->v.s, "stderr", 7))
tsp_warn("write: expected file name as string, "
"or symbol stdout/stderr");
- for (v = cddr(v); !nilp(v); v = cdr(v))
- tisp_print(f, car(v));
+ for (args = cddr(args); !nilp(args); args = cdr(args))
+ tisp_print(f, car(args));
if (f == stdout || f == stderr)
fflush(f);
else
@@ -66,15 +63,12 @@ prim_write(Tsp st, Hash env, Val args)
static Val
prim_read(Tsp st, Hash env, Val args)
{
- Val v;
char *file, *fname = NULL; /* read from stdin by default */
if (list_len(args) > 1)
tsp_warnf("read: expected 0 or 1 argument, received %d", list_len(args));
if (list_len(args) == 1) { /* if file name given as string, read it */
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- tsp_arg_type(v, "read", TSP_STR);
- fname = v->v.s;
+ tsp_arg_type(car(args), "read", TSP_STR);
+ fname = car(args)->v.s;
}
if (!(file = tisp_read_file(fname)))
return st->nil;
@@ -86,45 +80,41 @@ prim_read(Tsp st, Hash env, Val args)
static Val
prim_parse(Tsp st, Hash env, Val args)
{
- Val v;
+ Val expr;
char *file = st->file;
size_t filec = st->filec;
tsp_arg_num(args, "parse", 1);
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- if (nilp(v))
+ expr = car(args);
+ if (nilp(expr))
return mk_pair(mk_sym(st, "quit"), st->nil);
- tsp_arg_type(v, "parse", TSP_STR);
- st->file = v->v.s;
+ tsp_arg_type(expr, "parse", TSP_STR);
+ st->file = expr->v.s;
st->filec = 0;
- v = tisp_read(st);
- /* for (; tsp_fget(st) && (v = tisp_read(st));) ; */
+ expr = tisp_read(st);
+ /* for (; tsp_fget(st) && (expr = tisp_read(st));) ; */
st->file = file;
st->filec = filec;
- return v ? v : st->none;
- /* return tisp_parse_file(st, v->v.s); */
+ return expr ? expr : st->none;
+ /* return tisp_parse_file(st, expr->v.s); */
}
/* save value as binary file to be quickly read again */
static Val
prim_save(Tsp st, Hash env, Val args)
{
- Val v;
char *fname;
FILE *f;
tsp_arg_min(args, "save", 2);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- tsp_arg_type(cadr(v), "save", TSP_STR);
- fname = cadr(v)->v.s;
+ tsp_arg_type(cadr(args), "save", TSP_STR);
+ fname = cadr(args)->v.s;
if (!(f = fopen(fname, "wb")))
tsp_warnf("save: could not load file '%s'", fname);
- if (!(fwrite(&*car(v), sizeof(struct Val), 1, f))) {
+ if (!(fwrite(&*car(args), sizeof(struct Val), 1, f))) {
fclose(f);
tsp_warnf("save: could not save file '%s'", fname);
}
fclose(f);
- return car(v);
+ return car(args);
}
/* return read binary value previously saved */
@@ -138,9 +128,7 @@ prim_open(Tsp st, Hash env, Val args)
if (!(ret = malloc(sizeof(struct Val))))
perror("; malloc"), exit(1);
tsp_arg_min(args, "open", 1);
- if (!(args = tisp_eval_list(st, env, args)))
- return NULL;
- tsp_arg_type(car(args), "save", TSP_STR);
+ tsp_arg_type(car(args), "open", TSP_STR);
fname = car(args)->v.s;
if (!(f = fopen(fname, "rb")))
tsp_warnf("save: could not load file '%s'", fname);
@@ -153,9 +141,9 @@ prim_open(Tsp st, Hash env, Val args)
void
tib_env_io(Tsp st)
{
- tsp_env_fn(write);
- tsp_env_fn(read);
- tsp_env_fn(parse);
- tsp_env_fn(save);
- tsp_env_fn(open);
+ tsp_env_prim(write);
+ tsp_env_prim(read);
+ tsp_env_prim(parse);
+ tsp_env_prim(save);
+ tsp_env_prim(open);
}
diff --git a/tib/math.c b/tib/math.c
@@ -74,10 +74,11 @@ static Val
static Val \
prim_##NAME(Tsp st, Hash vars, Val args) \
{ \
- Val a; \
+ Val n; \
tsp_arg_num(args, #NAME, 1); \
- EVAL_CHECK(a, car(args), #NAME, TSP_NUM); \
- return (mk_num(a->t, a->t, FORCE))(NAME(num(a)/den(a)), 1.); \
+ n = car(args); \
+ tsp_arg_type(n, #NAME, TSP_NUM); \
+ return (mk_num(n->t, n->t, FORCE))(NAME(num(n)/den(n)), 1.); \
}
/* define int and dec as identity functions to use them in the same macro */
@@ -96,8 +97,9 @@ prim_add(Tsp st, Hash vars, Val args)
{
Val a, b;
tsp_arg_num(args, "+", 2);
- EVAL_CHECK(a, car(args), "+", TSP_NUM);
- EVAL_CHECK(b, car(cdr(args)), "+", TSP_NUM);
+ a = car(args), b = cadr(args);
+ tsp_arg_type(a, "+", TSP_NUM);
+ tsp_arg_type(b, "+", TSP_NUM);
if (a->t & TSP_DEC || b->t & TSP_DEC)
return mk_dec((num(a)/den(a)) + (num(b)/den(b)));
return (mk_num(a->t, b->t, 0))
@@ -112,12 +114,14 @@ prim_sub(Tsp st, Hash vars, Val args)
int len = list_len(args);
if (len != 2 && len != 1)
tsp_warnf("-: expected 1 or 2 arguments, recieved %d", len);
- EVAL_CHECK(a, car(args), "-", TSP_NUM);
+ a = car(args);
+ tsp_arg_type(a, "-", TSP_NUM);
if (len == 1) {
b = a;
a = mk_int(0);
} else {
- EVAL_CHECK(b, car(cdr(args)), "-", TSP_NUM);
+ b = cadr(args);
+ tsp_arg_type(b, "-", TSP_NUM);
}
if (a->t & TSP_DEC || b->t & TSP_DEC)
return mk_dec((num(a)/den(a)) - (num(b)/den(b)));
@@ -131,8 +135,9 @@ prim_mul(Tsp st, Hash vars, Val args)
{
Val a, b;
tsp_arg_num(args, "*", 2);
- EVAL_CHECK(a, car(args), "*", TSP_NUM);
- EVAL_CHECK(b, car(cdr(args)), "*", TSP_NUM);
+ a = car(args), b = cadr(args);
+ tsp_arg_type(a, "*", TSP_NUM);
+ tsp_arg_type(b, "*", TSP_NUM);
if (a->t & TSP_DEC || b->t & TSP_DEC)
return mk_dec((num(a)/den(a)) * (num(b)/den(b)));
return (mk_num(a->t, b->t, 0))(num(a) * num(b), den(a) * den(b));
@@ -146,12 +151,14 @@ prim_div(Tsp st, Hash vars, Val args)
int len = list_len(args);
if (len != 2 && len != 1)
tsp_warnf("/: expected 1 or 2 arguments, recieved %d", len);
- EVAL_CHECK(a, car(args), "/", TSP_NUM);
+ a = car(args);
+ tsp_arg_type(a, "/", TSP_NUM);
if (len == 1) {
b = a;
a = mk_int(1);
} else {
- EVAL_CHECK(b, car(cdr(args)), "/", TSP_NUM);
+ b = cadr(args);
+ tsp_arg_type(b, "/", TSP_NUM);
}
if (a->t & TSP_DEC || b->t & TSP_DEC)
return mk_dec((num(a)/den(a)) / (num(b)/den(b)));
@@ -163,8 +170,9 @@ prim_mod(Tsp st, Hash vars, Val args)
{
Val a, b;
tsp_arg_num(args, "mod", 2);
- EVAL_CHECK(a, car(args), "mod", TSP_INT);
- EVAL_CHECK(b, car(cdr(args)), "mod", TSP_INT);
+ a = car(args), b = cadr(args);
+ tsp_arg_type(a, "mod", TSP_INT);
+ tsp_arg_type(b, "mod", TSP_INT);
if (num(b) == 0)
tsp_warn("division by zero");
return mk_int((int)num(a) % abs((int)num(b)));
@@ -174,11 +182,12 @@ prim_mod(Tsp st, Hash vars, Val args)
static Val
prim_pow(Tsp st, Hash vars, Val args)
{
- double bnum, bden;
Val b, p;
+ double bnum, bden;
tsp_arg_num(args, "pow", 2);
- EVAL_CHECK(b, car(args), "pow", TSP_EXPR);
- EVAL_CHECK(p, car(cdr(args)), "pow", TSP_EXPR);
+ b = car(args), p = cadr(args);
+ tsp_arg_type(b, "pow", TSP_EXPR);
+ tsp_arg_type(p, "pow", TSP_EXPR);
bnum = pow(num(b), num(p)/den(p));
bden = pow(den(b), num(p)/den(p));
if ((bnum == (int)bnum && bden == (int)bden) ||
@@ -187,20 +196,17 @@ prim_pow(Tsp st, Hash vars, Val args)
return mk_pair(mk_sym(st, "^"), mk_pair(b, mk_pair(p, st->nil)));
}
-#define PRIM_COMPARE(NAME, OP) \
-static Val \
-prim_##NAME(Tsp st, Hash vars, Val args) \
-{ \
- Val v; \
- if (!(v = tisp_eval_list(st, vars, args))) \
- return NULL; \
- if (list_len(v) != 2) \
- return st->t; \
- tsp_arg_type(car(v), #OP, TSP_NUM); \
- tsp_arg_type(car(cdr(v)), #OP, TSP_NUM); \
- return ((num(car(v))*den(car(cdr(v)))) OP \
- (num(car(cdr(v)))*den(car(v)))) ? \
- st->t : st->nil; \
+#define PRIM_COMPARE(NAME, OP) \
+static Val \
+prim_##NAME(Tsp st, Hash vars, Val args) \
+{ \
+ if (list_len(args) != 2) \
+ return st->t; \
+ tsp_arg_type(car(args), #OP, TSP_NUM); \
+ tsp_arg_type(car(cdr(args)), #OP, TSP_NUM); \
+ return ((num(car(args))*den(car(cdr(args)))) OP \
+ (num(car(cdr(args)))*den(car(args)))) ? \
+ st->t : st->nil; \
}
PRIM_COMPARE(lt, <)
@@ -208,16 +214,15 @@ PRIM_COMPARE(gt, >)
PRIM_COMPARE(lte, <=)
PRIM_COMPARE(gte, >=)
-#define PRIM_TRIG(NAME) \
-static Val \
-prim_##NAME(Tsp st, Hash vars, Val args) \
-{ \
- Val v; \
- tsp_arg_num(args, #NAME, 1); \
- EVAL_CHECK(v, car(args), #NAME, TSP_EXPR); \
- if (v->t & TSP_DEC) \
- return mk_dec(NAME(num(v))); \
- return mk_pair(mk_sym(st, #NAME), mk_pair(v, st->nil)); \
+#define PRIM_TRIG(NAME) \
+static Val \
+prim_##NAME(Tsp st, Hash vars, Val args) \
+{ \
+ tsp_arg_num(args, #NAME, 1); \
+ tsp_arg_type(car(args), #NAME, TSP_EXPR); \
+ if (car(args)->t & TSP_DEC) \
+ return mk_dec(NAME(num(car(args)))); \
+ return mk_pair(mk_sym(st, #NAME), mk_pair(car(args), st->nil)); \
}
PRIM_TRIG(sin)
@@ -238,36 +243,36 @@ PRIM_TRIG(log)
void
tib_env_math(Tsp st)
{
- tsp_env_fn(Int);
- tsp_env_fn(Dec);
- tsp_env_fn(floor);
- tsp_env_fn(ceil);
- tsp_env_fn(round);
+ tsp_env_prim(Int);
+ tsp_env_prim(Dec);
+ tsp_env_prim(floor);
+ tsp_env_prim(ceil);
+ tsp_env_prim(round);
- tsp_env_name_fn(+, add);
- tsp_env_name_fn(-, sub);
- tsp_env_name_fn(*, mul);
- tsp_env_name_fn(/, div);
- tsp_env_fn(mod);
- tsp_env_name_fn(^, pow);
+ tsp_env_name_prim(+, add);
+ tsp_env_name_prim(-, sub);
+ tsp_env_name_prim(*, mul);
+ tsp_env_name_prim(/, div);
+ tsp_env_prim(mod);
+ tsp_env_name_prim(^, pow);
- tsp_env_name_fn(<, lt);
- tsp_env_name_fn(>, gt);
- tsp_env_name_fn(<=, lte);
- tsp_env_name_fn(>=, gte);
+ tsp_env_name_prim(<, lt);
+ tsp_env_name_prim(>, gt);
+ tsp_env_name_prim(<=, lte);
+ tsp_env_name_prim(>=, gte);
- tsp_env_fn(sin);
- tsp_env_fn(cos);
- tsp_env_fn(tan);
- tsp_env_fn(sinh);
- tsp_env_fn(cosh);
- tsp_env_fn(tanh);
- tsp_env_name_fn(arcsin, asin);
- tsp_env_name_fn(arccos, acos);
- tsp_env_name_fn(arctan, atan);
- tsp_env_name_fn(arcsinh, asinh);
- tsp_env_name_fn(arccosh, acosh);
- tsp_env_name_fn(arctanh, atanh);
- tsp_env_fn(exp);
- tsp_env_fn(log);
+ tsp_env_prim(sin);
+ tsp_env_prim(cos);
+ tsp_env_prim(tan);
+ tsp_env_prim(sinh);
+ tsp_env_prim(cosh);
+ tsp_env_prim(tanh);
+ tsp_env_name_prim(arcsin, asin);
+ tsp_env_name_prim(arccos, acos);
+ tsp_env_name_prim(arctan, atan);
+ tsp_env_name_prim(arcsinh, asinh);
+ tsp_env_name_prim(arccosh, acosh);
+ tsp_env_name_prim(arctanh, atanh);
+ tsp_env_prim(exp);
+ tsp_env_prim(log);
}
diff --git a/tib/os.c b/tib/os.c
@@ -30,13 +30,12 @@
static Val
prim_cd(Tsp st, Hash env, Val args)
{
- Val v;
+ Val dir;
tsp_arg_num(args, "cd", 1);
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- if (!(v->t & (TSP_STR|TSP_SYM)))
- tsp_warnf("strlen: expected string or symbol, received %s", type_str(v->t));
- if (chdir(v->v.s))
+ dir = car(args);
+ if (!(dir->t & (TSP_STR|TSP_SYM)))
+ tsp_warnf("strlen: expected string or symbol, received %s", type_str(dir->t));
+ if (chdir(dir->v.s))
return perror("; error: cd"), NULL;
return st->none;
}
@@ -44,7 +43,7 @@ prim_cd(Tsp st, Hash env, Val args)
/* TODO rename to cwd ? */
/* return string of current working directory */
static Val
-prim_pwd(Tsp st, Hash env, Val args)
+form_pwd(Tsp st, Hash env, Val args)
{
tsp_arg_num(args, "pwd", 0);
char cwd[PATH_MAX];
@@ -55,7 +54,7 @@ prim_pwd(Tsp st, Hash env, Val args)
/* return number of seconds since 1970 (unix time stamp) */
static Val
-prim_time(Tsp st, Hash env, Val args)
+form_time(Tsp st, Hash env, Val args)
{
tsp_arg_num(args, "time", 0);
return mk_int(time(NULL));
@@ -63,7 +62,7 @@ prim_time(Tsp st, Hash env, Val args)
/* return time taken to run command given */
static Val
-prim_timeit(Tsp st, Hash env, Val args)
+form_timeit(Tsp st, Hash env, Val args)
{
Val v;
clock_t t;
@@ -78,8 +77,8 @@ prim_timeit(Tsp st, Hash env, Val args)
void
tib_env_os(Tsp st)
{
- tsp_env_name_fn(cd!, cd);
- tsp_env_fn(pwd);
- tsp_env_fn(time);
- tsp_env_fn(timeit);
+ tsp_env_name_prim(cd!, cd);
+ tsp_env_form(pwd);
+ tsp_env_form(time);
+ tsp_env_form(timeit);
}
diff --git a/tib/string.c b/tib/string.c
@@ -26,7 +26,7 @@
typedef Val (*MkFn)(Tsp, char*);
-/* TODO string tib: lower upper strpos strsub */
+/* TODO string tib: lower upper capitalize strpos strsub (python: dir(str))*/
/* TODO simplify by using fmemopen/funopen and tisp_print */
static Val
@@ -88,40 +88,33 @@ val_string(Tsp st, Val args, MkFn mk_fn)
static Val
prim_Str(Tsp st, Hash env, Val args)
{
- Val v;
tsp_arg_min(args, "Str", 1);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- return val_string(st, v, mk_str);
+ return val_string(st, args, mk_str);
}
static Val
prim_Sym(Tsp st, Hash env, Val args)
{
- Val v;
tsp_arg_min(args, "Sym", 1);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- return val_string(st, v, mk_sym);
+ return val_string(st, args, mk_sym);
}
static Val
prim_strlen(Tsp st, Hash env, Val args)
{
- Val v;
+ Val str;
tsp_arg_num(args, "strlen", 1);
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- if (!(v->t & (TSP_STR|TSP_SYM)))
+ str = car(args);
+ if (!(str->t & (TSP_STR|TSP_SYM)))
tsp_warnf("strlen: expected string or symbol, received %s",
- type_str(v->t));
- return mk_int(strlen(v->v.s));
+ type_str(str->t));
+ return mk_int(strlen(str->v.s));
}
void
tib_env_string(Tsp st)
{
- tsp_env_fn(Sym);
- tsp_env_fn(Str);
- tsp_env_fn(strlen);
+ tsp_env_prim(Sym);
+ tsp_env_prim(Str);
+ tsp_env_prim(strlen);
}
diff --git a/tisp.c b/tisp.c
@@ -371,10 +371,10 @@ mk_sym(Tsp st, char *s)
}
Val
-mk_prim(Prim pr, char *name)
+mk_prim(TspType t, Prim pr, char *name)
{
Val ret = emalloc(sizeof(struct Val));
- ret->t = TSP_PRIM;
+ ret->t = t;
ret->v.pr.name = name;
ret->v.pr.pr = pr;
return ret;
@@ -704,14 +704,15 @@ eval_proc(Tsp st, Hash env, Val f, Val args)
{
Val ret;
Hash e;
+ /* evaluate function and primitive arguments before being passed */
+ if (f->t & (TSP_FUNC|TSP_PRIM))
+ if (!(args = tisp_eval_list(st, env, args)))
+ return NULL;
switch (f->t) {
+ case TSP_FORM:
case TSP_PRIM:
return (*f->v.pr.pr)(st, env, args);
case TSP_FUNC:
- /* tail call into the function body with the extended env */
- if (!(args = tisp_eval_list(st, env, args)))
- return NULL;
- /* FALLTHROUGH */
case TSP_MACRO:
tsp_arg_num(args, f->v.f.name ? f->v.f.name : "anonymous",
list_len(f->v.f.args));
@@ -813,40 +814,31 @@ tisp_print(FILE *f, Val v)
static Val
prim_car(Tsp st, Hash env, Val args)
{
- Val v;
tsp_arg_num(args, "car", 1);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- tsp_arg_type(car(v), "car", TSP_PAIR);
- return caar(v);
+ tsp_arg_type(car(args), "car", TSP_PAIR);
+ return caar(args);
}
/* return elements of a list after the first */
static Val
prim_cdr(Tsp st, Hash env, Val args)
{
- Val v;
tsp_arg_num(args, "cdr", 1);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- tsp_arg_type(car(v), "cdr", TSP_PAIR);
- return cdar(v);
+ tsp_arg_type(car(args), "cdr", TSP_PAIR);
+ return cdar(args);
}
/* return new pair */
static Val
prim_cons(Tsp st, Hash env, Val args)
{
- Val v;
tsp_arg_num(args, "cons", 2);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- return mk_pair(car(v), cadr(v));
+ return mk_pair(car(args), cadr(args));
}
/* do not evaluate argument */
static Val
-prim_quote(Tsp st, Hash env, Val args)
+form_quote(Tsp st, Hash env, Val args)
{
tsp_arg_num(args, "quote", 1);
return car(args);
@@ -854,7 +846,7 @@ prim_quote(Tsp st, Hash env, Val args)
/* returns nothing */
static Val
-prim_Void(Tsp st, Hash env, Val args)
+form_Void(Tsp st, Hash env, Val args)
{
return st->none;
}
@@ -865,29 +857,24 @@ prim_eval(Tsp st, Hash env, Val args)
{
Val v;
tsp_arg_num(args, "eval", 1);
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- return (v = tisp_eval(st, st->global, v)) ? v : st->none;
+ return (v = tisp_eval(st, st->global, car(args))) ? v : st->none;
}
/* test equality of all values given */
static Val
prim_eq(Tsp st, Hash env, Val args)
{
- Val v;
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- if (nilp(v))
+ if (nilp(args))
return st->t;
- for (; !nilp(cdr(v)); v = cdr(v))
- if (!vals_eq(car(v), cadr(v)))
+ for (; !nilp(cdr(args)); args = cdr(args))
+ if (!vals_eq(car(args), cadr(args)))
return st->nil;
return st->t;
}
/* evaluates all expressions if their conditions are met */
static Val
-prim_cond(Tsp st, Hash env, Val args)
+form_cond(Tsp st, Hash env, Val args)
{
Val v, cond;
for (v = args; !nilp(v); v = cdr(v))
@@ -902,23 +889,19 @@ prim_cond(Tsp st, Hash env, Val args)
static Val
prim_typeof(Tsp st, Hash env, Val args)
{
- Val v;
tsp_arg_num(args, "typeof", 1);
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- return mk_str(st, type_str(v->t));
+ return mk_str(st, type_str(car(args)->t));
}
+/* TODO rename get to getattr like python ? */
/* get a property of given value */
static Val
prim_get(Tsp st, Hash env, Val args)
{
Val v, prop;
tsp_arg_num(args, "get", 2);
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- if (!(prop = tisp_eval(st, env, cadr(args))))
- return NULL;
+ v = car(args);
+ prop = cadr(args);
tsp_arg_type(prop, "get", TSP_SYM);
switch (v->t) {
case TSP_PRIM:
@@ -959,7 +942,7 @@ prim_get(Tsp st, Hash env, Val args)
/* creates new tisp lambda function */
static Val
-prim_lambda(Tsp st, Hash env, Val args)
+form_lambda(Tsp st, Hash env, Val args)
{
tsp_arg_min(args, "lambda", 2);
return mk_func(TSP_FUNC, NULL, car(args), cdr(args), env);
@@ -967,7 +950,7 @@ prim_lambda(Tsp st, Hash env, Val args)
/* creates new tisp defined macro */
static Val
-prim_macro(Tsp st, Hash env, Val args)
+form_macro(Tsp st, Hash env, Val args)
{
tsp_arg_min(args, "macro", 2);
return mk_func(TSP_MACRO, NULL, car(args), cdr(args), env);
@@ -978,7 +961,7 @@ prim_macro(Tsp st, Hash env, Val args)
* function name and the cdr the function arguments */
/* TODO if var not func error if more than 2 args */
static Val
-prim_def(Tsp st, Hash env, Val args)
+form_def(Tsp st, Hash env, Val args)
{
Val sym, val;
tsp_arg_min(args, "def", 1);
@@ -1004,7 +987,7 @@ prim_def(Tsp st, Hash env, Val args)
/* set symbol to new value */
static Val
-prim_set(Tsp st, Hash env, Val args)
+form_set(Tsp st, Hash env, Val args)
{
Val val;
Hash h;
@@ -1032,7 +1015,7 @@ prim_set(Tsp st, Hash env, Val args)
static Val
prim_load(Tsp st, Hash env, Val args)
{
- Val v;
+ Val tib;
void (*tibenv)(Tsp);
char *name;
const char *paths[] = {
@@ -1040,14 +1023,13 @@ prim_load(Tsp st, Hash env, Val args)
};
tsp_arg_num(args, "load", 1);
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- tsp_arg_type(v, "load", TSP_STR);
+ tib = car(args);
+ tsp_arg_type(tib, "load", TSP_STR);
name = emalloc(PATH_MAX * sizeof(char));
for (int i = 0; paths[i]; i++) {
strcpy(name, paths[i]);
- strcat(name, v->v.s);
+ strcat(name, tib->v.s);
strcat(name, ".tsp");
if (access(name, R_OK) != -1) {
tisp_eval_seq(st, env, tisp_parse_file(st, name));
@@ -1059,23 +1041,23 @@ prim_load(Tsp st, Hash env, Val args)
/* If not tisp file, try loading shared object library */
st->libh = erealloc(st->libh, (st->libhc+1)*sizeof(void*));
- name = erealloc(name, (strlen(v->v.s)+10) * sizeof(char));
+ name = erealloc(name, (strlen(tib->v.s)+10) * sizeof(char));
strcpy(name, "libtib");
- strcat(name, v->v.s);
+ strcat(name, tib->v.s);
strcat(name, ".so");
if (!(st->libh[st->libhc] = dlopen(name, RTLD_LAZY))) {
free(name);
- tsp_warnf("load: could not load '%s':\n%s", v->v.s, dlerror());
+ tsp_warnf("load: could not load '%s':\n%s", tib->v.s, dlerror());
}
dlerror();
- name = erealloc(name, (strlen(v->v.s)+9) * sizeof(char));
+ name = erealloc(name, (strlen(tib->v.s)+9) * sizeof(char));
strcpy(name, "tib_env_");
- strcat(name, v->v.s);
+ strcat(name, tib->v.s);
tibenv = dlsym(st->libh[st->libhc], name);
if (dlerror()) {
free(name);
- tsp_warnf("load: could not run '%s':\n%s", v->v.s, dlerror());
+ tsp_warnf("load: could not run '%s':\n%s", tib->v.s, dlerror());
}
(*tibenv)(st);
free(name);
@@ -1088,22 +1070,20 @@ prim_load(Tsp st, Hash env, Val args)
static Val
prim_error(Tsp st, Hash env, Val args)
{
- Val v;
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
/* TODO have error auto print function name that was pre-defined */
- tsp_arg_min(v, "error", 2);
- tsp_arg_type(car(v), "error", TSP_SYM);
- fprintf(stderr, "; tisp: error: %s: ", car(v)->v.s); /* TODO specify error raised by error func */
- for (v = cdr(v); !nilp(v); v = cdr(v))
- tisp_print(stderr, car(v));
+ tsp_arg_min(args, "error", 2);
+ tsp_arg_type(car(args), "error", TSP_SYM);
+ /* TODO specify error raised by error func */
+ fprintf(stderr, "; tisp: error: %s: ", car(args)->v.s);
+ for (args = cdr(args); !nilp(args); args = cdr(args))
+ tisp_print(stderr, car(args));
fputc('\n', stderr);
return NULL;
}
/* list tisp version */
static Val
-prim_version(Tsp st, Hash env, Val args)
+form_version(Tsp st, Hash env, Val args)
{
return mk_str(st, "0.0");
}
@@ -1138,23 +1118,23 @@ tisp_env_init(size_t cap)
tisp_env_add(st, "True", st->t);
tisp_env_add(st, "Nil", st->nil);
tisp_env_add(st, "bt", st->nil);
- tsp_env_fn(car);
- tsp_env_fn(cdr);
- tsp_env_fn(cons);
- tsp_env_fn(quote);
- tsp_env_fn(Void);
- tsp_env_fn(eval);
- tsp_env_name_fn(=, eq);
- tsp_env_fn(cond);
- tsp_env_fn(typeof);
- tsp_env_fn(get);
- tsp_env_fn(lambda);
- tsp_env_fn(macro);
- tsp_env_fn(def);
- tsp_env_name_fn(set!, set);
- tsp_env_fn(load);
- tsp_env_fn(error);
- tsp_env_fn(version);
+ tsp_env_prim(car);
+ tsp_env_prim(cdr);
+ tsp_env_prim(cons);
+ tsp_env_form(quote);
+ tsp_env_form(Void);
+ tsp_env_prim(eval);
+ tsp_env_name_prim(=, eq);
+ tsp_env_form(cond);
+ tsp_env_prim(typeof);
+ tsp_env_prim(get);
+ tsp_env_form(lambda);
+ tsp_env_form(macro);
+ tsp_env_form(def);
+ tsp_env_name_form(set!, set);
+ tsp_env_prim(load);
+ tsp_env_prim(error);
+ tsp_env_form(version);
st->strs = hash_new(cap, NULL);
st->syms = hash_new(cap, NULL);
diff --git a/tisp.h b/tisp.h
@@ -45,9 +45,11 @@
type_str(TYPE), type_str(ARG->t)); \
} while(0)
-#define tsp_env_name_fn(NAME, FN) tisp_env_add(st, #NAME, mk_prim(prim_##FN, #NAME))
-#define tsp_env_fn(NAME) tsp_env_name_fn(NAME, NAME)
-#define tsp_include_tib(NAME) void tib_env_##NAME(Tsp)
+#define tsp_env_name_prim(NAME, FN) tisp_env_add(st, #NAME, mk_prim(TSP_PRIM, prim_##FN, #NAME))
+#define tsp_env_prim(NAME) tsp_env_name_prim(NAME, NAME)
+#define tsp_env_name_form(NAME, FN) tisp_env_add(st, #NAME, mk_prim(TSP_FORM, form_##FN, #NAME))
+#define tsp_env_form(NAME) tsp_env_name_form(NAME, NAME)
+#define tsp_include_tib(NAME) void tib_env_##NAME(Tsp)
#define tsp_finc(ST) ST->filec++
#define tsp_fgetat(ST, O) ST->file[ST->filec+O]
@@ -80,17 +82,18 @@ typedef struct Hash {
/* possible tisp object types */
typedef enum {
- TSP_NONE = 1 << 0,
- TSP_NIL = 1 << 1,
- TSP_INT = 1 << 2,
- TSP_DEC = 1 << 3,
- TSP_RATIO = 1 << 4,
- TSP_STR = 1 << 5,
- TSP_SYM = 1 << 6,
- TSP_PRIM = 1 << 7,
- TSP_FUNC = 1 << 8,
- TSP_MACRO = 1 << 9,
- TSP_PAIR = 1 << 10,
+ TSP_NONE = 1 << 0, /* void */
+ TSP_NIL = 1 << 1, /* nil: false, empty list */
+ TSP_INT = 1 << 2, /* integer: whole number */
+ TSP_DEC = 1 << 3, /* decimal: floating point number */
+ TSP_RATIO = 1 << 4, /* ratio: numerator/denominator */
+ TSP_STR = 1 << 5, /* string: immutable characters */
+ TSP_SYM = 1 << 6, /* symbol: variable names */
+ TSP_PRIM = 1 << 7, /* primitive: built-in function */
+ TSP_FORM = 1 << 8, /* special form: built-in macro */
+ TSP_FUNC = 1 << 9, /* function: procedure written is tisp */
+ TSP_MACRO = 1 << 10, /* macro: function without evaluated arguments */
+ TSP_PAIR = 1 << 11, /* pair: building block for lists */
} TspType;
#define TSP_RATIONAL (TSP_INT | TSP_RATIO)
#define TSP_NUM (TSP_RATIONAL | TSP_DEC)
@@ -106,8 +109,8 @@ struct Val {
union {
char *s; /* STRING, SYMBOL */
struct { double num, den; } n; /* NUMBER */
- struct { char *name; Prim pr; } pr; /* PRIMITIVE */
- struct { char *name; Val args, body; Hash env; } f; /* FUNCTION */
+ struct { char *name; Prim pr; } pr; /* PRIMITIVE, FORM */
+ struct { char *name; Val args, body; Hash env; } f; /* FUNCTION, MACRO */
struct { Val car, cdr; } p; /* PAIR */
} v;
};
@@ -130,7 +133,7 @@ Val mk_dec(double d);
Val mk_rat(int num, int den);
Val mk_str(Tsp st, char *s);
Val mk_sym(Tsp st, char *s);
-Val mk_prim(Prim prim, char *name);
+Val mk_prim(TspType t, Prim prim, char *name);
Val mk_func(TspType t, char *name, Val args, Val body, Hash env);
Val mk_pair(Val a, Val b);
Val mk_list(Tsp st, int n, Val *a);
