#include "inc/priv.h"
#include "inc/cvalues.h"
#include "inc/read.h"
#include "inc/nan.h"
#include "inc/str.h"
#include "inc/table.h"
#include "inc/equal.h"
#include "tbl.h"

enum {
	TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM,
	TOK_BQ, TOK_COMMA, TOK_COMMAAT, TOK_COMMADOT,
	TOK_SHARPDOT, TOK_LABEL, TOK_BACKREF, TOK_SHARPQUOTE, TOK_SHARPOPEN,
	TOK_OPENB, TOK_CLOSEB, TOK_SHARPSYM, TOK_GENSYM, TOK_DOUBLEQUOTE,
	TOK_OPENC, TOK_CLOSEC, TOK_VERBATIM, TOK_MACROCHAR, TOK_TERM
};

static Tbl *name2rune;

const char *ascii2name[0x20+1] = {
	"nul", "soh", "stx", "etx", "eot", "enq", "ack", "bel",
	"backspace", "tab", "newline", "vt", "page", "return", "so", "si",
	"dle", "dc1", "dc2", "dc3", "dc4", "nak", "syn", "etb",
	"can", "em", "sub", "esc", "fs", "gs", "rs", "us",
	"space",
};

#define vec_grow_amt(x) ((x)<8 ? 5 : 6*((x)>>3))
#define sl_noexpr sl_unbound
#define PAtLoc "at %"PRIu32":%"PRIu32

static sl_v do_read_sexpr(sl_v label);

#define RS sl.rs
#define IO value2c(ios*, RS->io)

bool
sl_read_numtok(const char *tok, sl_v *pval, int base)
{
	char *end;
	s64int i64;
	double d;

	if(sl_unlikely(*tok == 0))
		return false;
	if(!((tok[0] == '0' && tok[1] == 'x') || (base >= 15)) && strpbrk(tok, ".eEpP") != nil){
		d = strtod(tok, &end);
		if(sl_unlikely(*end == 0)){
			if(pval != nil)
				*pval = mk_f64(d);
			return true;
		}
		// floats can end in f or f0
		if(end > tok && end[0] == 'f' &&
			(end[1] == 0 ||
			 (end[1] == '0' && end[2] == 0))){
			if(pval != nil)
				*pval = mk_f32((float)d);
			return true;
		}
	}

	if(sl_unlikely(*tok == '+' || *tok == '-')){
		if(!strcasecmp(tok+1, "nan.0")){
			if(pval != nil)
				*pval = mk_f64(*tok == '+' ? D_PNAN : D_NNAN);
			return true;
		}
		if(!strcasecmp(tok+1, "inf.0")){
			if(pval != nil)
				*pval = mk_f64(*tok == '+' ? D_PINF : D_NINF);
			return true;
		}
	}
	if(sl_unlikely(base == 32 && pval != nil))
		i64 = INT64_MAX;
	else{
		i64 = strtoll(tok, &end, base);
		if(*end != 0){
			Rune r;
			chartorune(&r, end);
			if(!isspacerune(r))
				return false;
		}
	}
	if(sl_unlikely(pval == nil))
		return true;
	if(sl_likely(fits_fixnum(i64))){
		*pval = fixnum(i64);
		return true;
	}
	mpint *m = strtomp(tok, &end, base, nil);
	if(m == nil)
		return false;
	if(*end != 0){
		Rune r;
		chartorune(&r, end);
		if(!isspacerune(r)){
			mpfree(m);
			return false;
		}
	}
	if(mpsignif(m) >= FIXNUM_BITS){
		*pval = mk_bignum(m);
		return true;
	}
	i64 = mptov(m);
	*pval = fixnum(i64);
	mpfree(m);
	return true;
}

static bool
terminator(void)
{
	// have to take all terminators into account
	for(sl_readstate *rs = RS; rs != nil; rs = rs->prev){
		if(rs->termlen > 0
		   && ios_readprep(IO, rs->termlen) >= (usize)rs->termlen
		   && memcmp(IO->buf+IO->bpos, rs->term, rs->termlen) == 0){
			RS->termrs = rs;
			return true;
		}
	}
	return false;
}

static Rune
nextrune(u32int *tok)
{
	Rune r;
	ios *f = IO;

	*tok = TOK_NONE;
	do{
		if(sl_unlikely(terminator())){
			*tok = TOK_TERM;
			return 0;
		}
		if(sl_unlikely(ios_getrune(f, &r) != 1))
			return 0;
		if(sl_unlikely(r == '\n' && RS->ws))
			return '\n';
	}while(r == ' ' || isspacerune(r));
	return r;
}

