tisp.c

/* zlib License
 *
 * Copyright (c) 2017-2022 Ed van Bruggen
 *
 * This software is provided 'as-is', without any express or implied
 * warranty.  In no event will the authors be held liable for any damages
 * arising from the use of this software.
 *
 * Permission is granted to anyone to use this software for any purpose,
 * including commercial applications, and to alter it and redistribute it
 * freely, subject to the following restrictions:
 *
 * 1. The origin of this software must not be misrepresented; you must not
 *    claim that you wrote the original software. If you use this software
 *    in a product, an acknowledgment in the product documentation would be
 *    appreciated but is not required.
 * 2. Altered source versions must be plainly marked as such, and must not be
 *    misrepresented as being the original software.
 * 3. This notice may not be removed or altered from any source distribution.
 */
#include <ctype.h>
#include <dlfcn.h>
#include <fcntl.h>
#include <limits.h>
#include <stdarg.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>

#include "tisp.h"

#define BETWEEN(X, A, B)  ((A) <= (X) && (X) <= (B))
#define LEN(X)            (sizeof(X) / sizeof((X)[0]))

/* functions */
static void hash_add(Hash ht, char *key, Val val);

/* utility functions */

/* return named string for each type */
/* TODO loop through each type bit to print */
char *
type_str(TspType t)
{
	switch (t) {
	case TSP_NONE:  return "Void";
	case TSP_NIL:   return "Nil";
	case TSP_INT:   return "Int";
	case TSP_DEC:   return "Dec";
	case TSP_RATIO: return "Ratio";
	case TSP_STR:   return "Str";
	case TSP_SYM:   return "Sym";
	case TSP_PRIM:  return "Prim";
	case TSP_FORM:  return "Form";
	case TSP_FUNC:  return "Func";
	case TSP_MACRO: return "Macro";
	case TSP_PAIR:  return "Pair";
	default:
		if (t == TSP_EXPR)
			return "Expr";
		if (t == TSP_RATIONAL)
			return "Rational";
		if (t & TSP_NUM)
			return "Num";
		return "Invalid";
	}
}

/* check if character can be a part of a symbol */
static int
issym(char c)
{
	return BETWEEN(c, 'a', 'z') || BETWEEN(c, 'A', 'Z') ||
	       BETWEEN(c, '0', '9') || strchr("_+-*/=<>!?$&^#@:~", c);
}

/* check if character is start of a number */
/* TODO only if -/+ is not followed by a delim */
static int
isnum(char *str)
{
	return isdigit(*str) || (*str == '.' && isdigit(str[1])) ||
	       ((*str == '-' || *str == '+') && (isdigit(str[1]) || str[1] == '.'));
}

/* check if character is a symbol delimiter */
static char
isdelim(int c)
{
	/* add .{}[]`', */
	return isspace(c) || c == '(' || c == ')' || c == '"' || c == ';';
}

/* skip over comments and white space */
/* TODO support mac/windows line endings */
static void
skip_ws(Tsp st, int skipnl)
{
	const char *s = skipnl ? " \t\n" : " \t";
	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;
	}
}

/* count number of parenthesis */
static int
count_parens(char *s, int len)
{
	int count = 0;
	for (int i = 0; i < len && s[i]; i++)
		if (s[i] == '(')
			count++;
		else if (s[i] == ')')
			count--;
	return count;
}

/* get length of list, if improper list return -1 */
int
list_len(Val v)
{
	int len = 0;
	for (; v->t == TSP_PAIR; v = cdr(v))
		len++;
	return nilp(v) ? len : -1;
}

