#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) boolsl_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 boolterminator(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 Runenextrune(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 voidtake(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 voidaccumrune(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 boolread_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 u32intpeek(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_vvec_grow(sl_v v, bool rewrite_refs){	usize i, s = vec_size(v);	usize d = vec_grow_amt(s);

Lines 1–500 of 1027. Load more