static void
take(void)
{
	RS->toktype = TOK_NONE;
}

static _Noreturn void sl_printfmt(1, 2)
sl_parse_error(const char *format, ...)
{
	char msgbuf[1024];
	va_list args;

	va_start(args, format);
	vsnprintf(msgbuf, sizeof(msgbuf), format, args);
	sl_v msg = str_from_cstr(msgbuf);
	va_end(args);
	RS->errloc = RS->loc;
	sl_raise(mk_list2(sl_errparse, msg));
}

sl_nonnull(2)
static void
accumrune(Rune c, int *pi)
{
	if(sl_unlikely(*pi >= (int)(sizeof(RS->buf)-UTFmax))){
		const int cut = *pi <= 63 ? *pi : 63;
		RS->buf[cut] = 0; // cut down to fit the whole message
		cthrow(parse_error("token too long: %s…", RS->buf), c);
	}
	*pi += runetochar(RS->buf + *pi, &c);
}

// return: true if escaped (forced to be symbol)
static bool
read_token(Rune c, bool digits)
{
	int i = 0, e, nc = 0;
	bool escaped = false, issym = false;

	while(1){
		if(nc != 0){
			if(sl_unlikely(nc != 1 && ios_getrune(IO, &c) != 1))
				goto terminate;
			if(sl_unlikely(terminator()))
				goto terminate;
			e = ios_peekrune(IO, &c);
			if(sl_unlikely(e != 1))
				goto terminate;
		}
		if(sl_unlikely(c == '|')){
			issym = true;
			escaped = !escaped;
		}else if(sl_unlikely(c == '\\')){
			issym = true;
			if(sl_unlikely(ios_getrune(IO, &c) != 1))
				goto terminate;
			e = ios_peekrune(IO, &c);
			if(sl_unlikely(e != 1))
				goto terminate;
			accumrune(c, &i);
		}else if(sl_unlikely(!escaped && !(symchar(c) && (!digits || isdigitrune(c))))){
			break;
		}else{
			accumrune(c, &i);
		}
		nc++;
	}
	if(sl_unlikely(nc == 0))
		cthrow(parse_error("unexpected char: #x%"PRIx32, c), c);
terminate:
	RS->buf[i++] = 0;
	return issym;
}