/* check if two values are equal */
static int
vals_eq(Val a, Val b)
{
	if (a->t & TSP_NUM && b->t & TSP_NUM) { /* NUMBERs */
		if (num(a) != num(b) || den(a) != den(b))
			return 0;
		return 1;
	}
	if (a->t != b->t)
		return 0;
	if (a->t == TSP_PAIR) /* PAIR */
		return vals_eq(car(a), car(b)) && vals_eq(cdr(a), cdr(b));
	/* TODO function var names should not matter in comparison */
	if (a->t & (TSP_FUNC | TSP_MACRO)) /* FUNCTION, MACRO */
		return vals_eq(a->v.f.args, b->v.f.args) &&
		       vals_eq(a->v.f.body, b->v.f.body);
	if (a != b) /* PRIMITIVE, STRING, SYMBOL, NIL, VOID */
		return 0;
	return 1;
}

/* reduce fraction by modifying supplied numerator and denominator */
static void
frac_reduce(int *num, int *den)
{
	int a = abs(*num), b = abs(*den), c = a % b;
	while (c > 0) {
		a = b;
		b = c;
		c = a % b;
	}
	*num = *num / b;
	*den = *den / b;
}

/* hash map */

/* return hashed number based on key */
static uint32_t
hash(char *key)
{
	uint32_t h = 0;
	char c;
	while (h < UINT32_MAX && (c = *key++))
		h = h * 33 + c;
	return h;
}

/* create new empty hash table with given capacity */
static Hash
hash_new(size_t cap, Hash next)
{
	if (cap < 1) return NULL;
	Hash ht = malloc(sizeof(struct Hash));
	if (!ht) perror("; malloc"), exit(1);
	ht->size = 0;
	ht->cap = cap;
	ht->items = calloc(cap, sizeof(struct Entry));
	if (!ht->items) perror("; calloc"), exit(1);
	ht->next = next;
	return ht;
}

/* get entry in one hash table for the key */
static Entry
entry_get(Hash ht, char *key)
{
	int i = hash(key) % ht->cap;
	char *s;
	while ((s = ht->items[i].key)) {
		if (!strcmp(s, key))
			break;
		if (++i == ht->cap)
			i = 0;
	}
	return &ht->items[i]; /* returns entry if found or empty one to be filled */
}

/* get value of given key in each hash table */
static Val
hash_get(Hash ht, char *key)
{
	Entry e;
	for (; ht; ht = ht->next) {
		e = entry_get(ht, key);
		if (e->key)
			return e->val;
	}
	return NULL;
}

/* enlarge the hash table to ensure algorithm's efficiency */
static void
hash_grow(Hash ht)
{
	int i, ocap = ht->cap;
	Entry oitems = ht->items;
	ht->cap *= 2;
	ht->items = calloc(ht->cap, sizeof(struct Entry));
	if (!ht->items) perror("; calloc"), exit(1);
	for (i = 0; i < ocap; i++) /* repopulate new hash table with old values */
		if (oitems[i].key)
			hash_add(ht, oitems[i].key, oitems[i].val);
	free(oitems);
}

/* create new key and value pair to the hash table */
static void
hash_add(Hash ht, char *key, Val val)
{
	Entry e = entry_get(ht, key);
	e->val = val;
	if (!e->key) {
		e->key = key;
		ht->size++;
		if (ht->size > ht->cap / 2) /* grow table if it is more than half full */
			hash_grow(ht);
	}
}

/* add each binding args[i] -> vals[i] */
/* args and vals are both lists */
/* TODO don't return anything in hash_extend since it's modifying ht */
static Hash
hash_extend(Hash ht, Val args, Val vals)
{
	Val arg, val;
	for (; !nilp(args); args = cdr(args), vals = cdr(vals)) {
		if (args->t == TSP_PAIR) {
			arg = car(args);
			val = car(vals);
		} else {
			arg = args;
			val = vals;
		}
		if (arg->t != TSP_SYM)
			tsp_warnf("expected symbol for argument of function"
				  " definition, recieved %s", type_str(arg->t));
		hash_add(ht, arg->v.s, val);
		if (args->t != TSP_PAIR)
			break;
	}
	return ht;
}

/* make types */

Val
mk_val(TspType t)
{
	Val ret = malloc(sizeof(struct Val));
	if (!ret) perror("; malloc"), exit(1);
	ret->t = t;
	return ret;
}

