tisp

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

tisp.c (25774B)


      1 /* zlib License
      2  *
      3  * Copyright (c) 2017-2020 Ed van Bruggen
      4  *
      5  * This software is provided 'as-is', without any express or implied
      6  * warranty.  In no event will the authors be held liable for any damages
      7  * arising from the use of this software.
      8  *
      9  * Permission is granted to anyone to use this software for any purpose,
     10  * including commercial applications, and to alter it and redistribute it
     11  * freely, subject to the following restrictions:
     12  *
     13  * 1. The origin of this software must not be misrepresented; you must not
     14  *    claim that you wrote the original software. If you use this software
     15  *    in a product, an acknowledgment in the product documentation would be
     16  *    appreciated but is not required.
     17  * 2. Altered source versions must be plainly marked as such, and must not be
     18  *    misrepresented as being the original software.
     19  * 3. This notice may not be removed or altered from any source distribution.
     20  */
     21 #include <ctype.h>
     22 #include <dlfcn.h>
     23 #include <fcntl.h>
     24 #include <limits.h>
     25 #include <stdarg.h>
     26 #include <stdint.h>
     27 #include <stdio.h>
     28 #include <stdlib.h>
     29 #include <string.h>
     30 #include <unistd.h>
     31 
     32 #include "tisp.h"
     33 
     34 #define BETWEEN(X, A, B)  ((A) <= (X) && (X) <= (B))
     35 #define LEN(X)            (sizeof(X) / sizeof((X)[0]))
     36 
     37 /* functions */
     38 static void hash_add(Hash ht, char *key, Val val);
     39 
     40 /* utility functions */
     41 
     42 /* return named string for each type */
     43 /* TODO loop through each type bit to print */
     44 char *
     45 type_str(TspType t)
     46 {
     47 	switch (t) {
     48 	case TSP_NONE:  return "Void";
     49 	case TSP_NIL:   return "Nil";
     50 	case TSP_INT:   return "Int";
     51 	case TSP_DEC:   return "Dec";
     52 	case TSP_RATIO: return "Ratio";
     53 	case TSP_STR:   return "Str";
     54 	case TSP_SYM:   return "Sym";
     55 	case TSP_PRIM:  return "Prim";
     56 	case TSP_FUNC:  return "Func";
     57 	case TSP_MACRO: return "Macro";
     58 	case TSP_PAIR:  return "Pair";
     59 	default:
     60 		if (t == TSP_EXPR)
     61 			return "Expr";
     62 		if (t == TSP_RATIONAL)
     63 			return "Rational";
     64 		if (t & TSP_NUM)
     65 			return "Num";
     66 		return "Invalid";
     67 	}
     68 }
     69 
     70 /* check if character can be a part of a symbol */
     71 static int
     72 issym(char c)
     73 {
     74 	return BETWEEN(c, 'a', 'z') || BETWEEN(c, 'A', 'Z') ||
     75 	       BETWEEN(c, '0', '9') || strchr("_+-*/=<>!?$&^#@:~", c);
     76 }
     77 
     78 /* check if character is start of a number */
     79 /* TODO only if -/+ is not followed by a delim */
     80 static int
     81 isnum(char *str)
     82 {
     83 	return isdigit(*str) || (*str == '.' && isdigit(str[1])) ||
     84 	       ((*str == '-' || *str == '+') && (isdigit(str[1]) || str[1] == '.'));
     85 }
     86 
     87 /* check if character is a symbol delimiter */
     88 static char
     89 isdelim(int c)
     90 {
     91 	/* add .{}[]`', */
     92 	return isspace(c) || c == '(' || c == ')' || c == '"' || c == ';';
     93 }
     94 
     95 /* skip over comments and white space */
     96 /* TODO support mac/windows line endings */
     97 static void
     98 skip_ws(Tsp st, int skipnl)
     99 {
    100 	const char *s = skipnl ? " \t\n" : " \t";
    101 	while (tsp_fget(st) && (strchr(s, tsp_fget(st)) || tsp_fget(st) == ';')) {
    102 		st->filec += strspn(st->file+st->filec, s); /* skip white space */
    103 		for (; tsp_fget(st) == ';'; tsp_finc(st)) /* skip comments until newline */
    104 			st->filec += strcspn(st->file+st->filec, "\n") - !skipnl;
    105 	}
    106 }
    107 
    108 /* count number of parenthesis */
    109 static int
    110 count_parens(char *s, int len)
    111 {
    112 	int count = 0;
    113 	for (int i = 0; i < len && s[i]; i++)
    114 		if (s[i] == '(')
    115 			count++;
    116 		else if (s[i] == ')')
    117 			count--;
    118 	return count;
    119 }
    120 
    121 /* get length of list, if improper list return -1 */
    122 int
    123 list_len(Val v)
    124 {
    125 	int len = 0;
    126 	for (; v->t == TSP_PAIR; v = cdr(v))
    127 		len++;
    128 	return nilp(v) ? len : -1;
    129 }
    130 
    131 /* check if two values are equal */
    132 static int
    133 vals_eq(Val a, Val b)
    134 {
    135 	if (a->t & TSP_NUM && b->t & TSP_NUM) { /* NUMBERs */
    136 		if (num(a) != num(b) || den(a) != den(b))
    137 			return 0;
    138 		return 1;
    139 	}
    140 	if (a->t != b->t)
    141 		return 0;
    142 	if (a->t == TSP_PAIR) /* PAIR */
    143 		return vals_eq(car(a), car(b)) && vals_eq(cdr(a), cdr(b));
    144 	/* TODO function var names should not matter in comparison */
    145 	if (a->t & (TSP_FUNC | TSP_MACRO)) /* FUNCTION, MACRO */
    146 		return vals_eq(a->v.f.args, b->v.f.args) &&
    147 		       vals_eq(a->v.f.body, b->v.f.body);
    148 	if (a != b) /* PRIMITIVE, STRING, SYMBOL, NIL, VOID */
    149 		return 0;
    150 	return 1;
    151 }
    152 
    153 /* reduce fraction by modifying supplied numerator and denominator */
    154 static void
    155 frac_reduce(int *num, int *den)
    156 {
    157 	int a = abs(*num), b = abs(*den), c = a % b;
    158 	while (c > 0) {
    159 		a = b;
    160 		b = c;
    161 		c = a % b;
    162 	}
    163 	*num = *num / b;
    164 	*den = *den / b;
    165 }
    166 
    167 /* hash map */
    168 
    169 /* return hashed number based on key */
    170 static uint32_t
    171 hash(char *key)
    172 {
    173 	uint32_t h = 0;
    174 	char c;
    175 	while (h < UINT32_MAX && (c = *key++))
    176 		h = h * 33 + c;
    177 	return h;
    178 }
    179 
    180 /* create new empty hash table with given capacity */
    181 static Hash
    182 hash_new(size_t cap, Hash next)
    183 {
    184 	if (cap < 1) return NULL;
    185 	Hash ht = malloc(sizeof(struct Hash));
    186 	if (!ht) perror("; malloc"), exit(1);
    187 	ht->size = 0;
    188 	ht->cap = cap;
    189 	ht->items = calloc(cap, sizeof(struct Entry));
    190 	if (!ht->items) perror("; calloc"), exit(1);
    191 	ht->next = next;
    192 	return ht;
    193 }
    194 
    195 /* get entry in one hash table for the key */
    196 static Entry
    197 entry_get(Hash ht, char *key)
    198 {
    199 	int i = hash(key) % ht->cap;
    200 	char *s;
    201 	while ((s = ht->items[i].key)) {
    202 		if (!strcmp(s, key))
    203 			break;
    204 		if (++i == ht->cap)
    205 			i = 0;
    206 	}
    207 	return &ht->items[i]; /* returns entry if found or empty one to be filled */
    208 }
    209 
    210 /* get value of given key in each hash table */
    211 static Val
    212 hash_get(Hash ht, char *key)
    213 {
    214 	Entry e;
    215 	for (; ht; ht = ht->next) {
    216 		e = entry_get(ht, key);
    217 		if (e->key)
    218 			return e->val;
    219 	}
    220 	return NULL;
    221 }
    222 
    223 /* enlarge the hash table to ensure algorithm's efficiency */
    224 static void
    225 hash_grow(Hash ht)
    226 {
    227 	int i, ocap = ht->cap;
    228 	Entry oitems = ht->items;
    229 	ht->cap *= 2;
    230 	ht->items = calloc(ht->cap, sizeof(struct Entry));
    231 	if (!ht->items) perror("; calloc"), exit(1);
    232 	for (i = 0; i < ocap; i++) /* repopulate new hash table with old values */
    233 		if (oitems[i].key)
    234 			hash_add(ht, oitems[i].key, oitems[i].val);
    235 	free(oitems);
    236 }
    237 
    238 /* create new key and value pair to the hash table */
    239 static void
    240 hash_add(Hash ht, char *key, Val val)
    241 {
    242 	Entry e = entry_get(ht, key);
    243 	e->val = val;
    244 	if (!e->key) {
    245 		e->key = key;
    246 		ht->size++;
    247 		if (ht->size > ht->cap / 2) /* grow table if it is more than half full */
    248 			hash_grow(ht);
    249 	}
    250 }
    251 
    252 /* add each binding args[i] -> vals[i] */
    253 /* args and vals are both lists */
    254 /* TODO don't return anything in hash_extend since it's modifying ht */
    255 static Hash
    256 hash_extend(Hash ht, Val args, Val vals)
    257 {
    258 	Val arg, val;
    259 	for (; !nilp(args); args = cdr(args), vals = cdr(vals)) {
    260 		if (args->t == TSP_PAIR) {
    261 			arg = car(args);
    262 			val = car(vals);
    263 		} else {
    264 			arg = args;
    265 			val = vals;
    266 		}
    267 		if (arg->t != TSP_SYM)
    268 			tsp_warnf("expected symbol for argument of function"
    269 				  " definition, recieved %s", type_str(arg->t));
    270 		hash_add(ht, arg->v.s, val);
    271 		if (args->t != TSP_PAIR)
    272 			break;
    273 	}
    274 	return ht;
    275 }
    276 
    277 /* make types */
    278 
    279 Val
    280 mk_val(TspType t)
    281 {
    282 	Val ret = malloc(sizeof(struct Val));
    283 	if (!ret) perror("; malloc"), exit(1);
    284 	ret->t = t;
    285 	return ret;
    286 }
    287 
    288 Val
    289 mk_int(int i)
    290 {
    291 	Val ret = mk_val(TSP_INT);
    292 	num(ret) = i;
    293 	den(ret) = 1;
    294 	return ret;
    295 }
    296 
    297 Val
    298 mk_dec(double d)
    299 {
    300 	Val ret = mk_val(TSP_DEC);
    301 	num(ret) = d;
    302 	den(ret) = 1;
    303 	return ret;
    304 }
    305 
    306 Val
    307 mk_rat(int num, int den)
    308 {
    309 	Val ret;
    310 	if (den == 0)
    311 		tsp_warn("division by zero");
    312 	frac_reduce(&num, &den);
    313 	if (den < 0) { /* simplify so only numerator is negative */
    314 		den = abs(den);
    315 		num = -num;
    316 	}
    317 	if (den == 1) /* simplify into integer if denominator is 1 */
    318 		return mk_int(num);
    319 	ret = mk_val(TSP_RATIO);
    320 	ret->v.n.num = num;
    321 	ret->v.n.den = den;
    322 	return ret;
    323 }
    324 
    325 /* TODO combine mk_str and mk_sym */
    326 Val
    327 mk_str(Tsp st, char *s)
    328 {
    329 	Val ret;
    330 	if ((ret = hash_get(st->strs, s)))
    331 		return ret;
    332 	ret = mk_val(TSP_STR);
    333 	ret->v.s = strndup(s, strlen(s));
    334 	if (!ret->v.s) perror("; strndup"), exit(1);
    335 	hash_add(st->strs, s, ret);
    336 	return ret;
    337 }
    338 
    339 Val
    340 mk_sym(Tsp st, char *s)
    341 {
    342 	Val ret;
    343 	if ((ret = hash_get(st->syms, s)))
    344 		return ret;
    345 	ret = mk_val(TSP_SYM);
    346 	ret->v.s = strndup(s, strlen(s));
    347 	if (!ret->v.s) perror("; strndup"), exit(1);
    348 	hash_add(st->syms, s, ret);
    349 	return ret;
    350 }
    351 
    352 Val
    353 mk_prim(TspType t, Prim pr, char *name)
    354 {
    355 	Val ret = mk_val(t);
    356 	ret->v.pr.name = name;
    357 	ret->v.pr.pr = pr;
    358 	return ret;
    359 }
    360 
    361 Val
    362 mk_func(TspType t, char *name, Val args, Val body, Hash env)
    363 {
    364 	Val ret = mk_val(t);
    365 	ret->v.f.name = name;
    366 	ret->v.f.args = args;
    367 	ret->v.f.body = body;
    368 	ret->v.f.env  = env;
    369 	return ret;
    370 }
    371 
    372 Val
    373 mk_pair(Val a, Val b)
    374 {
    375 	Val ret = mk_val(TSP_PAIR);
    376 	car(ret) = a;
    377 	cdr(ret) = b;
    378 	return ret;
    379 }
    380 
    381 Val
    382 mk_list(Tsp st, int n, Val *a)
    383 {
    384 	int i;
    385 	Val b = st->nil;
    386 	for (i = n-1; i >= 0; i--)
    387 		b = mk_pair(a[i], b);
    388 	return b;
    389 }
    390 
    391 /* read */
    392 
    393 /* read first character of number to determine sign */
    394 static int
    395 read_sign(Tsp st)
    396 {
    397 	switch (tsp_fget(st)) {
    398 	case '-': tsp_finc(st); return -1;
    399 	case '+': tsp_finc(st); return 1;
    400 	default: return 1;
    401 	}
    402 }
    403 
    404 /* return read integer */
    405 static int
    406 read_int(Tsp st)
    407 {
    408 	int ret = 0;
    409 	for (; tsp_fget(st) && isdigit(tsp_fget(st)); tsp_finc(st))
    410 		ret = ret * 10 + tsp_fget(st) - '0';
    411 	return ret;
    412 }
    413 
    414 /* return read scientific notation */
    415 static Val
    416 read_sci(Tsp st, double val, int isint)
    417 {
    418 	if (tolower(tsp_fget(st)) != 'e')
    419 		goto finish;
    420 
    421 	tsp_finc(st);
    422 	double sign = read_sign(st) == 1 ? 10.0 : 0.1;
    423 	for (int expo = read_int(st); expo--; val *= sign) ;
    424 
    425 finish:
    426 	if (isint)
    427 		return mk_int(val);
    428 	return mk_dec(val);
    429 }
    430 
    431 /* return read number */
    432 static Val
    433 read_num(Tsp st)
    434 {
    435 	int sign = read_sign(st);
    436 	int num = read_int(st);
    437 	size_t oldc;
    438 	switch (tsp_fget(st)) {
    439 	case '/':
    440 		if (!isnum(st->file + ++st->filec))
    441 			tsp_warn("incorrect ratio format, no denominator found");
    442 		return mk_rat(sign * num, read_sign(st) * read_int(st));
    443 	case '.':
    444 		tsp_finc(st);
    445 		oldc = st->filec;
    446 		double d = (double) read_int(st);
    447 		int size = st->filec - oldc;
    448 		while (size--)
    449 			d /= 10.0;
    450 		return read_sci(st, sign * (num+d), 0);
    451 	default:
    452 		return read_sci(st, sign * num, 1);
    453 	}
    454 }
    455 
    456 /* return character for escape */
    457 static char
    458 esc_char(char c)
    459 {
    460 	switch (c) {
    461 	case 'n': return '\n';
    462 	case 't': return '\t';
    463 	case '\\':
    464 	case '"':
    465 	default:
    466 		return c;
    467 	}
    468 }
    469 
    470 /* replace all encoded escape characters in string with their actual character */
    471 static char *
    472 esc_str(char *s)
    473 {
    474 	char *c, *ret = malloc((strlen(s)+1) * sizeof(char));
    475 	if (!ret) perror("; malloc"), exit(1);
    476 	for (c = ret; *s != '\0'; c++, s++)
    477 		if (*s == '\\')
    478 			*c = esc_char(*(++s));
    479 		else
    480 			*c = *s;
    481 	*c = '\0';
    482 	return ret;
    483 }
    484 
    485 /* return read string */
    486 static Val
    487 read_str(Tsp st)
    488 {
    489 	int len = 0;
    490 	char *s = st->file + ++st->filec; /* skip starting open quote */
    491 	for (; tsp_fget(st) != '"'; tsp_finc(st), len++)
    492 		if (!tsp_fget(st))
    493 			tsp_warn("reached end before closing double quote");
    494 		else if (tsp_fget(st) == '\\' && tsp_fgetat(st, 1) == '"')
    495 			tsp_finc(st), len++;
    496 	tsp_finc(st); /* skip last closing quote */
    497 	s[len] = '\0'; /* TODO remember string length */
    498 	return mk_str(st, esc_str(s));
    499 }
    500 
    501 /* return read symbol */
    502 static Val
    503 read_sym(Tsp st)
    504 {
    505 	int n = 1, i = 0;
    506 	char *sym = malloc(n);
    507 	for (; tsp_fget(st) && issym(tsp_fget(st)); tsp_finc(st)) {
    508 		if (!sym) perror("; alloc"), exit(1);
    509 		sym[i++] = tsp_fget(st);
    510 		if (i == n) {
    511 			n *= 2;
    512 			sym = realloc(sym, n);
    513 		}
    514 	}
    515 	sym[i] = '\0';
    516 	return mk_sym(st, sym);
    517 }
    518 
    519 /* return read string containing a list */
    520 /* TODO read pair after as well, allow lambda((x) (* x 2))(4) */
    521 static Val
    522 read_pair(Tsp st)
    523 {
    524 	Val a, b;
    525 	skip_ws(st, 1);
    526 	if (tsp_fget(st) == ')') {
    527 		tsp_finc(st);
    528 		skip_ws(st, 1);
    529 		return st->nil;
    530 	}
    531 	/* TODO simplify read_pair by supporting (. x) => x */
    532 	if (!(a = tisp_read(st)))
    533 		return NULL;
    534 	skip_ws(st, 1);
    535 	if (!tsp_fget(st))
    536 		tsp_warn("reached end before closing ')'");
    537 	if (tsp_fget(st) == '.' && isdelim(tsp_fgetat(st,1))) {
    538 		tsp_finc(st);
    539 		if (!(b = tisp_read(st)))
    540 			return NULL;
    541 		skip_ws(st, 1);
    542 		if (tsp_fget(st) != ')')
    543 			tsp_warn("did not find closing ')'");
    544 		tsp_finc(st);
    545 		skip_ws(st, 1);
    546 	} else {
    547 		if (!(b = read_pair(st)))
    548 			return NULL;
    549 	}
    550 	return mk_pair(a, b);
    551 }
    552 
    553 /* reads given string returning its tisp value */
    554 Val
    555 tisp_read(Tsp st)
    556 {
    557 	char *shorthands[] = {
    558 		"'", "quote",
    559 		"`", "quasiquote",
    560 		",", "unquote",
    561 	};
    562 	skip_ws(st, 1);
    563 	if (strlen(st->file+st->filec) == 0)
    564 		return st->none;
    565 	if (isnum(st->file+st->filec))
    566 		return read_num(st);
    567 	/* TODO support | for symbols */
    568 	if (tsp_fget(st) == '"')
    569 		return read_str(st);
    570 	for (int i = 0; i < LEN(shorthands); i += 2) {
    571 		if (tsp_fget(st) == *shorthands[i]) {
    572 			Val v;
    573 			tsp_finc(st);
    574 			if (!(v = tisp_read(st)))
    575 				return NULL;
    576 			return mk_pair(mk_sym(st, shorthands[i+1]),
    577 			               mk_pair(v, st->nil));
    578 		}
    579 	}
    580 	if (issym(tsp_fget(st)))
    581 		return read_sym(st);
    582 	if (tsp_fget(st) == '(') {
    583 		tsp_finc(st);
    584 		return read_pair(st);
    585 	}
    586 	tsp_warnf("could not read given input '%s'", st->file+st->filec);
    587 }
    588 
    589 /* return string containing contents of file name */
    590 char *
    591 tisp_read_file(char *fname)
    592 {
    593 	char buf[BUFSIZ], *file = NULL;
    594 	int len = 0, n, fd, parens = 0;
    595 	if (!fname)
    596 		fd = 0;
    597 	else if ((fd = open(fname, O_RDONLY)) < 0)
    598 		tsp_warnf("could not load file '%s'", fname);
    599 	while ((n = read(fd, buf, sizeof(buf))) > 0) {
    600 		file = realloc(file, len + n + 1);
    601 		if (!file) perror("; realloc"), exit(1);
    602 		memcpy(file + len, buf, n);
    603 		len += n;
    604 		file[len] = '\0';
    605 		if (fd == 0 && !(parens += count_parens(buf, n)))
    606 			break;
    607 	}
    608 	if (fd)
    609 		close(fd);
    610 	if (n < 0)
    611 		tsp_warnf("could not read file '%s'", fname);
    612 	return file;
    613 }
    614 
    615 /* read given file name returning its tisp value */
    616 Val
    617 tisp_parse_file(Tsp st, char *fname)
    618 {
    619 	Val ret = mk_pair(st->none, st->nil);
    620 	Val v, last = ret;
    621 	char *file = st->file;
    622 	size_t filec = st->filec;
    623 	if (!(st->file = tisp_read_file(fname)))
    624 		return ret;
    625 	for (st->filec = 0; tsp_fget(st) && (v = tisp_read(st)); last = cdr(last))
    626 		cdr(last) = mk_pair(v, st->nil);
    627 	free(st->file);
    628 	st->file = file;
    629 	st->filec = filec;
    630 	return cdr(ret);
    631 }
    632 
    633 /* eval */
    634 
    635 /* evaluate each element of list */
    636 Val
    637 tisp_eval_list(Tsp st, Hash env, Val v)
    638 {
    639 	Val cur = mk_pair(NULL, st->none);
    640 	Val ret = cur, ev;
    641 	for (; !nilp(v); v = cdr(v), cur = cdr(cur)) {
    642 		if (v->t != TSP_PAIR) {
    643 			if (!(ev = tisp_eval(st, env, v)))
    644 				return NULL;
    645 			cdr(cur) = ev;
    646 			return cdr(ret);
    647 		}
    648 		if (!(ev = tisp_eval(st, env, car(v))))
    649 			return NULL;
    650 		cdr(cur) = mk_pair(ev, st->none);
    651 	}
    652 	cdr(cur) = st->nil;
    653 	return cdr(ret);
    654 }
    655 
    656 /* evaluate all elements of list returning last */
    657 Val
    658 tisp_eval_seq(Tsp st, Hash env, Val v)
    659 {
    660 	Val ret = st->none;
    661 	for (; v->t == TSP_PAIR; v = cdr(v))
    662 		if (!(ret = tisp_eval(st, env, car(v))))
    663 			return NULL;
    664 	return nilp(v) ? ret : tisp_eval(st, env, v);
    665 }
    666 
    667 static void
    668 prepend_bt(Tsp st, Hash env, Val f)
    669 {
    670 	if (!f->v.f.name) /* no need to record anonymous functions */
    671 		return;
    672 	for (; env->next; env = env->next) ; /* bt var located at base env */
    673 	Entry e = entry_get(env, "bt");
    674 	if (e->val->t == TSP_PAIR && car(e->val)->t == TSP_SYM &&
    675 	    !strncmp(f->v.f.name, car(e->val)->v.s, strlen(car(e->val)->v.s)))
    676 		return; /* don't record same function on recursion */
    677 	e->val = mk_pair(mk_sym(st, f->v.f.name), e->val);
    678 }
    679 
    680 /* evaluate procedure f with arguments */
    681 static Val
    682 eval_proc(Tsp st, Hash env, Val f, Val args)
    683 {
    684 	Val ret;
    685 	Hash e;
    686 	/* evaluate function and primitive arguments before being passed */
    687 	if (f->t & (TSP_FUNC|TSP_PRIM))
    688 		if (!(args = tisp_eval_list(st, env, args)))
    689 			return NULL;
    690 	switch (f->t) {
    691 	case TSP_FORM:
    692 	case TSP_PRIM:
    693 		return (*f->v.pr.pr)(st, env, args);
    694 	case TSP_FUNC:
    695 	case TSP_MACRO:
    696 		tsp_arg_num(args, f->v.f.name ? f->v.f.name : "anonymous",
    697 		            list_len(f->v.f.args));
    698 		e = hash_new(8, f->v.f.env);
    699 		/* TODO call hash_extend in hash_new to know new hash size */
    700 		if (!(hash_extend(e, f->v.f.args, args)))
    701 			return NULL;
    702 		if (!(ret = tisp_eval_seq(st, e, f->v.f.body)))
    703 			return prepend_bt(st, env, f), NULL;
    704 		if (f->t == TSP_MACRO)
    705 			ret = tisp_eval(st, env, ret);
    706 		return ret;
    707 	default:
    708 		tsp_warnf("attempt to evaluate non procedural type %s", type_str(f->t));
    709 	}
    710 }
    711 
    712 /* evaluate given value */
    713 Val
    714 tisp_eval(Tsp st, Hash env, Val v)
    715 {
    716 	Val f;
    717 	switch (v->t) {
    718 	case TSP_SYM:
    719 		if (!(f = hash_get(env, v->v.s)))
    720 			tsp_warnf("could not find symbol %s", v->v.s);
    721 		return f;
    722 	case TSP_PAIR:
    723 		if (!(f = tisp_eval(st, env, car(v))))
    724 			return NULL;
    725 		return eval_proc(st, env, f, cdr(v));
    726 	case TSP_STR: /* TODO string interpolation */
    727 	default:
    728 		return v;
    729 	}
    730 }
    731 
    732 /* print */
    733 
    734 /* main print function */
    735 void
    736 tisp_print(FILE *f, Val v)
    737 {
    738 	switch (v->t) {
    739 	case TSP_NONE:
    740 		fputs("#<void>", f);
    741 		break;
    742 	case TSP_NIL:
    743 		fputs("Nil", f);
    744 		break;
    745 	case TSP_INT:
    746 		fprintf(f, "%d", (int)num(v));
    747 		break;
    748 	case TSP_DEC:
    749 		fprintf(f, "%.15g", num(v));
    750 		if (num(v) == (int)num(v))
    751 			fprintf(f, ".0");
    752 		break;
    753 	case TSP_RATIO:
    754 		fprintf(f, "%d/%d", (int)num(v), (int)den(v));
    755 		break;
    756 	case TSP_STR:
    757 	case TSP_SYM:
    758 		fputs(v->v.s, f);
    759 		break;
    760 	case TSP_FUNC:
    761 	case TSP_MACRO:
    762 		fprintf(f, "#<%s%s%s>", /* if proc name is not null print it */
    763 		            v->t == TSP_FUNC ? "function" : "macro",
    764 		            v->v.pr.name ? ":" : "",
    765 		            v->v.pr.name ? v->v.pr.name : "");
    766 		break;
    767 	case TSP_PRIM:
    768 		fprintf(f, "#<primitive:%s>", v->v.pr.name);
    769 		break;
    770 	case TSP_PAIR:
    771 		putc('(', f);
    772 		tisp_print(f, car(v));
    773 		for (v = cdr(v); !nilp(v); v = cdr(v)) {
    774 			if (v->t == TSP_PAIR) {
    775 				putc(' ', f);
    776 				tisp_print(f, car(v));
    777 			} else {
    778 				fputs(" . ", f);
    779 				tisp_print(f, v);
    780 				break;
    781 			}
    782 		}
    783 		putc(')', f);
    784 		break;
    785 	default:
    786 		fprintf(stderr, "; tisp: could not print value type %s\n", type_str(v->t));
    787 	}
    788 }
    789 
    790 /* primitives */
    791 
    792 /* return first element of list */
    793 static Val
    794 prim_car(Tsp st, Hash env, Val args)
    795 {
    796 	tsp_arg_num(args, "car", 1);
    797 	tsp_arg_type(car(args), "car", TSP_PAIR);
    798 	return caar(args);
    799 }
    800 
    801 /* return elements of a list after the first */
    802 static Val
    803 prim_cdr(Tsp st, Hash env, Val args)
    804 {
    805 	tsp_arg_num(args, "cdr", 1);
    806 	tsp_arg_type(car(args), "cdr", TSP_PAIR);
    807 	return cdar(args);
    808 }
    809 
    810 /* return new pair */
    811 static Val
    812 prim_cons(Tsp st, Hash env, Val args)
    813 {
    814 	tsp_arg_num(args, "cons", 2);
    815 	return mk_pair(car(args), cadr(args));
    816 }
    817 
    818 /* do not evaluate argument */
    819 static Val
    820 form_quote(Tsp st, Hash env, Val args)
    821 {
    822 	tsp_arg_num(args, "quote", 1);
    823 	return car(args);
    824 }
    825 
    826 /* TODO make Void variable like Nil, True, False or like Str, Int ? */
    827 /* returns nothing */
    828 static Val
    829 form_Void(Tsp st, Hash env, Val args)
    830 {
    831 	return st->none;
    832 }
    833 
    834 /* evaluate argument given */
    835 static Val
    836 prim_eval(Tsp st, Hash env, Val args)
    837 {
    838 	Val v;
    839 	tsp_arg_num(args, "eval", 1);
    840 	return (v = tisp_eval(st, st->global, car(args))) ? v : st->none;
    841 }
    842 
    843 /* test equality of all values given */
    844 static Val
    845 prim_eq(Tsp st, Hash env, Val args)
    846 {
    847 	if (nilp(args))
    848 		return st->t;
    849 	for (; !nilp(cdr(args)); args = cdr(args))
    850 		if (!vals_eq(car(args), cadr(args)))
    851 			return st->nil;
    852 	return st->t;
    853 }
    854 
    855 /* evaluates all expressions if their conditions are met */
    856 static Val
    857 form_cond(Tsp st, Hash env, Val args)
    858 {
    859 	Val v, cond;
    860 	for (v = args; !nilp(v); v = cdr(v))
    861 		if (!(cond = tisp_eval(st, env, caar(v))))
    862 			return NULL;
    863 		else if (!nilp(cond)) /* TODO incorporate else directly into cond */
    864 			return tisp_eval_seq(st, env, cdar(v));
    865 	return st->none;
    866 }
    867 
    868 /* return type of tisp value */
    869 static Val
    870 prim_typeof(Tsp st, Hash env, Val args)
    871 {
    872 	tsp_arg_num(args, "typeof", 1);
    873 	return mk_str(st, type_str(car(args)->t));
    874 }
    875 
    876 /* TODO rename get to getattr like python ? */
    877 /* get a property of given value */
    878 static Val
    879 prim_get(Tsp st, Hash env, Val args)
    880 {
    881 	Val v, prop;
    882 	tsp_arg_num(args, "get", 2);
    883 	v = car(args);
    884 	prop = cadr(args);
    885 	tsp_arg_type(prop, "get", TSP_SYM);
    886 	switch (v->t) {
    887 	case TSP_PRIM:
    888 		if (!strncmp(prop->v.s, "name", 4))
    889 			return mk_sym(st, v->v.pr.name);
    890 		break;
    891 	case TSP_FUNC:
    892 	case TSP_MACRO:
    893 		if (!strncmp(prop->v.s, "name", 4)) /* TODO fix seg fault on anon proc */
    894 			return mk_sym(st, v->v.f.name);
    895 		if (!strncmp(prop->v.s, "body", 4))
    896 			return v->v.f.body;
    897 		if (!strncmp(prop->v.s, "args", 4))
    898 			return v->v.f.args;
    899 		break;
    900 	case TSP_INT:
    901 	case TSP_RATIO:
    902 		if (!strncmp(prop->v.s, "num", 3))
    903 			return mk_int(v->v.n.num);
    904 		if (!strncmp(prop->v.s, "den", 3))
    905 			return mk_int(v->v.n.den);
    906 		break;
    907 	case TSP_PAIR:
    908 		if (!strncmp(prop->v.s, "car", 3))
    909 			return v->v.p.car;
    910 		if (!strncmp(prop->v.s, "cdr", 3))
    911 			return v->v.p.cdr;
    912 		break;
    913 	case TSP_STR:
    914 	case TSP_SYM:
    915 		if (!strncmp(prop->v.s, "len", 3))
    916 			return mk_int(strlen(v->v.s));
    917 	default: break;
    918 	}
    919 	tsp_warnf("get: can not access %s from type %s",
    920 		   prop->v.s, type_str(v->t));
    921 }
    922 
    923 /* creates new tisp lambda function */
    924 static Val
    925 form_lambda(Tsp st, Hash env, Val args)
    926 {
    927 	tsp_arg_min(args, "lambda", 2);
    928 	return mk_func(TSP_FUNC, NULL, car(args), cdr(args), env);
    929 }
    930 
    931 /* creates new tisp defined macro */
    932 static Val
    933 form_macro(Tsp st, Hash env, Val args)
    934 {
    935 	tsp_arg_min(args, "macro", 2);
    936 	return mk_func(TSP_MACRO, NULL, car(args), cdr(args), env);
    937 }
    938 
    939 /* creates new variable of given name and value
    940  * if pair is given as name of variable, creates function with the car as the
    941  * function name and the cdr the function arguments */
    942 /* TODO if var not func error if more than 2 args */
    943 static Val
    944 form_def(Tsp st, Hash env, Val args)
    945 {
    946 	Val sym, val;
    947 	tsp_arg_min(args, "def", 1);
    948 	if (car(args)->t == TSP_PAIR) { /* create function if given argument list */
    949 		sym = caar(args); /* first element of argument list is function name */
    950 		if (sym->t != TSP_SYM)
    951 			tsp_warnf("def: incorrect format,"
    952 			          " expected symbol for function name, received %s",
    953 			          type_str(sym->t));
    954 		val = mk_func(TSP_FUNC, sym->v.s, cdar(args), cdr(args), env);
    955 	} else if (car(args)->t == TSP_SYM) { /* create variable */
    956 		sym = car(args); /* if only symbol given, make it self evaluating */
    957 		val = nilp(cdr(args)) ? sym : tisp_eval(st, env, cadr(args));
    958 	} else tsp_warn("def: incorrect format, no variable name found");
    959 	if (!val)
    960 		return NULL;
    961 	/* set procedure name if it was previously anonymous */
    962 	if (val->t & (TSP_FUNC|TSP_MACRO) && !val->v.f.name)
    963 		val->v.f.name = sym->v.s;
    964 	hash_add(env, sym->v.s, val);
    965 	return st->none;
    966 }
    967 
    968 /* set symbol to new value */
    969 static Val
    970 form_set(Tsp st, Hash env, Val args)
    971 {
    972 	Val val;
    973 	Hash h;
    974 	Entry e = NULL;
    975 	tsp_arg_num(args, "set!", 2);
    976 	tsp_arg_type(car(args), "set!", TSP_SYM);
    977 	if (!(val = tisp_eval(st, env, cadr(args))))
    978 		return NULL;
    979 	/* find first occurrence of symbol */
    980 	for (h = env; h; h = h->next) {
    981 		e = entry_get(h, car(args)->v.s);
    982 		if (e->key)
    983 			break;
    984 	}
    985 	if (!e || !e->key)
    986 		tsp_warnf("set!: variable %s is not defined", car(args)->v.s);
    987 	e->val = val;
    988 	return val;
    989 }
    990 
    991 /* loads tisp file or C dynamic library */
    992 /* TODO lua like error listing places load looked */
    993 /* TODO only use dlopen if -ldl is given with TIB_DYNAMIC */
    994 /* TODO define load in lisp which calls load-dl */
    995 static Val
    996 prim_load(Tsp st, Hash env, Val args)
    997 {
    998 	Val tib;
    999 	void (*tibenv)(Tsp);
   1000 	char name[PATH_MAX];
   1001 	const char *paths[] = {
   1002 		"/usr/local/share/tisp/", "/usr/share/tisp/", "./", NULL
   1003 	};
   1004 
   1005 	tsp_arg_num(args, "load", 1);
   1006 	tib = car(args);
   1007 	tsp_arg_type(tib, "load", TSP_STR);
   1008 
   1009 	for (int i = 0; paths[i]; i++) {
   1010 		strcpy(name, paths[i]);
   1011 		strcat(name, tib->v.s);
   1012 		strcat(name, ".tsp");
   1013 		if (access(name, R_OK) != -1) {
   1014 			tisp_eval_seq(st, env, tisp_parse_file(st, name));
   1015 			return st->none;
   1016 		}
   1017 	}
   1018 
   1019 	/* If not tisp file, try loading shared object library */
   1020 	st->libh = realloc(st->libh, (st->libhc+1)*sizeof(void*));
   1021 	if (!st->libh) perror("; realloc"), exit(1);
   1022 
   1023 	memset(name, 0, sizeof(name));
   1024 	strcpy(name, "libtib");
   1025 	strcat(name, tib->v.s);
   1026 	strcat(name, ".so");
   1027 	if (!(st->libh[st->libhc] = dlopen(name, RTLD_LAZY)))
   1028 		tsp_warnf("load: could not load '%s':\n%s", tib->v.s, dlerror());
   1029 	dlerror();
   1030 
   1031 	memset(name, 0, sizeof(name));
   1032 	strcpy(name, "tib_env_");
   1033 	strcat(name, tib->v.s);
   1034 	tibenv = dlsym(st->libh[st->libhc], name);
   1035 	if (dlerror())
   1036 		tsp_warnf("load: could not run '%s':\n%s", tib->v.s, dlerror());
   1037 	(*tibenv)(st);
   1038 
   1039 	st->libhc++;
   1040 	return st->none;
   1041 }
   1042 
   1043 /* display message and return error */
   1044 static Val
   1045 prim_error(Tsp st, Hash env, Val args)
   1046 {
   1047 	/* TODO have error auto print function name that was pre-defined */
   1048 	tsp_arg_min(args, "error", 2);
   1049 	tsp_arg_type(car(args), "error", TSP_SYM);
   1050 	/* TODO specify error raised by error func */
   1051 	fprintf(stderr, "; tisp: error: %s: ", car(args)->v.s);
   1052 	for (args = cdr(args); !nilp(args); args = cdr(args))
   1053 		tisp_print(stderr, car(args));
   1054 	fputc('\n', stderr);
   1055 	return NULL;
   1056 }
   1057 
   1058 /* list tisp version */
   1059 static Val
   1060 form_version(Tsp st, Hash env, Val args)
   1061 {
   1062 	return mk_str(st, "0.0");
   1063 }
   1064 
   1065 /* environment */
   1066 
   1067 /* add new variable of name key and value v to the given environment */
   1068 void
   1069 tisp_env_add(Tsp st, char *key, Val v)
   1070 {
   1071 	hash_add(st->global, key, v);
   1072 }
   1073 
   1074 /* initialise tisp's state and global environment */
   1075 Tsp
   1076 tisp_env_init(size_t cap)
   1077 {
   1078 	Tsp st = malloc(sizeof(struct Tsp));
   1079 	if (!st) perror("; malloc"), exit(1);
   1080 
   1081 	st->file = NULL;
   1082 	st->filec = 0;
   1083 
   1084 	st->nil = mk_val(TSP_NIL);
   1085 	st->none = mk_val(TSP_NONE);
   1086 	st->t = mk_val(TSP_SYM);
   1087 	st->t->v.s = "True";
   1088 
   1089 	st->global = hash_new(cap, NULL);
   1090 	tisp_env_add(st, "True", st->t);
   1091 	tisp_env_add(st, "Nil", st->nil);
   1092 	tisp_env_add(st, "bt", st->nil);
   1093 	tsp_env_prim(car);
   1094 	tsp_env_prim(cdr);
   1095 	tsp_env_prim(cons);
   1096 	tsp_env_form(quote);
   1097 	tsp_env_form(Void);
   1098 	tsp_env_prim(eval);
   1099 	tsp_env_name_prim(=, eq);
   1100 	tsp_env_form(cond);
   1101 	tsp_env_prim(typeof);
   1102 	tsp_env_prim(get);
   1103 	tsp_env_form(lambda);
   1104 	tsp_env_form(macro);
   1105 	tsp_env_form(def);
   1106 	tsp_env_name_form(set!, set);
   1107 	tsp_env_prim(load);
   1108 	tsp_env_prim(error);
   1109 	tsp_env_form(version);
   1110 
   1111 	st->strs = hash_new(cap, NULL);
   1112 	st->syms = hash_new(cap, NULL);
   1113 
   1114 	st->libh = NULL;
   1115 	st->libhc = 0;
   1116 
   1117 	return st;
   1118 }
   1119 
   1120 void
   1121 tisp_env_lib(Tsp st, char* lib)
   1122 {
   1123 	Val v;
   1124 	char *file = st->file;
   1125 	size_t filec = st->filec;
   1126 	st->file = lib;
   1127 	st->filec = 0;
   1128 	if ((v = tisp_read(st)))
   1129 		tisp_eval_seq(st, st->global, v);
   1130 	st->file = file;
   1131 	st->filec = filec;
   1132 }