static u32int
peek(int dummy)
{
	u32int tok;
	Rune c;
	char *end;
	sl_fx x;
	int ch, base;

again:
	if(RS->toktype != TOK_NONE){
		RS->ws = false;
		return RS->toktype;
	}
	c = nextrune(&tok);
	RS->loc = IO->loc;
	if(c == 0 || sl_unlikely((IO->flags & IOS_FL_EOF) != 0 || isspacerune(c))){
		if(tok == TOK_TERM){
			if(RS->termrs != RS && RS->termlen > 0)
				cthrow(parse_error("terminator \"%s\" before \"%s\"", RS->termrs->term, RS->term), dummy);
			ios_read(IO, RS->buf, RS->termlen);
			IO->loc.colno += RS->termwidth;
		}
		RS->ws = false;
		return tok;
	}
	RS->loc0 = IO->loc;

	sl_v best = sl_nil;
	sl_htable *rt = totable(sl.readtable);
	Rune c2 = c;
	// FIXME(sigrid): any length should work
	for(int i = 0; i < 2; i++){
		sl_v v = (sl_v)equalhash_get(rt, (void*)mk_rune(c2));
		if(v == (sl_v)HT_NOTFOUND || !ishashtable(v) || (rt = totable(v))->live < 1)
			break;
		sl_v m = (sl_v)equalhash_get(rt, (void*)sl_nil);
		if(m != (sl_v)HT_NOTFOUND && m != sl_nil){
			if(!iscons(m))
				cthrow(type_error("reader macro", "cons", m), dummy);
			else
				best = m;
		}
		if(i > 0)
			ios_getrune(IO, &c);

		if(sl_unlikely(ios_peekrune(IO, &c2) != 1)) // nowhere to go
			break;
	}

	if(iscons(best)){
		RS->tokval = car_(best);
		RS->macro = cdr_(best);
		RS->toktype = TOK_MACROCHAR;
		RS->ws = false;
		return RS->toktype;
	}

	if(c == '(')
		RS->toktype = TOK_OPEN;
	else if(c == ')')
		RS->toktype = TOK_CLOSE;
	else if(c == '[')
		RS->toktype = TOK_OPENB;
	else if(c == ']')
		RS->toktype = TOK_CLOSEB;
	else if(c == '{')
		RS->toktype = TOK_OPENC;
	else if(c == '}')
		RS->toktype = TOK_CLOSEC;
	else if(c == '\'')
		RS->toktype = TOK_QUOTE;
	else if(c == '`')
		RS->toktype = TOK_BQ;
	else if(c == '"')
		RS->toktype = TOK_DOUBLEQUOTE;
	else if(sl_unlikely(c == 0xab)) // «
		RS->toktype = TOK_VERBATIM;
	else if(sl_unlikely(c == ';')){
		// single-line comment
		do{
			ch = ios_getc(IO);
		}while(ch != IOS_EOF && ch != '\n');
		goto again;
	}else if(c == '#'){
		if(terminator())
			cthrow(parse_error("unexpected terminator"), dummy);
		c = ch = ios_getc(IO);
		if(sl_unlikely(ch == IOS_EOF))
			cthrow(parse_error("invalid reader macro"), dummy);
		if(c == '.')
			RS->toktype = TOK_SHARPDOT;
		else if(c == '\'')
			RS->toktype = TOK_SHARPQUOTE;
		else if(c == '\\'){
			Rune cval;
			RS->tokval = sl_nil;
			if(terminator())
				cthrow(parse_error("unexpected terminator"), dummy);
			if(ios_getrune(IO, &cval) != 1)
				cthrow(parse_error("EOI in rune constant"), dummy);
			if((cval >= 'a' && cval <= 'z') || cval == 'U'){
				const char *k;
				read_token(cval, false);
				if(RS->buf[1] != 0){
					if(cval == 'u' || cval == 'U' || cval == 'x' || cval == 'X'){
						if(!sl_read_numtok(&RS->buf[1], &RS->tokval, 16))
							cthrow(parse_error("invalid hex rune constant: %s", &RS->buf[1]), dummy);
						RS->tokval = mk_rune(numval(RS->tokval));
					}else if(!Tgetkv(name2rune, RS->buf, strlen(RS->buf), &k, (void**)&RS->tokval)){
						cthrow(parse_error("unknown rune #\\%s", RS->buf), dummy);
					}
				}
			}
			RS->toktype = TOK_NUM;
			if(RS->tokval == sl_nil)
				RS->tokval = mk_rune(cval);
		}else if(c == '('){
			RS->toktype = TOK_SHARPOPEN;
		}else if(c == '<'){
			cthrow(parse_error("unreadable object"), dummy);
		}else if(isdigitrune(c)){
			read_token(c, true);
			if(terminator())
				cthrow(parse_error("unexpected terminator"), dummy);
			ch = ios_getc(IO);
			if(ch == '#')
				RS->toktype = TOK_BACKREF;
			else if(ch == '=')
				RS->toktype = TOK_LABEL;
			else if(ch == 'r' || ch == 'R'){
				if((base = atoi(RS->buf)) < 2 || base > 36)
					cthrow(parse_error("invalid radix specifier: #%s%c", RS->buf, ch), dummy);
				ch = ios_getc(IO);
				if(isdigit_base(ch, base) || ch == '-'){
					read_token(ch, false);
					if(sl_read_numtok(RS->buf, &RS->tokval, base)){
						RS->ws = false;
						return (RS->toktype = TOK_NUM);
					}
					cthrow(parse_error("invalid base %d constant: %s", base, RS->buf), dummy);
				}
				cthrow(parse_error("invalid base %d constant: %c…", base, ch), dummy);
			}else
				cthrow(parse_error( "invalid label: #%s%c", RS->buf, ch), dummy);
			x = strtoll(RS->buf, &end, 10);
			if(*end != 0)
				cthrow(parse_error("invalid label: #%s%c", RS->buf, ch), dummy);
			RS->tokval = fixnum(x);
		}else if(sl_unlikely(c == '!')){
			// #! single-line comment for shebang script support
			do{
				ch = ios_getc(IO);
			}while(ch != IOS_EOF && ch != '\n');
			goto again;
		}else if(sl_unlikely(c == '|')){
			// multiline comment
			int commentlevel = 1;
			while(1){
				ch = ios_getc(IO);
			hashpipe_gotc:
				if(ch == IOS_EOF)
					cthrow(parse_error("eof within comment"), dummy);
				if(ch == '|'){
					ch = ios_getc(IO);
					if(ch == '#'){
						if(--commentlevel == 0)
							break;
						continue;
					}
					goto hashpipe_gotc;
				}else if(ch == '#'){
					ch = ios_getc(IO);
					if(ch == '|')
						commentlevel++;
					else
						goto hashpipe_gotc;
				}
			}
			goto again;
		}else if(sl_unlikely(c == ';')){
			// datum comment
			(void)do_read_sexpr(sl_unbound); // skip
			goto again;
		}else if(sl_unlikely(c == ':')){
			// gensym
			if(terminator())
				cthrow(parse_error("unexpected terminator"), dummy);
			ch = ios_getc(IO);
			if(terminator())
				cthrow(parse_error("unexpected terminator"), dummy);
			if(ch == 'g' && isdigit(ios_peekc(IO)))
				ch = ios_getc(IO);
			read_token(ch, false);
			usize n = strlen(RS->buf);
			if(RS->buf[n-1] == '#')
				RS->tokval = mk_sym(RS->buf, true);
			else{
				x = strtol(RS->buf, &end, 10);
				if(*end != 0 || RS->buf[0] == 0)
					cthrow(parse_error("invalid gensym label: #%s", RS->buf), dummy);
				RS->tokval = fixnum(x);
			}
			RS->toktype = TOK_GENSYM;
		}else if(sl_likely(symchar(c))){
			read_token(ch, false);

			c = tolower(c);
			if(((c == 'b' && (base = 2)) ||
			    (c == 'o' && (base = 8)) ||
			    (c == 'd' && (base = 10)) ||
			    (c == 'x' && (base = 16))) && (isdigit_base(RS->buf[1], base) || RS->buf[1] == '-')){
				if(!sl_read_numtok(&RS->buf[1], &RS->tokval, base))
					cthrow(parse_error("invalid base %d constant: %s", base, &RS->buf[1]), dummy);
				RS->ws = false;
				return (RS->toktype = TOK_NUM);
			}

			RS->toktype = TOK_SHARPSYM;
			RS->tokval = mk_sym(RS->buf, true);
		}else{
			cthrow(parse_error("unknown reader macro"), dummy);
		}
	}else if(sl_unlikely(c == ',')){
		if(terminator())
			cthrow(parse_error("unexpected terminator"), dummy);
		RS->toktype = TOK_COMMA;
		ch = ios_peekc(IO);
		if(ch == IOS_EOF)
			return RS->toktype;
		if(ch == '@')
			RS->toktype = TOK_COMMAAT;
		else if(ch == '.')
			RS->toktype = TOK_COMMADOT;
		else{
			RS->ws = false;
			return RS->toktype;
		}
		ios_getc(IO);
	}else{
		bool ok = read_token(c, 0);
		const char *s = RS->buf;
		if(sl_likely(!ok)){
			if(s[0] == '.' && s[1] == 0){
				RS->ws = false;
				return (RS->toktype = TOK_DOT);
			}
			if(sl_unlikely(sl_read_numtok(s, &RS->tokval, 10))){
				RS->ws = false;
				return (RS->toktype = TOK_NUM);
			}
		}
		RS->toktype = TOK_SYM;
		if(sl_unlikely(s[0] == 'N' && s[1] == 'I' && s[2] == 'L' && s[3] == 0))
			RS->tokval = sl_nil;
		else if(sl_unlikely(s[1] == 0 && s[0] == 'T'))
			RS->tokval = sl_t;
		else{
			usize n = strlen(s);
			if(sl_unlikely(s[n-1] == '#')){
				if(n >= sizeof(RS->buf)-16)
					cthrow(parse_error("auto gensym name too long: %s", RS->buf), dummy);
				snprintf(RS->buf+n-1, sizeof(RS->buf)-n, "_auto%"PRIu32"#", RS->ags);
				RS->toktype = TOK_GENSYM;
			}
			RS->tokval = mk_sym(s, true);
		}
	}
	RS->ws = false;
	return RS->toktype;
}