Val
mk_int(int i)
{
	Val ret = mk_val(TSP_INT);
	num(ret) = i;
	den(ret) = 1;
	return ret;
}

Val
mk_dec(double d)
{
	Val ret = mk_val(TSP_DEC);
	num(ret) = d;
	den(ret) = 1;
	return ret;
}

Val
mk_rat(int num, int den)
{
	Val ret;
	if (den == 0)
		tsp_warn("division by zero");
	frac_reduce(&num, &den);
	if (den < 0) { /* simplify so only numerator is negative */
		den = abs(den);
		num = -num;
	}
	if (den == 1) /* simplify into integer if denominator is 1 */
		return mk_int(num);
	ret = mk_val(TSP_RATIO);
	ret->v.n.num = num;
	ret->v.n.den = den;
	return ret;
}

/* TODO combine mk_str and mk_sym */
Val
mk_str(Tsp st, char *s)
{
	Val ret;
	if ((ret = hash_get(st->strs, s)))
		return ret;
	ret = mk_val(TSP_STR);
	ret->v.s = strndup(s, strlen(s));
	if (!ret->v.s) perror("; strndup"), exit(1);
	hash_add(st->strs, s, ret);
	return ret;
}

Val
mk_sym(Tsp st, char *s)
{
	Val ret;
	if ((ret = hash_get(st->syms, s)))
		return ret;
	ret = mk_val(TSP_SYM);
	ret->v.s = strndup(s, strlen(s));
	if (!ret->v.s) perror("; strndup"), exit(1);
	hash_add(st->syms, s, ret);
	return ret;
}

Val
mk_prim(TspType t, Prim pr, char *name)
{
	Val ret = mk_val(t);
	ret->v.pr.name = name;
	ret->v.pr.pr = pr;
	return ret;
}

Val
mk_func(TspType t, char *name, Val args, Val body, Hash env)
{
	Val ret = mk_val(t);
	ret->v.f.name = name;
	ret->v.f.args = args;
	ret->v.f.body = body;
	ret->v.f.env  = env;
	return ret;
}

Val
mk_pair(Val a, Val b)
{
	Val ret = mk_val(TSP_PAIR);
	car(ret) = a;
	cdr(ret) = b;
	return ret;
}

Val
mk_list(Tsp st, int n, ...)
{
	Val lst, cur;
	va_list argp;
	va_start(argp, n);
	lst = mk_pair(va_arg(argp, Val), st->nil);
	for (cur = lst; n > 1; n--, cur = cdr(cur))
		cdr(cur) = mk_pair(va_arg(argp, Val), st->nil);
	va_end(argp);
	return lst;
}

/* read */

/* read first character of number to determine sign */
static int
read_sign(Tsp st)
{
	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(Tsp st)
{
	int ret = 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(Tsp st, double val, int isint)
{
	if (tolower(tsp_fget(st)) != 'e')
		goto finish;

	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)
		return mk_int(val);
	return mk_dec(val);
}

/* return read number */
static Val
read_num(Tsp st)
{
	int sign = read_sign(st);
	int num = read_int(st);
	size_t oldc;
	switch (tsp_fget(st)) {
	case '/':
		if (!isnum(st->file + ++st->filec))
			tsp_warn("incorrect ratio format, no denominator found");
		return mk_rat(sign * num, read_sign(st) * read_int(st));
	case '.':
		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(st, sign * (num+d), 0);
	default:
		return read_sci(st, sign * num, 1);
	}
}

/* return character for escape */
static char
esc_char(char c)
{
	switch (c) {
	case 'n': return '\n';
	case 't': return '\t';
	case '\n': return ' ';
	case '\\':
	case '"':
	default:  return c;
	}
}

/* replace all encoded escape characters in string with their actual character */
static char *
esc_str(char *s, int len)
{
	char *pos, *ret = malloc((len+1) * sizeof(char));
	if (!ret) perror("; malloc"), exit(1);
	for (pos = ret; pos-ret < len; pos++, s++)
		*pos = (*s == '\\') ? esc_char(*(++s)) : *s;
	*pos = '\0';
	return ret;
}

/* return read string */
static Val
read_str(Tsp st)
{
	int len = 0;
	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(st) == '\\' && tsp_fgetat(st, -1) != '\\')
			tsp_finc(st); /* skip over break condition */
	tsp_finc(st); /* skip last closing quote */
	return mk_str(st, esc_str(s, len));
}

