tisp

tiny lisp
git clone git://edryd.org/tisp
Log | Files | Refs | LICENSE

commit 0f6536a2239b52e23aeae5ac74c8e2b86139827d
parent 1e6de8943d87aab3b5abbb66a54c56fd364300ba
Author: Ed van Bruggen <edvb@uw.edu>
Date:   Tue, 17 Dec 2019 23:58:52 -0800

Differentiate state and environment to fix eval

Fix function and macro calls by using environment when function was
created to evaluate body, but use local environment for evaluating macro
results to prevent arguments escaping the body's scope.

Fix prim_write

Diffstat:
main.c | 27+++++++++++++--------------
test.c | 21++++++++++-----------
tibs/io.c | 38+++++++++++++++++++-------------------
tibs/lib.tsp | 4++--
tibs/math.c | 79++++++++++++++++++++++++++++++++++++++++---------------------------------------
tibs/string.c | 31++++++++++++++++---------------
tibs/time.c | 8++++----
tisp.c | 426++++++++++++++++++++++++++++++++++++-------------------------------------------
tisp.h | 51+++++++++++++++++++++++++++------------------------
9 files changed, 326 insertions(+), 359 deletions(-)

diff --git a/main.c b/main.c @@ -19,30 +19,30 @@ main(int argc, char *argv[]) int i; Val v = NULL; - Env env = tisp_env_init(64); + Tsp st = tisp_env_init(64); #ifndef TIB_DYNAMIC - tib_env_math(env); - tib_env_io(env); - tib_env_time(env); - tib_env_string(env); + tib_env_math(st); + tib_env_io(st); + tib_env_time(st); + tib_env_string(st); # include "libs.tsp.h" - tisp_env_lib(env, libs_tsp); + tisp_env_lib(st, libs_tsp); #endif /* TODO reduce redunecy by setting argv[i][0] = '-' ? */ if (argc == 1) - if ((v = tisp_eval_list(env, tisp_parse_file(env, NULL)))) - tisp_print(stdout, v); + if ((v = tisp_eval_list(st, st->global, tisp_parse_file(st, NULL)))) + tisp_print(stdout, car(v)); for (i = 1; i < argc; i++, v = NULL) { if (argv[i][0] == '-') { if (argv[i][1] == 'c') { /* run next argument as tisp command */ - if (!(env->file = argv[++i])) { + if (!(st->file = argv[++i])) { fputs("tisp: expected command after -c\n", stderr); exit(2); } - if ((v = tisp_read(env))) - v = tisp_eval(env, v); + if ((v = tisp_read(st))) + v = tisp_eval(st, st->global, v); } else if (argv[i][1] == 'v') { /* version and copyright info */ fprintf(stderr, "tisp v%s (c) 2017-2019 Ed van Bruggen\n", VERSION); exit(0); @@ -50,17 +50,16 @@ main(int argc, char *argv[]) fputs("usage: tisp [-hv] [FILE ...]\n", stderr); exit(argv[i][1] == 'h' ? 0 : 1); } else { /* single hypen read from stdin */ - v = tisp_eval_list(env, tisp_parse_file(env, NULL)); + v = tisp_eval_list(st, st->global, tisp_parse_file(st, NULL)); } } else { /* otherwise read as file */ - v = tisp_eval_list(env, tisp_parse_file(env, argv[i])); + v = tisp_eval_list(st, st->global, tisp_parse_file(st, argv[i])); } if (v) tisp_print(stdout, v); } puts(""); - /* tisp_env_free(env); */ return 0; } diff --git a/test.c b/test.c @@ -482,19 +482,19 @@ char *tests[][2] = { }; int -tisp_test(Env env, const char *input, const char *expect, int output) +tisp_test(Tsp st, const char *input, const char *expect, int output) { Val v; FILE *f; size_t nread; char buf[BUFSIZ] = {0}; - if (!(env->file = strdup(input))) + if (!(st->file = strdup(input))) return 0; - env->filec = 0; - if (!(v = tisp_read(env))) + st->filec = 0; + if (!(v = tisp_read(st))) return 0; - if (!(v = tisp_eval(env, v))) { + if (!(v = tisp_eval(st, st->global, v))) { if (output) putchar('\n'); return 0; @@ -519,9 +519,9 @@ main(void) { int correct = 0, total = 0, seccorrect = 0, sectotal = 0, last = 1; int errors[LEN(tests)] = {0}; - Env env = tisp_env_init(1024); - tib_env_math(env); - tisp_env_lib(env, libs_tsp); + Tsp st = tisp_env_init(1024); + tib_env_math(st); + tisp_env_lib(st, libs_tsp); for (int i = 0; ; i++) { if (!tests[i][1]) { @@ -534,7 +534,7 @@ main(void) printf(" input: %s\n" " expect: %s\n" " output: ", tests[j][0], tests[j][1]); - tisp_test(env, tests[j][0], tests[j][1], 1); + tisp_test(st, tests[j][0], tests[j][1], 1); } last = i + 1; } @@ -544,7 +544,7 @@ main(void) seccorrect = 0; sectotal = 0; } else { - if (tisp_test(env, tests[i][0], tests[i][1], 0)) { + if (tisp_test(st, tests[i][0], tests[i][1], 0)) { correct++; seccorrect++; } else { @@ -556,6 +556,5 @@ main(void) } printf("%-10s %d/%d\n", "total", correct, total); - /* tisp_env_free(env); */ return correct != total; } diff --git a/tibs/io.c b/tibs/io.c @@ -27,12 +27,12 @@ /* write all arguemnts to given file, or stdout/stderr, without newline */ static Val -prim_write(Env env, Val args) +prim_write(Tsp st, Hash env, Val args) { Val v; FILE *f; tsp_arg_min(args, "write", 2); - if (!(v = tisp_eval_list(env, args))) + if (!(v = tisp_eval_list(st, env, args))) return NULL; /* first argument can either be the symbol stdout or stderr, @@ -54,52 +54,52 @@ prim_write(Env env, Val args) else tisp_print(f, car(v)); fflush(f); - return env->none; + return st->none; } /* return string of given file or read from stdin */ static Val -prim_read(Env env, Val args) +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(env, car(args)))) + if (!(v = tisp_eval(st, env, car(args)))) return NULL; tsp_arg_type(v, "read", STRING); fname = v->v.s; } if (!(file = tisp_read_file(fname))) - return env->nil; - return mk_str(env, file); + return st->nil; + return mk_str(st, file); } /* parse string as tisp expression, return (quit) if given nil */ /* TODO parse more than 1 expression */ static Val -prim_parse(Env env, Val args) +prim_parse(Tsp st, Hash env, Val args) { Val v; - char *file = env->file; - size_t filec = env->filec; + char *file = st->file; + size_t filec = st->filec; tsp_arg_num(args, "parse", 1); - if (!(v = tisp_eval(env, car(args)))) + if (!(v = tisp_eval(st, env, car(args)))) return NULL; if (nilp(v)) - return mk_pair(mk_sym(env, "quit"), env->nil); + return mk_pair(mk_sym(st, "quit"), st->nil); tsp_arg_type(v, "parse", STRING); - env->file = v->v.s; - env->filec = 0; - v = tisp_read(env); - env->file = file; - env->filec = filec; - return v ? v : env->none; + st->file = v->v.s; + st->filec = 0; + v = tisp_read(st); + st->file = file; + st->filec = filec; + return v ? v : st->none; } void -tib_env_io(Env env) +tib_env_io(Tsp st) { tsp_env_fn(write); tsp_env_fn(read); diff --git a/tibs/lib.tsp b/tibs/lib.tsp @@ -63,8 +63,8 @@ ;;; Control Flow ; TODO if d = pair and car d = else use cdr d -(defmacro (if con c d) - (list 'cond (list con c) (list t d))) +(defmacro (if con a b) + (list 'cond (list con a) (list t b))) (define else t) (defmacro (when con . body) (list 'cond (list con (cons 'do body)))) diff --git a/tibs/math.c b/tibs/math.c @@ -25,14 +25,14 @@ #include "../tisp.h" -#define EVAL_CHECK(A, V, NAME, TYPE) do { \ - if (!(A = tisp_eval(env, V))) \ - return NULL; \ - tsp_arg_type(A, NAME, TYPE); \ +#define EVAL_CHECK(A, V, NAME, TYPE) do { \ + if (!(A = tisp_eval(st, vars, V))) \ + return NULL; \ + tsp_arg_type(A, NAME, TYPE); \ } while(0) static Val -prim_numerator(Env env, Val args) +prim_numerator(Tsp st, Hash vars, Val args) { Val a; tsp_arg_num(args, "numerator", 1); @@ -41,7 +41,7 @@ prim_numerator(Env env, Val args) } static Val -prim_denominator(Env env, Val args) +prim_denominator(Tsp st, Hash vars, Val args) { Val a; tsp_arg_num(args, "denominator", 1); @@ -90,7 +90,7 @@ static Val #define PRIM_ROUND(NAME, FORCE) \ static Val \ -prim_##NAME(Env env, Val args) \ +prim_##NAME(Tsp st, Hash vars, Val args) \ { \ Val a; \ tsp_arg_num(args, #NAME, 1); \ @@ -110,7 +110,7 @@ PRIM_ROUND(floor, 0) PRIM_ROUND(ceil, 0) static Val -prim_add(Env env, Val args) +prim_add(Tsp st, Hash vars, Val args) { Val a, b; tsp_arg_num(args, "+", 2); @@ -124,7 +124,7 @@ prim_add(Env env, Val args) } static Val -prim_sub(Env env, Val args) +prim_sub(Tsp st, Hash vars, Val args) { Val a, b; int len = list_len(args); @@ -145,7 +145,7 @@ prim_sub(Env env, Val args) } static Val -prim_mul(Env env, Val args) +prim_mul(Tsp st, Hash vars, Val args) { Val a, b; tsp_arg_num(args, "*", 2); @@ -158,7 +158,7 @@ prim_mul(Env env, Val args) } static Val -prim_div(Env env, Val args) +prim_div(Tsp st, Hash vars, Val args) { Val a, b; int len = list_len(args); @@ -177,7 +177,7 @@ prim_div(Env env, Val args) } static Val -prim_mod(Env env, Val args) +prim_mod(Tsp st, Hash vars, Val args) { Val a, b; tsp_arg_num(args, "mod", 2); @@ -188,8 +188,9 @@ prim_mod(Env env, Val args) return mk_int((int)num(a) % abs((int)num(b))); } +/* TODO if given function as 2nd arg run it on first arg */ static Val -prim_pow(Env env, Val args) +prim_pow(Tsp st, Hash vars, Val args) { double bnum, bden; Val b, p; @@ -201,23 +202,23 @@ prim_pow(Env env, Val args) if (bnum == (int)bnum && bden == (int)bden && b->t & NUMBER && p->t & NUMBER) return mk_num(b->t, p->t, 0)(bnum, bden); - return mk_pair(mk_sym(env, "^"), mk_pair(b, mk_pair(p, env->nil))); + return mk_pair(mk_sym(st, "^"), mk_pair(b, mk_pair(p, st->nil))); } -#define PRIM_COMPARE(NAME, OP) \ -static Val \ -prim_##NAME(Env env, Val args) \ -{ \ - Val v; \ - if (!(v = tisp_eval_list(env, args))) \ - return NULL; \ - if (list_len(v) != 2) \ - return env->t; \ - tsp_arg_type(car(v), #OP, NUMBER); \ - tsp_arg_type(car(cdr(v)), #OP, NUMBER); \ - return ((num(car(v))*den(car(cdr(v)))) OP \ - (num(car(cdr(v)))*den(car(v)))) ? \ - env->t : env->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, NUMBER); \ + tsp_arg_type(car(cdr(v)), #OP, NUMBER); \ + return ((num(car(v))*den(car(cdr(v)))) OP \ + (num(car(cdr(v)))*den(car(v)))) ? \ + st->t : st->nil; \ } PRIM_COMPARE(lt, <) @@ -225,16 +226,16 @@ PRIM_COMPARE(gt, >) PRIM_COMPARE(lte, <=) PRIM_COMPARE(gte, >=) -#define PRIM_TRIG(NAME) \ -static Val \ -prim_##NAME(Env env, Val args) \ -{ \ - Val v; \ - tsp_arg_num(args, #NAME, 1); \ - EVAL_CHECK(v, car(args), #NAME, EXPRESSION); \ - if (v->t & DECIMAL) \ - return mk_dec(NAME(num(v))); \ - return mk_pair(mk_sym(env, #NAME), mk_pair(v, env->nil)); \ +#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, EXPRESSION); \ + if (v->t & DECIMAL) \ + return mk_dec(NAME(num(v))); \ + return mk_pair(mk_sym(st, #NAME), mk_pair(v, st->nil)); \ } PRIM_TRIG(sin) @@ -253,7 +254,7 @@ PRIM_TRIG(exp) PRIM_TRIG(log) void -tib_env_math(Env env) +tib_env_math(Tsp st) { tsp_env_fn(numerator); tsp_env_fn(denominator); diff --git a/tibs/string.c b/tibs/string.c @@ -24,31 +24,32 @@ #include "../tisp.h" -typedef Val (*MkFn)(Env, char*); +typedef Val (*MkFn)(Tsp, char*); /* TODO string tib: strlen lower upper strpos strsub */ +/* TODO return string val in val_string to be concated */ static Val -val_string(Env env, Val v, MkFn mk_fn) +val_string(Tsp st, Val v, MkFn mk_fn) { char s[43]; switch (v->t) { case NONE: - return mk_fn(env, "void"); + return mk_fn(st, "void"); case NIL: - return mk_fn(env, "nil"); + return mk_fn(st, "nil"); case INTEGER: snprintf(s, 21, "%d", (int)v->v.n.num); - return mk_fn(env, s); + return mk_fn(st, s); case DECIMAL: snprintf(s, 17, "%.15g", v->v.n.num); - return mk_fn(env, s); + return mk_fn(st, s); case RATIO: snprintf(s, 43, "%d/%d", (int)v->v.n.num, (int)v->v.n.den); - return mk_fn(env, s); + return mk_fn(st, s); case STRING: case SYMBOL: - return mk_fn(env, v->v.s); + return mk_fn(st, v->v.s); case PAIR: default: tsp_warnf("could not convert type %s into string", type_str(v->t)); @@ -57,27 +58,27 @@ val_string(Env env, Val v, MkFn mk_fn) /* TODO string and symbol: multi arguments to concat */ static Val -prim_string(Env env, Val args) +prim_string(Tsp st, Hash env, Val args) { Val v; tsp_arg_num(args, "string", 1); - if (!(v = tisp_eval(env, car(args)))) + if (!(v = tisp_eval(st, env, car(args)))) return NULL; - return val_string(env, v, mk_str); + return val_string(st, v, mk_str); } static Val -prim_symbol(Env env, Val args) +prim_symbol(Tsp st, Hash env, Val args) { Val v; tsp_arg_num(args, "symbol", 1); - if (!(v = tisp_eval(env, car(args)))) + if (!(v = tisp_eval(st, env, car(args)))) return NULL; - return val_string(env, v, mk_sym); + return val_string(st, v, mk_sym); } void -tib_env_string(Env env) +tib_env_string(Tsp st) { tsp_env_fn(symbol); tsp_env_fn(string); diff --git a/tibs/time.c b/tibs/time.c @@ -26,7 +26,7 @@ /* return number of seconds since 1970 (unix time stamp) */ static Val -prim_time(Env env, Val args) +prim_time(Tsp st, Hash env, Val args) { tsp_arg_num(args, "time", 0); return mk_int(time(NULL)); @@ -34,20 +34,20 @@ prim_time(Env env, Val args) /* return time taken to run command given */ static Val -prim_timeit(Env env, Val args) +prim_timeit(Tsp st, Hash env, Val args) { Val v; clock_t t; tsp_arg_num(args, "timeit", 1); t = clock(); - if (!(v = tisp_eval(env, car(args)))) + if (!(v = tisp_eval(st, env, car(args)))) return NULL; t = clock() - t; return mk_dec(((double)t)/CLOCKS_PER_SEC); } void -tib_env_time(Env env) +tib_env_time(Tsp st) { tsp_env_fn(time); tsp_env_fn(timeit); diff --git a/tisp.c b/tisp.c @@ -130,13 +130,13 @@ isdelim(int c) /* skip over comments and white space */ static void -skip_ws(Env env, int skipnl) +skip_ws(Tsp st, int skipnl) { const char *s = skipnl ? " \t\n" : " \t"; - while (tsp_fget(env) && (strchr(s, tsp_fget(env)) || tsp_fget(env) == ';')) { - env->filec += strspn(env->file+env->filec, s); /* skip white space */ - for (; tsp_fget(env) == ';'; tsp_finc(env)) /* skip comments until newline */ - env->filec += strcspn(env->file+env->filec, "\n") - !skipnl; + while (tsp_fget(st) && (strchr(s, tsp_fget(st)) || tsp_fget(st) == ';')) { + st->filec += strspn(st->file+st->filec, s); /* skip white space */ + for (; tsp_fget(st) == ';'; tsp_finc(st)) /* skip comments until newline */ + st->filec += strcspn(st->file+st->filec, "\n") - !skipnl; } } @@ -312,19 +312,6 @@ hash_extend(Hash ht, Val args, Val vals) return ht; } -/* clean up hash table */ -static void -hash_free(Hash ht) -{ - for (Hash h = ht; h; h = h->next) { - for (int i = 0; i < h->cap; i++) - if (h->items[i].key) - free(h->items[i].val); - free(h->items); - } - free(ht); -} - /* make types */ Val @@ -366,30 +353,30 @@ mk_rat(int num, int den) } Val -mk_str(Env env, char *s) +mk_str(Tsp st, char *s) { Val ret; - if ((ret = hash_get(env->strs, s))) + if ((ret = hash_get(st->strs, s))) return ret; ret = emalloc(sizeof(struct Val)); ret->t = STRING; ret->v.s = emalloc((strlen(s)+1) * sizeof(char)); strcpy(ret->v.s, s); - hash_add(env->strs, s, ret); + hash_add(st->strs, s, ret); return ret; } Val -mk_sym(Env env, char *s) +mk_sym(Tsp st, char *s) { Val ret; - if ((ret = hash_get(env->syms, s))) + if ((ret = hash_get(st->syms, s))) return ret; ret = emalloc(sizeof(struct Val)); ret->t = SYMBOL; ret->v.s = emalloc((strlen(s)+1) * sizeof(char)); strcpy(ret->v.s, s); - hash_add(env->syms, s, ret); + hash_add(st->syms, s, ret); return ret; } @@ -403,7 +390,7 @@ mk_prim(Prim pr) } Val -mk_func(Type t, Val args, Val body, Env env) +mk_func(Type t, Val args, Val body, Hash env) { Val ret = emalloc(sizeof(struct Val)); ret->t = t; @@ -424,10 +411,10 @@ mk_pair(Val a, Val b) } Val -mk_list(Env env, int n, Val *a) +mk_list(Tsp st, int n, Val *a) { int i; - Val b = env->nil; + Val b = st->nil; for (i = n-1; i >= 0; i--) b = mk_pair(a[i], b); return b; @@ -437,35 +424,35 @@ mk_list(Env env, int n, Val *a) /* read first character of number to determine sign */ static int -read_sign(Env env) +read_sign(Tsp st) { - switch (tsp_fget(env)) { - case '-': tsp_finc(env); return -1; - case '+': tsp_finc(env); return 1; + switch (tsp_fget(st)) { + case '-': tsp_finc(st); return -1; + case '+': tsp_finc(st); return 1; default: return 1; } } /* return read integer */ static int -read_int(Env env) +read_int(Tsp st) { int ret = 0; - for (; tsp_fget(env) && isdigit(tsp_fget(env)); tsp_finc(env)) - ret = ret * 10 + tsp_fget(env) - '0'; + for (; tsp_fget(st) && isdigit(tsp_fget(st)); tsp_finc(st)) + ret = ret * 10 + tsp_fget(st) - '0'; return ret; } /* return read scientific notation */ static Val -read_sci(Env env, double val, int isint) +read_sci(Tsp st, double val, int isint) { - if (tolower(tsp_fget(env)) != 'e') + if (tolower(tsp_fget(st)) != 'e') goto finish; - tsp_finc(env); - double sign = read_sign(env) == 1 ? 10.0 : 0.1; - for (int expo = read_int(env); expo--; val *= sign) ; + tsp_finc(st); + double sign = read_sign(st) == 1 ? 10.0 : 0.1; + for (int expo = read_int(st); expo--; val *= sign) ; finish: if (isint) @@ -475,26 +462,26 @@ finish: /* return read number */ static Val -read_num(Env env) +read_num(Tsp st) { - int sign = read_sign(env); - int num = read_int(env); + int sign = read_sign(st); + int num = read_int(st); size_t oldc; - switch (tsp_fget(env)) { + switch (tsp_fget(st)) { case '/': - if (!isnum(env->file + ++env->filec)) + if (!isnum(st->file + ++st->filec)) tsp_warn("incorrect ratio format, no denominator found"); - return mk_rat(sign * num, read_sign(env) * read_int(env)); + return mk_rat(sign * num, read_sign(st) * read_int(st)); case '.': - tsp_finc(env); - oldc = env->filec; - double d = (double) read_int(env); - int size = env->filec - oldc; + tsp_finc(st); + oldc = st->filec; + double d = (double) read_int(st); + int size = st->filec - oldc; while (size--) d /= 10.0; - return read_sci(env, sign * (num+d), 0); + return read_sci(st, sign * (num+d), 0); default: - return read_sci(env, sign * num, 1); + return read_sci(st, sign * num, 1); } } @@ -528,63 +515,63 @@ esc_str(char *s) /* return read string */ static Val -read_str(Env env) +read_str(Tsp st) { int len = 0; - char *s = env->file + ++env->filec; /* skip starting open quote */ - for (; tsp_fget(env) != '"'; tsp_finc(env), len++) - if (!tsp_fget(env)) + char *s = st->file + ++st->filec; /* skip starting open quote */ + for (; tsp_fget(st) != '"'; tsp_finc(st), len++) + if (!tsp_fget(st)) tsp_warn("reached end before closing double quote"); - else if (tsp_fget(env) == '\\' && tsp_fgetat(env, 1) == '"') - tsp_finc(env), len++; - tsp_finc(env); /* skip last closing quote */ + else if (tsp_fget(st) == '\\' && tsp_fgetat(st, 1) == '"') + tsp_finc(st), len++; + tsp_finc(st); /* skip last closing quote */ s[len] = '\0'; /* TODO remember string length */ - return mk_str(env, esc_str(s)); + return mk_str(st, esc_str(s)); } /* return read symbol */ static Val -read_sym(Env env) +read_sym(Tsp st) { int n = 1, i = 0; char *sym = emalloc(n); - for (; tsp_fget(env) && issym(tsp_fget(env)); tsp_finc(env)) { - sym[i++] = tsp_fget(env); + for (; tsp_fget(st) && issym(tsp_fget(st)); tsp_finc(st)) { + sym[i++] = tsp_fget(st); if (i == n) { n *= 2; sym = erealloc(sym, n); } } sym[i] = '\0'; - return mk_sym(env, sym); + return mk_sym(st, sym); } /* return read string containing a list */ static Val -read_pair(Env env) +read_pair(Tsp st) { Val a, b; - skip_ws(env, 1); - if (tsp_fget(env) == ')') { - tsp_finc(env); - skip_ws(env, 1); - return env->nil; + skip_ws(st, 1); + if (tsp_fget(st) == ')') { + tsp_finc(st); + skip_ws(st, 1); + return st->nil; } /* TODO simplify read_pair by supporting (. x) => x */ - if (!(a = tisp_read(env))) + if (!(a = tisp_read(st))) return NULL; - skip_ws(env, 1); - if (tsp_fget(env) == '.' && isdelim(tsp_fgetat(env,1))) { - tsp_finc(env); - if (!(b = tisp_read(env))) + skip_ws(st, 1); + if (tsp_fget(st) == '.' && isdelim(tsp_fgetat(st,1))) { + tsp_finc(st); + if (!(b = tisp_read(st))) return NULL; - skip_ws(env, 1); - if (tsp_fget(env) != ')') + skip_ws(st, 1); + if (tsp_fget(st) != ')') tsp_warn("did not find closing ')'"); - tsp_finc(env); - skip_ws(env, 1); + tsp_finc(st); + skip_ws(st, 1); } else { - if (!(b = read_pair(env))) + if (!(b = read_pair(st))) return NULL; } return mk_pair(a, b); @@ -592,37 +579,37 @@ read_pair(Env env) /* reads given string returning its tisp value */ Val -tisp_read(Env env) +tisp_read(Tsp st) { char *shorthands[] = { "'", "quote", "`", "quasiquote", ",", "unquote", }; - skip_ws(env, 1); - if (strlen(env->file+env->filec) == 0) - return env->none; - if (isnum(env->file+env->filec)) - return read_num(env); - if (tsp_fget(env) == '"') - return read_str(env); + skip_ws(st, 1); + if (strlen(st->file+st->filec) == 0) + return st->none; + if (isnum(st->file+st->filec)) + return read_num(st); + if (tsp_fget(st) == '"') + return read_str(st); for (int i = 0; i < LEN(shorthands); i += 2) { - if (tsp_fget(env) == *shorthands[i]) { + if (tsp_fget(st) == *shorthands[i]) { Val v; - tsp_finc(env); - if (!(v = tisp_read(env))) + tsp_finc(st); + if (!(v = tisp_read(st))) return NULL; - return mk_pair(mk_sym(env, shorthands[i+1]), - mk_pair(v, env->nil)); + return mk_pair(mk_sym(st, shorthands[i+1]), + mk_pair(v, st->nil)); } } - if (issym(tsp_fget(env))) - return read_sym(env); - if (tsp_fget(env) == '(') { - tsp_finc(env); - return read_pair(env); + if (issym(tsp_fget(st))) + return read_sym(st); + if (tsp_fget(st) == '(') { + tsp_finc(st); + return read_pair(st); } - tsp_warnf("could not read given input '%s'", env->file+env->filec); + tsp_warnf("could not read given input '%s'", st->file+st->filec); } /* return string containing contents of file name */ @@ -652,19 +639,19 @@ tisp_read_file(char *fname) /* read given file name returning its tisp value */ Val -tisp_parse_file(Env env, char *fname) +tisp_parse_file(Tsp st, char *fname) { - Val ret = mk_pair(NULL, env->nil); + Val ret = mk_pair(NULL, st->nil); Val v, last = ret; - char *file = env->file; - size_t filec = env->filec; - if (!(env->file = tisp_read_file(fname))) + char *file = st->file; + size_t filec = st->filec; + if (!(st->file = tisp_read_file(fname))) return ret; - for (env->filec = 0; tsp_fget(env) && (v = tisp_read(env)); last = cdr(last)) - cdr(last) = mk_pair(v, env->nil); - free(env->file); - env->file = file; - env->filec = filec; + for (st->filec = 0; tsp_fget(st) && (v = tisp_read(st)); last = cdr(last)) + cdr(last) = mk_pair(v, st->nil); + free(st->file); + st->file = file; + st->filec = filec; return cdr(ret); } @@ -672,47 +659,50 @@ tisp_parse_file(Env env, char *fname) /* evaluate each element of list */ Val -tisp_eval_list(Env env, Val v) +tisp_eval_list(Tsp st, Hash env, Val v) { - Val cur = mk_pair(NULL, env->none); + Val cur = mk_pair(NULL, st->none); Val ret = cur, ev; for (; !nilp(v); v = cdr(v), cur = cdr(cur)) { if (v->t != PAIR) { - if (!(ev = tisp_eval(env, v))) + if (!(ev = tisp_eval(st, env, v))) return NULL; cdr(cur) = ev; return cdr(ret); } - if (!(ev = tisp_eval(env, car(v)))) + if (!(ev = tisp_eval(st, env, car(v)))) return NULL; - cdr(cur) = mk_pair(ev, env->none); + cdr(cur) = mk_pair(ev, st->none); } - cdr(cur) = env->nil; + cdr(cur) = st->nil; return cdr(ret); } /* evaluate procedure f of name v with arguments */ static Val -eval_proc(Env env, Val v, Val f, Val args) +eval_proc(Tsp st, Hash env, Val v, Val f, Val args) { Val ret; + Hash e; switch (f->t) { case PRIMITIVE: - return (*f->v.pr)(env, args); + return (*f->v.pr)(st, env, args); case FUNCTION: /* tail call into the function body with the extended env */ - if (!(args = tisp_eval_list(env, args))) + if (!(args = tisp_eval_list(st, env, args))) return NULL; /* FALLTHROUGH */ case MACRO: tsp_arg_num(args, v->t == SYMBOL ? v->v.s : "lambda", list_len(f->v.f.args)); - env->h = hash_new(32, env->h); - if (!(hash_extend(env->h, f->v.f.args, args))) + e = hash_new(8, f->v.f.env); + /* TODO call hash_extend in hash_new to know new hash size */ + if (!(hash_extend(e, f->v.f.args, args))) return NULL; - ret = list_last(tisp_eval_list(env, f->v.f.body)); + if (!(ret = tisp_eval_list(st, e, f->v.f.body))) + return NULL; + ret = list_last(ret); if (f->t == MACRO) - ret = tisp_eval(env, ret); - env->h = env->h->next; + ret = tisp_eval(st, env, ret); return ret; default: tsp_warnf("attempt to evaluate non procedural type %s", type_str(f->t)); @@ -721,12 +711,12 @@ eval_proc(Env env, Val v, Val f, Val args) /* evaluate given value */ Val -tisp_eval(Env env, Val v) +tisp_eval(Tsp st, Hash env, Val v) { Val f; switch (v->t) { case SYMBOL: - if (!(f = hash_get(env->h, v->v.s))) + if (!(f = hash_get(env, v->v.s))) #ifdef TSP_SYM_RETURN return v; #else @@ -734,9 +724,9 @@ tisp_eval(Env env, Val v) #endif return f; case PAIR: - if (!(f = tisp_eval(env, car(v)))) + if (!(f = tisp_eval(st, env, car(v)))) return NULL; - return eval_proc(env, car(v), f, cdr(v)); + return eval_proc(st, env, car(v), f, cdr(v)); default: return v; } @@ -815,11 +805,11 @@ tisp_print(FILE *f, Val v) /* return first element of list */ static Val -prim_car(Env env, Val args) +prim_car(Tsp st, Hash env, Val args) { Val v; tsp_arg_num(args, "car", 1); - if (!(v = tisp_eval_list(env, args))) + if (!(v = tisp_eval_list(st, env, args))) return NULL; tsp_arg_type(car(v), "car", PAIR); return caar(v); @@ -827,11 +817,11 @@ prim_car(Env env, Val args) /* return elements of a list after the first */ static Val -prim_cdr(Env env, Val args) +prim_cdr(Tsp st, Hash env, Val args) { Val v; tsp_arg_num(args, "cdr", 1); - if (!(v = tisp_eval_list(env, args))) + if (!(v = tisp_eval_list(st, env, args))) return NULL; tsp_arg_type(car(v), "cdr", PAIR); return cdar(v); @@ -839,18 +829,18 @@ prim_cdr(Env env, Val args) /* return new pair */ static Val -prim_cons(Env env, Val args) +prim_cons(Tsp st, Hash env, Val args) { Val v; tsp_arg_num(args, "cons", 2); - if (!(v = tisp_eval_list(env, args))) + if (!(v = tisp_eval_list(st, env, args))) return NULL; return mk_pair(car(v), cadr(v)); } /* do not evaluate argument */ static Val -prim_quote(Env env, Val args) +prim_quote(Tsp st, Hash env, Val args) { tsp_arg_num(args, "quote", 1); return car(args); @@ -858,64 +848,64 @@ prim_quote(Env env, Val args) /* returns nothing */ static Val -prim_void(Env env, Val args) +prim_void(Tsp st, Hash env, Val args) { - return env->none; + return st->none; } /* evaluate argument given */ static Val -prim_eval(Env env, Val args) +prim_eval(Tsp st, Hash env, Val args) { Val v; tsp_arg_num(args, "eval", 1); - if (!(v = tisp_eval(env, car(args)))) + if (!(v = tisp_eval(st, env, car(args)))) return NULL; - return (v = tisp_eval(env, v)) ? v : env->none; + return (v = tisp_eval(st, env, v)) ? v : st->none; } /* test equality of all values given */ static Val -prim_eq(Env env, Val args) +prim_eq(Tsp st, Hash env, Val args) { Val v; - if (!(v = tisp_eval_list(env, args))) + if (!(v = tisp_eval_list(st, env, args))) return NULL; if (nilp(v)) - return env->t; + return st->t; for (; !nilp(cdr(v)); v = cdr(v)) if (!vals_eq(car(v), cadr(v))) - return env->nil; - return env->t; + return st->nil; + return st->t; } /* evaluates all expressions if their conditions are met */ static Val -prim_cond(Env env, Val args) +prim_cond(Tsp st, Hash env, Val args) { Val v, cond; for (v = args; !nilp(v); v = cdr(v)) - if (!(cond = tisp_eval(env, caar(v)))) + if (!(cond = tisp_eval(st, env, caar(v)))) return NULL; else if (!nilp(cond)) /* TODO incorporate else directly into cond */ - return tisp_eval(env, car(cdar(v))); - return env->none; + return tisp_eval(st, env, car(cdar(v))); + return st->none; } /* return type of tisp value */ static Val -prim_type(Env env, Val args) +prim_type(Tsp st, Hash env, Val args) { Val v; tsp_arg_num(args, "type", 1); - if (!(v = tisp_eval(env, car(args)))) + if (!(v = tisp_eval(st, env, car(args)))) return NULL; - return mk_str(env, type_str(v->t)); + return mk_str(st, type_str(v->t)); } /* creates new tisp lambda function */ static Val -prim_lambda(Env env, Val args) +prim_lambda(Tsp st, Hash env, Val args) { tsp_arg_min(args, "lambda", 2); return mk_func(FUNCTION, car(args), cdr(args), env); @@ -923,7 +913,7 @@ prim_lambda(Env env, Val args) /* creates new tisp defined macro */ static Val -prim_macro(Env env, Val args) +prim_macro(Tsp st, Hash env, Val args) { tsp_arg_min(args, "macro", 2); return mk_func(MACRO, car(args), cdr(args), env); @@ -933,7 +923,7 @@ prim_macro(Env env, Val args) * if pair is given as name of variable, creates function with the car as the * function name and the cdr the function arguments */ static Val -prim_define(Env env, Val args) +prim_define(Tsp st, Hash env, Val args) { Val sym, val; Hash h; @@ -947,30 +937,30 @@ prim_define(Env env, Val args) val = mk_func(FUNCTION, cdar(args), cdr(args), env); } else if (car(args)->t == SYMBOL) { sym = car(args); - val = tisp_eval(env, cadr(args)); + val = tisp_eval(st, env, cadr(args)); } else tsp_warn("define: incorrect format, no variable name found"); if (!val) return NULL; /* last linked hash is global namespace */ - for (h = env->h; h->next; h = h->next) ; + for (h = env; h->next; h = h->next) ; hash_add(h, sym->v.s, val); - return env->none; + return st->none; } /* set symbol to new value */ static Val -prim_set(Env env, Val args) +prim_set(Tsp st, Hash env, Val args) { Val val; Hash h; Entry e = NULL; tsp_arg_num(args, "set!", 2); tsp_arg_type(car(args), "set!", SYMBOL); - if (!(val = tisp_eval(env, cadr(args)))) + if (!(val = tisp_eval(st, env, cadr(args)))) return NULL; /* find first occurrence of symbol */ - for (h = env->h; h; h = h->next) { + for (h = env; h; h = h->next) { e = entry_get(h, car(args)->v.s); if (e->key) break; @@ -978,7 +968,7 @@ prim_set(Env env, Val args) if (!e || !e->key) tsp_warnf("set!: variable %s is not defined", car(args)->v.s); e->val = val; - return env->none; + return st->none; } /* loads tisp file or C dynamic library */ @@ -986,10 +976,10 @@ prim_set(Env env, Val args) /* TODO only use dlopen if -ldl is given with TIB_DYNAMIC */ /* TODO define load in lisp which calls load-dl */ static Val -prim_load(Env env, Val args) +prim_load(Tsp st, Hash env, Val args) { Val v; - void (*tibenv)(Env); + void (*tibenv)(Tsp); char *name; const char *paths[] = { #ifdef DEBUG @@ -999,7 +989,7 @@ prim_load(Env env, Val args) }; tsp_arg_num(args, "load", 1); - if (!(v = tisp_eval(env, car(args)))) + if (!(v = tisp_eval(st, env, car(args)))) return NULL; tsp_arg_type(v, "load", STRING); @@ -1009,20 +999,20 @@ prim_load(Env env, Val args) strcat(name, v->v.s); strcat(name, ".tsp"); if (access(name, R_OK) != -1) { - tisp_eval_list(env, tisp_parse_file(env, name)); + tisp_eval_list(st, env, tisp_parse_file(st, name)); free(name); - return env->none; + return st->none; } } /* If not tisp file, try loading shared object library */ - env->libh = erealloc(env->libh, (env->libhc+1)*sizeof(void*)); + st->libh = erealloc(st->libh, (st->libhc+1)*sizeof(void*)); name = erealloc(name, (strlen(v->v.s)+10) * sizeof(char)); strcpy(name, "libtib"); strcat(name, v->v.s); strcat(name, ".so"); - if (!(env->libh[env->libhc] = dlopen(name, RTLD_LAZY))) { + if (!(st->libh[st->libhc] = dlopen(name, RTLD_LAZY))) { free(name); tsp_warnf("load: could not load '%s':\n%s", v->v.s, dlerror()); } @@ -1031,24 +1021,24 @@ prim_load(Env env, Val args) name = erealloc(name, (strlen(v->v.s)+9) * sizeof(char)); strcpy(name, "tib_env_"); strcat(name, v->v.s); - tibenv = dlsym(env->libh[env->libhc], name); + tibenv = dlsym(st->libh[st->libhc], name); if (dlerror()) { free(name); tsp_warnf("load: could not run '%s':\n%s", v->v.s, dlerror()); } - (*tibenv)(env); + (*tibenv)(st); free(name); - env->libhc++; - return env->none; + st->libhc++; + return st->none; } /* display message and return error */ static Val -prim_error(Env env, Val args) +prim_error(Tsp st, Hash env, Val args) { Val v; - if (!(v = tisp_eval_list(env, args))) + 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); @@ -1065,39 +1055,39 @@ prim_error(Env env, Val args) /* list tisp version */ static Val -prim_version(Env env, Val args) +prim_version(Tsp st, Hash env, Val args) { - return mk_str(env, "0.0"); + return mk_str(st, "0.0"); } /* environment */ /* add new variable of name key and value v to the given environment */ void -tisp_env_add(Env e, char *key, Val v) +tisp_env_add(Tsp st, char *key, Val v) { - hash_add(e->h, key, v); + hash_add(st->global, key, v); } -/* initialise tisp's environment */ -Env +/* initialise tisp's state and global environment */ +Tsp tisp_env_init(size_t cap) { - Env env = emalloc(sizeof(struct Env)); + Tsp st = emalloc(sizeof(struct Tsp)); - env->file = NULL; - env->filec = 0; + st->file = NULL; + st->filec = 0; - env->nil = emalloc(sizeof(struct Val)); - env->nil->t = NIL; - env->none = emalloc(sizeof(struct Val)); - env->none->t = NONE; - env->t = emalloc(sizeof(struct Val)); - env->t->t = SYMBOL; - env->t->v.s = "t"; + st->nil = emalloc(sizeof(struct Val)); + st->nil->t = NIL; + st->none = emalloc(sizeof(struct Val)); + st->none->t = NONE; + st->t = emalloc(sizeof(struct Val)); + st->t->t = SYMBOL; + st->t->v.s = "t"; - env->h = hash_new(cap, NULL); - tisp_env_add(env, "t", env->t); + st->global = hash_new(cap, NULL); + tisp_env_add(st, "t", st->t); tsp_env_fn(car); tsp_env_fn(cdr); tsp_env_fn(cons); @@ -1115,51 +1105,25 @@ tisp_env_init(size_t cap) tsp_env_fn(error); tsp_env_fn(version); - env->strs = hash_new(cap, NULL); - env->syms = hash_new(cap, NULL); + st->strs = hash_new(cap, NULL); + st->syms = hash_new(cap, NULL); - env->libh = NULL; - env->libhc = 0; + st->libh = NULL; + st->libhc = 0; - return env; + return st; } void -tisp_env_lib(Env env, char* lib) +tisp_env_lib(Tsp st, char* lib) { Val v; - char *file = env->file; - size_t filec = env->filec; - env->file = lib; - env->filec = 0; - if ((v = tisp_read(env))) - tisp_eval_list(env, v); - env->file = file; - env->filec = filec; -} - -void -tisp_env_free(Env env) -{ - int i; - - hash_free(env->h); - hash_free(env->strs); - hash_free(env->syms); - for (i = 0; i < env->libhc; i++) - dlclose(env->libh[i]); - free(env->nil); - free(env->none); - free(env); -} - -void -val_free(Val v) -{ - if (v->t == PAIR) { - val_free(car(v)); - val_free(cdr(v)); - } - if (v->t != NIL) - free(v); + char *file = st->file; + size_t filec = st->filec; + st->file = lib; + st->filec = 0; + if ((v = tisp_read(st))) + tisp_eval_list(st, st->global, v); + st->file = file; + st->filec = filec; } diff --git a/tisp.h b/tisp.h @@ -56,13 +56,13 @@ type_str(TYPE), type_str(ARG->t)); \ } while(0) -#define tsp_env_name_fn(NAME, FN) tisp_env_add(env, #NAME, mk_prim(prim_##FN)) +#define tsp_env_name_fn(NAME, FN) tisp_env_add(st, #NAME, mk_prim(prim_##FN)) #define tsp_env_fn(NAME) tsp_env_name_fn(NAME, NAME) -#define tsp_include_tib(NAME) void tib_env_##NAME(Env) +#define tsp_include_tib(NAME) void tib_env_##NAME(Tsp) -#define tsp_finc(ENV) ENV->filec++ -#define tsp_fgetat(ENV, O) ENV->file[ENV->filec+O] -#define tsp_fget(ENV) tsp_fgetat(ENV,0) +#define tsp_finc(ST) ST->filec++ +#define tsp_fgetat(ST, O) ST->file[ST->filec+O] +#define tsp_fget(ST) tsp_fgetat(ST,0) #define car(P) ((P)->v.p.car) #define cdr(P) ((P)->v.p.cdr) @@ -76,7 +76,7 @@ struct Val; typedef struct Val *Val; -typedef struct Env *Env; +typedef struct Tsp *Tsp; /* fraction */ typedef struct { @@ -95,19 +95,20 @@ typedef struct Hash { } *Hash; /* basic function written in C, not lisp */ -typedef Val (*Prim)(Env, Val); +typedef Val (*Prim)(Tsp, Hash, Val); /* function written directly in lisp instead of C */ typedef struct { Val args; Val body; - Env env; + Hash env; } Func; typedef struct { Val car, cdr; } Pair; +/* possible tisp object types */ typedef enum { NONE = 1 << 0, NIL = 1 << 1, @@ -123,8 +124,10 @@ typedef enum { } Type; #define RATIONAL (INTEGER | RATIO) #define NUMBER (RATIONAL | DECIMAL) +/* TODO rename to math ? */ #define EXPRESSION (NUMBER | SYMBOL | PAIR) +/* tisp object */ struct Val { Type t; /* NONE, NIL */ union { @@ -136,11 +139,12 @@ struct Val { } v; }; -struct Env { +/* tisp state and global environment */ +struct Tsp { char *file; size_t filec; Val none, nil, t; - Hash h, strs, syms; + Hash global, strs, syms; void **libh; size_t libhc; }; @@ -149,25 +153,24 @@ char *type_str(Type t); int list_len(Val v); Val mk_int(int i); -Val mk_str(Env env, char *s); -Val mk_prim(Prim prim); Val mk_dec(double d); Val mk_rat(int num, int den); -Val mk_sym(Env env, char *s); -Val mk_func(Type t, Val args, Val body, Env env); +Val mk_str(Tsp st, char *s); +Val mk_sym(Tsp st, char *s); +Val mk_prim(Prim prim); +Val mk_func(Type t, Val args, Val body, Hash env); Val mk_pair(Val a, Val b); -Val mk_list(Env env, int n, Val *a); +Val mk_list(Tsp st, int n, Val *a); -Val tisp_read(Env env); -Val tisp_read_line(Env env); -Val tisp_eval_list(Env env, Val v); -Val tisp_eval(Env env, Val v); +Val tisp_read(Tsp st); +Val tisp_read_line(Tsp st); +Val tisp_eval_list(Tsp st, Hash env, Val v); +Val tisp_eval(Tsp st, Hash env, Val v); void tisp_print(FILE *f, Val v); char *tisp_read_file(char *fname); -Val tisp_parse_file(Env env, char *fname); +Val tisp_parse_file(Tsp st, char *fname); -void tisp_env_add(Env e, char *key, Val v); -Env tisp_env_init(size_t cap); -void tisp_env_lib(Env env, char* lib); -void tisp_env_free(Env env); +void tisp_env_add(Tsp st, char *key, Val v); +Tsp tisp_env_init(size_t cap); +void tisp_env_lib(Tsp st, char* lib);