// NOTE: this is NOT an efficient operation. it is only used by the
// reader, and requires at least 1 and up to 3 garbage collections!
static sl_v
vec_grow(sl_v v, bool rewrite_refs)
{
	usize i, s = vec_size(v);
	usize d = vec_grow_amt(s);
	PUSH_SAFE(v);
	assert(s+d > s);
	sl_v newv = alloc_vec(s+d, true);
	v = sl.sp[-1];
	for(i = 0; i < s; i++)
		vec_elt(newv, i) = vec_elt(v, i);
	// use gc to rewrite references from the old vector to the new
	sl.sp[-1] = newv;
	if(sl_unlikely(s > 0 && rewrite_refs)){
		ptr(usize, v)[0] |= VEC_GROWN;
		vec_elt(v, 0) = newv;
		sl_gc(false);
	}
	return POP();
}

static sl_v
read_vec(sl_v label, u32int closer)
{
	sl_v v = sl_emptyvec, elt;
	int i = 0;
	PUSH_SAFE(v);
	if(sl_unlikely(label != sl_unbound))
		ptrhash_put(&RS->backrefs, (void*)label, (void*)v);
	u32int t;
	while((t = peek(0)) != closer){
		if(t == TOK_TERM)
			cthrow(parse_error("unexpected terminator"), label);
		if(sl_unlikely((IO->flags & IOS_FL_EOF) != 0))
			cthrow(parse_error("unexpected EOI"), label);
		v = sl.sp[-1]; // reload after possible alloc in peek()
		if(i >= vec_size(v)){
			v = vec_grow(v, label != sl_unbound);
			sl.sp[-1] = v;
			assert(i < vec_size(v));
			if(sl_unlikely(label != sl_unbound))
				ptrhash_put(&RS->backrefs, (void*)label, (void*)v);
		}
		elt = do_read_sexpr(sl_unbound);
		if(elt != sl_noexpr){
			v = sl.sp[-1];
			vec_elt(v, i) = elt;
			i++;
		}
	}
	take();
	v = POP();
	if(i > 0)
		vec_setsize(v, i, vec_type(v));
	return v;
}