/* return read symbol */
static Val
read_sym(Tsp st)
{
	int n = 1, i = 0;
	char *sym = malloc(n);
	for (; tsp_fget(st) && issym(tsp_fget(st)); tsp_finc(st)) {
		if (!sym) perror("; alloc"), exit(1);
		sym[i++] = tsp_fget(st);
		if (i == n) {
			n *= 2;
			sym = realloc(sym, n);
		}
	}
	sym[i] = '\0';
	return mk_sym(st, sym);
}

/* return read string containing a list */
/* TODO read pair after as well, allow lambda((x) (* x 2))(4) */
static Val
read_pair(Tsp st, char endchar)
{
	Val a, b;
	skip_ws(st, 1);
	if (tsp_fget(st) == endchar)
		return tsp_finc(st), st->nil;
	/* TODO simplify read_pair by supporting (. x) => x */
	if (!(a = tisp_read(st)))
		return NULL;
	skip_ws(st, 1);
	if (!tsp_fget(st))
		tsp_warnf("reached end before closing '%c'", endchar);
	if (tsp_fget(st) == '.' && isdelim(tsp_fgetat(st,1))) {
		tsp_finc(st);
		if (!(b = tisp_read(st)))
			return NULL;
		skip_ws(st, 1);
		if (tsp_fget(st) != endchar)
			tsp_warnf("did not find closing '%c'", endchar);
		tsp_finc(st);
		skip_ws(st, 1);
	} else {
		if (!(b = read_pair(st, endchar)))
			return NULL;
	}
	return mk_pair(a, b);
}

/* reads given string returning its tisp value */
Val
tisp_read(Tsp st)
{
	char *prefix[] = {
		"'",  "quote",
		"`",  "quasiquote",
		",@", "unquote-splice", /* always check before , */
		",",  "unquote",
		"@",  "Func",
	};
	skip_ws(st, 1);
	if (strlen(st->file+st->filec) == 0) /* empty list */
		return st->none;
	if (isnum(st->file+st->filec)) /* number */
		return read_num(st);
	/* TODO support | for symbols */
	if (tsp_fget(st) == '"') /* strings */
		return read_str(st);
	for (int i = 0; i < LEN(prefix); i += 2) { /* character prefix */
		if (!strncmp(st->file+st->filec, prefix[i], strlen(prefix[i]))) {
			Val v;
			tsp_fincn(st, strlen(prefix[i]));
			if (!(v = tisp_read(st)))
				return NULL;
			return mk_list(st, 2, mk_sym(st, prefix[i+1]), v);
		}
	}
	if (issym(tsp_fget(st))) /* symbols */
		return read_sym(st);
	if (tsp_fget(st) == '(') /* list */
		return tsp_finc(st), read_pair(st, ')');
	tsp_warnf("could not read given input '%c'", st->file[st->filec]);
}

/* return string containing contents of file name */
char *
tisp_read_file(char *fname)
{
	char buf[BUFSIZ], *file = NULL;
	int len = 0, n, fd, parens = 0;
	if (!fname) /* read from stdin if no file given */
		fd = 0;
	else if ((fd = open(fname, O_RDONLY)) < 0)
		tsp_warnf("could not find file '%s'", fname);
	while ((n = read(fd, buf, sizeof(buf))) > 0) {
		file = realloc(file, len + n + 1);
		if (!file) perror("; realloc"), exit(1);
		memcpy(file + len, buf, n);
		len += n;
		file[len] = '\0';
		if (fd == 0 && !(parens += count_parens(buf, n)))
			break;
	}
	if (fd) /* close file if not stdin */
		close(fd);
	if (n < 0)
		tsp_warnf("could not read file '%s'", fname);
	return file;
}

/* read given file name returning its tisp value */
Val
tisp_parse_file(Tsp st, char *fname)
{
	Val ret = mk_pair(st->none, st->nil);
	Val v, last = ret;
	char *file = st->file;
	size_t filec = st->filec;
	if (!(st->file = tisp_read_file(fname)))
		return ret;
	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);
}

/* eval */

/* evaluate each element of list */
Val
tisp_eval_list(Tsp st, Hash env, Val v)
{
	Val cur = mk_pair(NULL, st->none);
	Val ret = cur, ev;
	for (; !nilp(v); v = cdr(v), cur = cdr(cur)) {
		if (v->t != TSP_PAIR) {
			if (!(ev = tisp_eval(st, env, v)))
				return NULL;
			cdr(cur) = ev;
			return cdr(ret);
		}
		if (!(ev = tisp_eval(st, env, car(v))))
			return NULL;
		cdr(cur) = mk_pair(ev, st->none);
	}
	cdr(cur) = st->nil;
	return cdr(ret);
}

/* evaluate all elements of list returning last */
Val
tisp_eval_seq(Tsp st, Hash env, Val v)
{
	Val ret = st->none;
	for (; v->t == TSP_PAIR; v = cdr(v))
		if (!(ret = tisp_eval(st, env, car(v))))
			return NULL;
	return nilp(v) ? ret : tisp_eval(st, env, v);
}

static void
prepend_bt(Tsp st, Hash env, Val f)
{
	if (!f->v.f.name) /* no need to record anonymous functions */
		return;
	for (; env->next; env = env->next) ; /* bt var located at base env */
	Entry e = entry_get(env, "bt");
	if (e->val->t == TSP_PAIR && car(e->val)->t == TSP_SYM &&
	    !strncmp(f->v.f.name, car(e->val)->v.s, strlen(car(e->val)->v.s)))
		return; /* don't record same function on recursion */
	e->val = mk_pair(mk_sym(st, f->v.f.name), e->val);
}

/* evaluate procedure f with arguments */
static Val
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:
	case TSP_MACRO:
		tsp_arg_num(args, f->v.f.name ? f->v.f.name : "anon",
		            list_len(f->v.f.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;
		if (!(ret = tisp_eval_seq(st, e, f->v.f.body)))
			return prepend_bt(st, env, f), NULL;
		if (f->t == TSP_MACRO)
			ret = tisp_eval(st, env, ret);
		return ret;
	default:
		tsp_warnf("attempt to evaluate non procedural type %s", type_str(f->t));
	}
}

/* evaluate given value */
Val
tisp_eval(Tsp st, Hash env, Val v)
{
	Val f;
	switch (v->t) {
	case TSP_SYM:
		if (!(f = hash_get(env, v->v.s)))
			tsp_warnf("could not find symbol %s", v->v.s);
		return f;
	case TSP_PAIR:
		if (!(f = tisp_eval(st, env, car(v))))
			return NULL;
		return eval_proc(st, env, f, cdr(v));
	case TSP_STR: /* TODO string interpolation */
	default:
		return v;
	}
}

/* print */