static sl_v
read_verbatim(int dummy)
{
	char *temp;
	usize i = 0, sz = sizeof(RS->buf);
	char *buf = RS->buf;

	while(1){
		if(sl_unlikely(i >= sz-UTFmax)){ // -UTFmax: leaves room for longest utf8 sequence
			sz *= 2;
			if(buf == RS->buf){
				if((temp = MEM_ALLOC(sz)) != nil)
					memcpy(temp, RS->buf, i);
			}else
				temp = MEM_REALLOC(buf, sz);
			if(temp == nil){
				if(buf == RS->buf)
					MEM_FREE(buf);
				cthrow(parse_error("out of memory reading verbatim string"), dummy);
			}
			buf = temp;
		}
		int c = ios_getc(IO);
		if(sl_unlikely(c == IOS_EOF)){
			if(buf != RS->buf)
				MEM_FREE(buf);
			cthrow(parse_error("unexpected EOI in verbatim string"), dummy);
		}
		if(sl_unlikely(c == 0xc2 && ios_peekc(IO) == 0xbb)){ // »
			ios_getc(IO);
			if(buf[i-1] != '\\')
				break;
			buf[i-1] = (char)0xc2;
			c = 0xbb;
		}
		buf[i++] = c;
	}
	sl_v s = cvalue_str(i);
	memcpy(cvalue_data(s), buf, i);
	if(sl_unlikely(buf != RS->buf))
		MEM_FREE(buf);
	return s;
}

static sl_v
read_str(int dummy)
{
	char *buf, *temp;
	char eseq[10];
	usize i = 0, j, sz, ndig;
	sl_v s;
	Rune r = 0;

	sz = sizeof(RS->buf);
	buf = RS->buf;
	while(1){
		if(sl_unlikely(i >= sz-UTFmax)){ // -UTFmax: leaves room for longest utf8 sequence
			sz *= 2;
			if(buf == RS->buf){
				if((temp = MEM_ALLOC(sz)) != nil)
					memcpy(temp, RS->buf, i);
			}else
				temp = MEM_REALLOC(buf, sz);
			if(temp == nil){
				if(buf != RS->buf)
					MEM_FREE(buf);
				cthrow(parse_error("out of memory reading string"), dummy);
			}
			buf = temp;
		}
		int c = ios_getc(IO);
		if(sl_unlikely(c == IOS_EOF)){
			if(buf != RS->buf)
				MEM_FREE(buf);
			cthrow(parse_error("unexpected EOI in string"), dummy);
		}
		if(sl_unlikely(c == '"'))
			break;
		if(c == '\\'){
			c = ios_getc(IO);
			if(c == IOS_EOF){
				if(buf != RS->buf)
					MEM_FREE(buf);
				cthrow(parse_error("EOI in escape sequence"), dummy);
			}
			j = 0;
			if(sl_unlikely(octal_digit(c))){
				while(1){
					eseq[j++] = c;
					c = ios_peekc(IO);
					if(c == IOS_EOF || !octal_digit(c) || j >= 3)
						break;
					ios_getc(IO);
				}
				eseq[j] = 0;
				r = strtol(eseq, nil, 8);
				// \DDD and \xXX read bytes, not runes
				buf[i++] = r;
			}else if((c == 'x' && (ndig = 2)) || (c == 'u' && (ndig = 4)) || (c == 'U' && (ndig = 8))){
				while(1){
					c = ios_peekc(IO);
					if(c == IOS_EOF || !hex_digit(c) || j >= ndig)
						break;
					eseq[j++] = c;
					ios_getc(IO);
				}
				eseq[j] = 0;
				if(j)
					r = strtol(eseq, nil, 16);
				if(!j || r > Runemax){
					if(buf != RS->buf)
						MEM_FREE(buf);
					cthrow(parse_error("invalid escape sequence"), dummy);
				}
				if(ndig == 2)
					buf[i++] = r;
				else
					i += runetochar(&buf[i], &r);
			}else if(c == '\n'){
				/* do nothing */
			}else{
				char esc = read_escape_control_char(c);
				if(sl_unlikely(esc == c && !strchr("\\'\"`", esc))){
					if(buf != RS->buf)
						MEM_FREE(buf);
					cthrow(parse_error("invalid escape sequence: \\%c", c), dummy);
				}
				buf[i++] = esc;
			}
		}else{
			buf[i++] = c;
		}
	}
	s = cvalue_str(i);
	memcpy(cvalue_data(s), buf, i);
	if(sl_unlikely(buf != RS->buf))
		MEM_FREE(buf);
	return s;
}