/* main print function */
void
tisp_print(FILE *f, Val v)
{
	switch (v->t) {
	case TSP_NONE:
		fputs("Void", f);
		break;
	case TSP_NIL:
		fputs("Nil", f);
		break;
	case TSP_INT:
		fprintf(f, "%d", (int)num(v));
		break;
	case TSP_DEC:
		fprintf(f, "%.15g", num(v));
		if (num(v) == (int)num(v))
			fprintf(f, ".0");
		break;
	case TSP_RATIO:
		fprintf(f, "%d/%d", (int)num(v), (int)den(v));
		break;
	case TSP_STR:
	case TSP_SYM:
		fputs(v->v.s, f);
		break;
	case TSP_FUNC:
	case TSP_MACRO:
		fprintf(f, "#<%s%s%s>", /* if proc name is not null print it */
		            v->t == TSP_FUNC ? "function" : "macro",
		            v->v.pr.name ? ":" : "",
		            v->v.pr.name ? v->v.pr.name : "");
		break;
	case TSP_PRIM:
		fprintf(f, "#<primitive:%s>", v->v.pr.name);
		break;
	case TSP_FORM:
		fprintf(f, "#<form:%s>", v->v.pr.name);
		break;
	case TSP_PAIR:
		putc('(', f);
		tisp_print(f, car(v));
		for (v = cdr(v); !nilp(v); v = cdr(v)) {
			if (v->t == TSP_PAIR) {
				putc(' ', f);
				tisp_print(f, car(v));
			} else {
				fputs(" . ", f);
				tisp_print(f, v);
				break;
			}
		}
		putc(')', f);
		break;
	default:
		fprintf(stderr, "; tisp: could not print value type %s\n", type_str(v->t));
	}
}

/* primitives */

/* return first element of list */
static Val
prim_car(Tsp st, Hash env, Val args)
{
	tsp_arg_num(args, "car", 1);
	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)
{
	tsp_arg_num(args, "cdr", 1);
	tsp_arg_type(car(args), "cdr", TSP_PAIR);
	return cdar(args);
}

/* return new pair */
static Val
prim_cons(Tsp st, Hash env, Val args)
{
	tsp_arg_num(args, "cons", 2);
	return mk_pair(car(args), cadr(args));
}

/* do not evaluate argument */
static Val
form_quote(Tsp st, Hash env, Val args)
{
	tsp_arg_num(args, "quote", 1);
	return car(args);
}

/* evaluate argument given */
static Val
prim_eval(Tsp st, Hash env, Val args)
{
	Val v;
	tsp_arg_num(args, "eval", 1);
	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)
{
	if (nilp(args))
		return st->t;
	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
form_cond(Tsp st, Hash env, Val args)
{
	Val v, cond;
	for (v = args; !nilp(v); v = cdr(v))
		if (!(cond = tisp_eval(st, env, caar(v))))
			return NULL;
		else if (!nilp(cond)) /* TODO incorporate else directly into cond */
			return tisp_eval_seq(st, env, cdar(v));
	return st->none;
}

/* return type of tisp value */
static Val
prim_typeof(Tsp st, Hash env, Val args)
{
	tsp_arg_num(args, "typeof", 1);
	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);
	v = car(args), prop = cadr(args);
	tsp_arg_type(prop, "get", TSP_SYM);
	switch (v->t) {
	case TSP_FORM:
	case TSP_PRIM:
		if (!strncmp(prop->v.s, "name", 4))
			return mk_sym(st, v->v.pr.name);
		break;
	case TSP_FUNC:
	case TSP_MACRO:
		if (!strncmp(prop->v.s, "name", 4))
			return mk_sym(st, v->v.f.name ? v->v.f.name : "anon");
		if (!strncmp(prop->v.s, "body", 4))
			return v->v.f.body;
		if (!strncmp(prop->v.s, "args", 4))
			return v->v.f.args;
		break;
	case TSP_INT:
	case TSP_RATIO:
		if (!strncmp(prop->v.s, "numerator", 9))
			return mk_int(v->v.n.num);
		if (!strncmp(prop->v.s, "denominator", 9))
			return mk_int(v->v.n.den);
		break;
	case TSP_PAIR: /* TODO get nth element if number */
		if (!strncmp(prop->v.s, "car", 3))
			return v->v.p.car;
		if (!strncmp(prop->v.s, "cdr", 3))
			return v->v.p.cdr;
		break;
	case TSP_STR:
	case TSP_SYM:
		if (!strncmp(prop->v.s, "len", 3))
			return mk_int(strlen(v->v.s));
	default: break;
	}
	tsp_warnf("get: can not access %s from type %s",
		   prop->v.s, type_str(v->t));
}

/* creates new tisp function */
static Val
form_Func(Tsp st, Hash env, Val args)
{
	Val params, body;
	tsp_arg_min(args, "Func", 1);
	if (nilp(cdr(args))) { /* if only 1 argument is given, auto fill func parameters */
		params = mk_pair(mk_sym(st, "it"), st->nil);
		body = args;
	} else {
		params = car(args);
		body = cdr(args);
	}
	return mk_func(TSP_FUNC, NULL, params, body, env);
}

/* creates new tisp defined macro */
static Val
form_Macro(Tsp st, Hash env, Val args)
{
	tsp_arg_min(args, "Macro", 1);
	Val ret = form_Func(st, env, args);
	ret->t = TSP_MACRO;
	return ret;
}

/* creates new variable of given name and value
 * if pair is given as name of variable, creates function with the car as the
 * function name and the cdr the function arguments */
/* TODO if var not func error if more than 2 args */
static Val
form_def(Tsp st, Hash env, Val args)
{
	Val sym, val;
	tsp_arg_min(args, "def", 1);
	if (car(args)->t == TSP_PAIR) { /* create function if given argument list */
		sym = caar(args); /* first element of argument list is function name */
		if (sym->t != TSP_SYM)
			tsp_warnf("def: incorrect format,"
			          " expected symbol for function name, received %s",
			          type_str(sym->t));
		val = mk_func(TSP_FUNC, sym->v.s, cdar(args), cdr(args), env);
	} else if (car(args)->t == TSP_SYM) { /* create variable */
		sym = car(args); /* if only symbol given, make it self evaluating */
		val = nilp(cdr(args)) ? sym : tisp_eval(st, env, cadr(args));
	} else tsp_warn("def: incorrect format, no variable name found");
	if (!val)
		return NULL;
	/* set procedure name if it was previously anonymous */
	if (val->t & (TSP_FUNC|TSP_MACRO) && !val->v.f.name)
		val->v.f.name = sym->v.s;
	hash_add(env, sym->v.s, val);
	return st->none;
}

/* set symbol to new value */
static Val
form_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!", TSP_SYM);
	if (!(val = tisp_eval(st, env, cadr(args))))
		return NULL;
	/* find first occurrence of symbol */
	for (h = env; h; h = h->next) {
		e = entry_get(h, car(args)->v.s);
		if (e->key)
			break;
	}
	if (!e || !e->key)
		tsp_warnf("set!: variable %s is not defined", car(args)->v.s);
	if (e->val->t == TSP_PRIM) /* TODO hard code other values */
		tsp_warnf("set!: can not modify %s, is primitive procedure", e->val->v.pr.name);
	e->val = val;
	return val;
}

/* TODO fix crashing if try to undefine builtin */
static Val
form_undefine(Tsp st, Hash env, Val args)
{
	tsp_arg_min(args, "undefine!", 1);
	tsp_arg_type(car(args), "undefine!", TSP_SYM);
	for (Hash h = env; h; h = h->next) {
		Entry e = entry_get(h, car(args)->v.s);
		if (e->key) {
			e->key = NULL;
			/* TODO tsp_free(e->val); */
			return st->none;
		}
	}
	tsp_warnf("undefine!: could not find symbol %s to undefine", car(args)->v.s);
}

static Val
form_definedp(Tsp st, Hash env, Val args)
{
	Entry e = NULL;
	tsp_arg_min(args, "defined?", 1);
	tsp_arg_type(car(args), "defined?", TSP_SYM);
	for (Hash h = env; h; h = h->next) {
		e = entry_get(h, car(args)->v.s);
		if (e->key)
			break;
	}
	return (!e || !e->key) ? st->nil : st->t;
}