// build a list of conses. this is complicated by the fact that all conses
// can move whenever a new cons is allocated. we have to refer to every cons
// through a handle to a relocatable pointer (i.e. a pointer on the stack).
static void
read_list(sl_v label, u32int closer)
{
	const usize pval = sl.sp-sl.stack-1;
	const usize pc = pval+1; // to keep track of current cons cell
	const usize pnewc = pval+2;
	const usize pprevc = pval+3;
	ios_loc loc0 = IO->loc;
	loc0.colno--;
	PUSH_SAFE(sl_nil);
	PUSH_SAFE(sl_nil);
	PUSH_SAFE(sl_noexpr);
	sl_v c = sl_nil, e, prevc;
	bool allocnew = true;

	u32int t = peek(0);

	while(t != closer){
		if(sl_unlikely((IO->flags & IOS_FL_EOF) != 0)){
			cthrow(
				parse_error(
					"not closed: unexpected EOI: opened with '%c' "PAtLoc,
					closer == TOK_CLOSE ? '(' : (closer == TOK_CLOSEB ? '[' : '{'),
					loc0.lineno,
					loc0.colno
				),
				label
			);
		}
		if(allocnew){
			c = alloc_cons();
			car_(c) = cdr_(c) = sl_nil;
			sl.stack[pnewc] = c;
		}
		bool next = iscons(sl.stack[pc]);
		if(!next && label != sl_unbound)
			ptrhash_put(&RS->backrefs, (void*)label, (void*)c);
		if((e = do_read_sexpr(sl_unbound)) == sl_noexpr){
			allocnew = false;
			prevc = sl.stack[pprevc];
			if(!next && label != sl_unbound){
				if(prevc == sl_noexpr)
					ptrhash_remove(&RS->backrefs, (void*)label);
				else
					ptrhash_put(&RS->backrefs, (void*)label, (void*)prevc);
			}
		}else{
			allocnew = true;
			c = sl.stack[pnewc];
			sl.stack[pprevc] = c;
			if(next)
				cdr_(sl.stack[pc]) = c;
			else
				sl.stack[pval] = c;
			sl.stack[pc] = c;
			car_(sl.stack[pc]) = e;
		}

		t = peek(0);
		if(t == TOK_DOT){
			take();
			do{
				c = do_read_sexpr(sl_unbound);
			}while(c == sl_noexpr);
			cdr_(sl.stack[pc]) = c;
			t = peek(0);
			if(sl_unlikely(t == TOK_TERM))
				cthrow(parse_error("unexpected terminator"), label);
			if(sl_unlikely((IO->flags & IOS_FL_EOF) != 0))
				cthrow(parse_error("unexpected EOI"), label);
			if(sl_unlikely(t != closer)){
				take();
				cthrow(
					parse_error(
						"expected '%c': opened "PAtLoc,
						closer == TOK_CLOSEB ? ']' : (closer == TOK_CLOSEC ? '}' : ')'),
						loc0.lineno,
						loc0.colno
					),
					label
				);
			}
		}
	}
	take();
	POPN(3);
}