/* loads tisp file or C dynamic library */
/* TODO lua like error listing places load looked */
/* TODO only use dlopen if -ldl is given with TIB_DYNAMIC */
/* TODO define load in lisp which calls load-dl */
static Val
prim_load(Tsp st, Hash env, Val args)
{
	Val tib;
	void (*tibenv)(Tsp);
	char name[PATH_MAX];
	const char *paths[] = {
		"/usr/local/share/tisp/", "/usr/share/tisp/", "./", NULL
	};

	tsp_arg_num(args, "load", 1);
	tib = car(args);
	tsp_arg_type(tib, "load", TSP_STR);

	for (int i = 0; paths[i]; i++) {
		strcpy(name, paths[i]);
		strcat(name, tib->v.s);
		strcat(name, ".tsp");
		if (access(name, R_OK) != -1) {
			tisp_eval_seq(st, env, tisp_parse_file(st, name));
			return st->none;
		}
	}

	/* If not tisp file, try loading shared object library */
	st->libh = realloc(st->libh, (st->libhc+1)*sizeof(void*));
	if (!st->libh) perror("; realloc"), exit(1);

	memset(name, 0, sizeof(name));
	strcpy(name, "libtib");
	strcat(name, tib->v.s);
	strcat(name, ".so");
	if (!(st->libh[st->libhc] = dlopen(name, RTLD_LAZY)))
		tsp_warnf("load: could not load '%s':\n%s", tib->v.s, dlerror());
	dlerror();

	memset(name, 0, sizeof(name));
	strcpy(name, "tib_env_");
	strcat(name, tib->v.s);
	tibenv = dlsym(st->libh[st->libhc], name);
	if (dlerror())
		tsp_warnf("load: could not run '%s':\n%s", tib->v.s, dlerror());
	(*tibenv)(st);

	st->libhc++;
	return st->none;
}

/* display message and return error */
static Val
prim_error(Tsp st, Hash env, Val args)
{
	/* TODO have error auto print function name that was pre-defined */
	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;
}


/* environment */

/* add new variable of name key and value v to the given environment */
void
tisp_env_add(Tsp st, char *key, Val v)
{
	hash_add(st->global, key, v);
}

/* initialise tisp's state and global environment */
Tsp
tisp_env_init(size_t cap)
{
	Tsp st = malloc(sizeof(struct Tsp));
	if (!st) perror("; malloc"), exit(1);

	st->file = NULL;
	st->filec = 0;

	st->strs = hash_new(cap, NULL);
	st->syms = hash_new(cap, NULL);

	st->nil = mk_val(TSP_NIL);
	st->none = mk_val(TSP_NONE);
	st->t = mk_val(TSP_SYM);
	st->t->v.s = "True";

	st->global = hash_new(cap, NULL);
	tisp_env_add(st, "True", st->t);
	tisp_env_add(st, "Nil", st->nil);
	tisp_env_add(st, "Void", st->none);
	tisp_env_add(st, "bt", st->nil);
	tisp_env_add(st, "version", mk_str(st, "0.0.0"));
	tsp_env_prim(car);
	tsp_env_prim(cdr);
	tsp_env_prim(cons);
	tsp_env_form(quote);
	tsp_env_prim(eval);
	tsp_env_name_prim(=, eq);
	tsp_env_form(cond);
	tsp_env_prim(typeof);
	tsp_env_prim(get);
	tsp_env_form(Func);
	tsp_env_form(Macro);
	tsp_env_form(def);
	tsp_env_name_form(set!, set);
	tsp_env_prim(load);
	tsp_env_name_form(undefine!, undefine);
	tsp_env_name_form(defined?, definedp);
	tsp_env_prim(error);

	st->libh = NULL;
	st->libhc = 0;

	return st;
}

void
tisp_env_lib(Tsp st, char* lib)
{
	Val v;
	char *file = st->file;
	size_t filec = st->filec;
	st->file = lib;
	st->filec = 0;
	if ((v = tisp_read(st)))
		tisp_eval_seq(st, st->global, v);
	st->file = file;
	st->filec = filec;
}