static sl_v
do_read_list(sl_v label, u32int closer)
{
	PUSH_SAFE(sl_nil);
	read_list(label, closer);
	return POP();
}

// label is the backreference we'd like to fix up with this read
static sl_v
do_read_sexpr(sl_v label)
{
	sl_v v, sym, oldtokval, *head, *pv;
	ios_loc loc0;
	u32int t;
	Rune c;

	t = peek(0);
	take();
	switch(t){
	case TOK_OPEN:
	case TOK_OPENB:
	case TOK_OPENC:
		return do_read_list(label, TOK_CLOSE-TOK_OPEN+t);
	case TOK_SYM:
	case TOK_NUM:
		return RS->tokval;
	case TOK_COMMA:
		head = &sl_comma; goto listwith;
	case TOK_COMMAAT:
		head = &sl_commaat; goto listwith;
	case TOK_COMMADOT:
		head = &sl_commadot; goto listwith;
	case TOK_SHARPQUOTE:
		// StreetLISP will force this to be a function
		head = &sl_fnsym; goto listwith;
	case TOK_BQ:
		head = &sl_backquote;
		RS->bq++;
		sl.ags++;
		goto listwith;
	case TOK_QUOTE:
		head = &sl_quote;
	listwith:
		v = cons_reserve(2);
		car_(v) = *head;
		cdr_(v) = tagptr(ptr(sl_cons, v)+1, TAG_CONS);
		car_(cdr_(v)) = cdr_(cdr_(v)) = sl_nil;
		PUSH_SAFE(v);
		if(label != sl_unbound)
			ptrhash_put(&RS->backrefs, (void*)label, (void*)v);
		t = RS->ags;
		RS->ags = sl.ags;
		v = do_read_sexpr(sl_unbound);
		RS->ags = t;
		car_(cdr_(sl.sp[-1])) = v;
		if(RS->bq > 0 && head == &sl_backquote)
			RS->bq--;
		return POP();
	case TOK_SHARPSYM:
		loc0 = RS->loc0;
		sym = RS->tokval;
		// constructor notation
		c = nextrune(&t);
		RS->loc = IO->loc;
		if(c != '(' && c != '[' && c != '{'){
			take();
			cthrow(parse_error("expected argument list for %s", sym_name(RS->tokval)), label);
		}
		PUSH_SAFE(sl_nil);
		read_list(sl_unbound, c == '(' ? TOK_CLOSE : (c == '[' ? TOK_CLOSEB : TOK_CLOSEC));
		if(sym == sl_vu8sym){
			sym = sl_arrsym;
			v = mk_cons(sl_u8sym, sl.sp[-1]);
			sl.sp[-1] = v;
		}
		v = sym_value(sym);
		RS->errloc = loc0;
		if(v == sl_unbound)
			cthrow(unbound_error(sym), label);
		return sl_apply(v, POP());
	case TOK_SHARPOPEN:
		return read_vec(label, TOK_CLOSE);
	case TOK_SHARPDOT:
		// eval-when-read
		// evaluated expressions can refer to existing backreferences, but they
		// cannot see pending labels. in other words:
		// (... #2=#.#0# ... )	OK
		// (... #2=#.(#2#) ... )  DO NOT WANT
		loc0 = RS->loc;
		sym = do_read_sexpr(sl_unbound);
		if(issym(sym)){
			v = sym_value(sym);
			if(v == sl_unbound){
				RS->errloc = loc0;
				cthrow(unbound_error(sym), label);
			}
			return v;
		}
		RS->errloc = loc0;
		return sl_toplevel_eval(sym);
	case TOK_LABEL:
		// create backreference label
		if(ptrhash_has(&RS->backrefs, (void*)RS->tokval))
			cthrow(parse_error("label %"PRIdPTR" redefined", (intptr)numval(RS->tokval)), label);
		oldtokval = RS->tokval;
		v = do_read_sexpr(RS->tokval);
		ptrhash_put(&RS->backrefs, (void*)oldtokval, (void*)v);
		return v;
	case TOK_BACKREF:
		// look up backreference
		v = (sl_v)ptrhash_get(&RS->backrefs, (void*)RS->tokval);
		if(v == (sl_v)HT_NOTFOUND)
			cthrow(parse_error("undefined label %"PRIdPTR, (intptr)numval(RS->tokval)), label);
		return v;
	case TOK_GENSYM:
		if(isfixnum(RS->tokval)){
			pv = (sl_v*)ptrhash_bp(&RS->gensyms, (void*)RS->tokval);
			if(*pv == (sl_v)HT_NOTFOUND)
				*pv = mk_gensym();
		}else{
			sl_sym *gs = ptr(sl_sym, RS->tokval);
			gs->flags = FLAG_GENSYM;
			if(gs->binding == sl_unbound){
				gs->binding = mk_gensym();
				sl_sym *b = ptr(sl_sym, gs->binding);
				b->name = gs->name;
			}
			return gs->binding;
		}
		return *pv;
	case TOK_DOUBLEQUOTE:
		return read_str(0);
	case TOK_VERBATIM:
		return read_verbatim(0);
	case TOK_MACROCHAR:
		v = sl_applyn(2, RS->macro, RS->io, RS->tokval);
		return v == sl_void ? sl_noexpr : v;
	case TOK_CLOSE:
		cthrow(parse_error("unexpected ')'"), label);
	case TOK_CLOSEB:
		cthrow(parse_error("unexpected ']'"), label);
	case TOK_CLOSEC:
		cthrow(parse_error("unexpected '}'"), label);
	case TOK_DOT:
		cthrow(parse_error("unexpected '.'"), label);
	case TOK_TERM:
		cthrow(parse_error("unexpected terminator"), label);
	}
	return sl_void;
}

sl_v
sl_read_sexpr(sl_v f, sl_v term, sl_expr_kind kind, bool ws)
{
	sl_readstate rs;

	rs.prev = RS;
	rs.toktype = TOK_NONE;
	rs.tokval = sl_nil;
	rs.macro = sl_nil;
	rs.ws = ws;
	rs.bq = 0;
	rs.ags = sl.ags+1;
	rs.io = f;

	if(sl_unlikely(sl_isrune(term))){
		Rune r = torune(term);
		rs.termlen = runetochar(rs.term, &r);
		// FIXME(sigrid): valid vs invalid terminators
		if(sl_unlikely(rs.termlen < 1 || r == Runeerror))
			cthrow(error(sl_errarg, "invalid terminator"), f);
		rs.termwidth = sl_wcwidth(r);
	}else if(sl_unlikely(term != sl_nil)){
		const char *s = tostr(term);
		rs.termlen = cvalue_len(term);
		// FIXME(sigrid): valid vs invalid terminators
		if(sl_unlikely(rs.termlen >= (int)sizeof(rs.term)))
			cthrow(error(sl_errarg, "terminator too long"), f);
		strcpy(rs.term, s);
		bool err;
		rs.termwidth = u8_strwidth(rs.term, rs.termlen, &err);
		if(sl_unlikely(err || rs.termlen < 1))
			cthrow(error(sl_errarg, "invalid terminator"), f);
	}else{
		rs.termlen = 0;
	}
	htable_new(&rs.backrefs, HT_N_INLINE);
	htable_new(&rs.gensyms, HT_N_INLINE);

	RS = &rs;

	sl_v v;
	do{
		switch(kind){
		case SL_EXPR_S:
			v = do_read_sexpr(sl_unbound);
			break;
		case SL_EXPR_LIST:
			v = do_read_list(sl_unbound, TOK_TERM);
			break;
		default:
			abort();
		}
	}while(v == sl_noexpr);

	RS = rs.prev;
	free_readstate(&rs);

	return v;
}

#define mk_name2rune(r, s) mk_rune2name_(r, s, strlen(s))

sl_nonnull(2)
sl_rd(2, 3)
static Rune
mk_rune2name_(Rune r, const char *str, int len)
{
	name2rune = Tsetl(name2rune, str, len, (void*)mk_rune(r));
	return r;
}

void
sl_read_init(void)
{
	sl.readtable = cvalue_nofinalizer(sl_tabletype, sizeof(sl_htable));
	sl_htable *h = cvalue_data(sl.readtable);
	htable_new(h, HT_N_INLINE);
	set(mk_csym("*read-table*"), sl.readtable);

	for(Rune r = 0; r < nelem(ascii2name); r++)
		mk_name2rune(r, ascii2name[r]);

	mk_name2rune(0x00, "null");
	mk_name2rune(0x08, "bs");
	mk_name2rune(mk_name2rune(0x0a, "nl"), "linefeed");
	mk_name2rune(0x0b, "vtab");
	mk_name2rune(0x0c, "ff");
	mk_name2rune(0x0d, "cr");
	mk_name2rune(0x1b, "escape");
	mk_name2rune(0x20, "sp");
	mk_name2rune(mk_name2rune(0x7f, "delete"), "del");
}