#include "sl.h"#include "cvalues.h"#include "read.h"#include "nan.h"#include "str.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,}; 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 PAtLoc "at %"PRIu32":%"PRIu32 typedef struct Rctx Rctx; struct Rctx {	sl_v tokval;	sl_v *source;	ios_loc loc0;	ios_loc loc;	u32int toktype;	bool ws;	char buf[1024];}; static sl_v do_read_sexpr(Rctx *ctx, sl_v label); #define RS value2c(ios*, sl.readstate->source) 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)				*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)				*pval = mk_f32((float)d);			return true;		}	} 	if(sl_unlikely(*tok == '+' || *tok == '-')){		if(!strcasecmp(tok+1, "nan.0")){			if(pval)				*pval = mk_f64(*tok == '+' ? D_PNAN : D_NNAN);			return true;		}		if(!strcasecmp(tok+1, "inf.0")){			if(pval)				*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')			return false;	}	if(pval == nil)		return true;	if(fits_fixnum(i64)){		*pval = fixnum(i64);		return true;	}	mpint *m = strtomp(tok, &end, base, nil);	if(m == nil)		return false;	if(end != tok+strlen(tok)){		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 charnextchar(Rctx *ctx){	int c;	ios *f = RS; 	do{		c = ios_getc(RS);		if(c == IOS_EOF)			return 0;		if(c == ';'){			// single-line comment			do{				c = ios_getc(f);				if(c == IOS_EOF)					return 0;			}while(c != '\n');		}		if(c == '\n' && ctx->ws)			return '\n';	}while(c == ' ' || isspace(c));	return c;} static voidtake(Rctx *ctx){	ctx->toktype = TOK_NONE;} static _Noreturn void sl_printfmt(2, 3)parse_error(Rctx *ctx, 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);	sl.readstate->errloc = ctx->loc;	sl_raise(mk_list2(sl_errparse, msg));} static voidaccumchar(Rctx *ctx, char c, int *pi){	ctx->buf[(*pi)++] = c;	if(*pi >= (int)(sizeof(ctx->buf)-1)){		ctx->buf[sizeof(ctx->buf)-64] = 0; // cut down to fit the whole message		parse_error(ctx, "token too long: %s…", ctx->buf);	}} // return: 1 if escaped (forced to be symbol)static boolread_token(Rctx *ctx, char c, bool digits){	int i = 0, ch, nc = 0;	bool escaped = false, issym = false; 	while(1){		if(nc != 0){			if(nc != 1)				ios_getc(RS);			ch = ios_peekc(RS);			if(ch == IOS_EOF)				goto terminate;			c = ch;		}		if(c == '|'){			issym = true;			escaped = !escaped;		}else if(c == '\\'){			issym = true;			ios_getc(RS);			ch = ios_peekc(RS);			if(ch == IOS_EOF)				goto terminate;			accumchar(ctx, ch, &i);		}else if(!escaped && !(symchar(c) && (!digits || isdigit(c)))){			break;		}else{			accumchar(ctx, c, &i);		}		nc++;	}	if(nc == 0)		parse_error(ctx, "unexpected char: 0x%x", c);terminate:	ctx->buf[i++] = '\0';	return issym;} static u32intpeek(Rctx *ctx){	u8int c;	char *end;	sl_fx x;	int ch, base; 	if(ctx->toktype != TOK_NONE){		ctx->ws = false;		return ctx->toktype;	}	c = nextchar(ctx);	ctx->loc = RS->loc;	if(ios_eof(RS) || isspace(c)){		ctx->ws = false;		return TOK_NONE;	}	ctx->loc0 = RS->loc;	if(c == '(')		ctx->toktype = TOK_OPEN;	else if(c == ')')		ctx->toktype = TOK_CLOSE;	else if(c == '[')		ctx->toktype = TOK_OPENB;	else if(c == ']')		ctx->toktype = TOK_CLOSEB;	else if(c == '{')		ctx->toktype = TOK_OPENC;	else if(c == '}')		ctx->toktype = TOK_CLOSEC;	else if(c == '\'')		ctx->toktype = TOK_QUOTE;	else if(c == '`')		ctx->toktype = TOK_BQ;	else if(c == '"')		ctx->toktype = TOK_DOUBLEQUOTE;	else if(c == 0xc2 && ios_peekc(RS) == 0xab){ // «		ctx->toktype = TOK_VERBATIM;		ios_getc(RS);	}else if(c == '#'){		c = ch = ios_getc(RS);		if(ch == IOS_EOF)			parse_error(ctx, "invalid read macro");		if(c == '.')			ctx->toktype = TOK_SHARPDOT;		else if(c == '\'')			ctx->toktype = TOK_SHARPQUOTE;		else if(c == '\\'){			Rune cval;			ctx->tokval = sl_nil;			if(ios_getrune(RS, &cval) == IOS_EOF)				parse_error(ctx, "EOI in rune constant");			if((cval >= 'a' && cval <= 'z') || cval == 'U'){				const char *k;				read_token(ctx, cval, false);				if(ctx->buf[1] != 0){					if(cval == 'u' || cval == 'U' || cval == 'x' || cval == 'X'){						if(!sl_read_numtok(&ctx->buf[1], &ctx->tokval, 16))							parse_error(ctx, "invalid hex rune constant: %s", &ctx->buf[1]);						ctx->tokval = mk_rune(numval(ctx->tokval));					}else if(!Tgetkv(name2rune, ctx->buf, strlen(ctx->buf), &k, (void**)&ctx->tokval)){						parse_error(ctx, "unknown rune #\\%s", ctx->buf);					}				}			}			ctx->toktype = TOK_NUM;			if(ctx->tokval == sl_nil)				ctx->tokval = mk_rune(cval);		}else if(c == '('){			ctx->toktype = TOK_SHARPOPEN;		}else if(c == '<'){			parse_error(ctx, "unreadable object");		}else if(isdigit(c)){			read_token(ctx, c, true);			c = ios_getc(RS);			if(c == '#')				ctx->toktype = TOK_BACKREF;			else if(c == '=')				ctx->toktype = TOK_LABEL;			else if(c == 'r' || c == 'R'){				if((base = atoi(ctx->buf)) < 2 || base > 36)					parse_error(ctx, "invalid radix specifier: #%s%c", ctx->buf, c);				c = ios_getc(RS);				if(isdigit_base(c, base) || c == '-'){					read_token(ctx, c, false);					if(sl_read_numtok(ctx->buf, &ctx->tokval, base)){						ctx->ws = false;						return (ctx->toktype = TOK_NUM);					}					parse_error(ctx, "invalid base %d constant: %s", base, ctx->buf);				}				parse_error(ctx, "invalid base %d constant: %c…", base, c);			}else				parse_error(ctx, "invalid label: #%s%c", ctx->buf, c);			x = strtoll(ctx->buf, &end, 10);			if(*end != '\0')				parse_error(ctx, "invalid label: #%s%c", ctx->buf, c);			ctx->tokval = fixnum(x);		}else if(c == '!'){			// #! single line comment for shbang script support			do{				ch = ios_getc(RS);			}while(ch != IOS_EOF && ch != '\n');			return peek(ctx);		}else if(c == '|'){			// multiline comment			int commentlevel = 1;			while(1){				ch = ios_getc(RS);			hashpipe_gotc:				if(ch == IOS_EOF)					parse_error(ctx, "eof within comment");				if(ch == '|'){					ch = ios_getc(RS);					if(ch == '#'){						commentlevel--;						if(commentlevel == 0)							break;						else							continue;					}					goto hashpipe_gotc;				}else if(ch == '#'){					ch = ios_getc(RS);					if(ch == '|')						commentlevel++;					else						goto hashpipe_gotc;				}			}			return peek(ctx);		}else if(c == ';'){			// datum comment			(void)do_read_sexpr(ctx, sl_unbound); // skip			return peek(ctx);		}else if(c == ':'){			// gensym			ch = ios_getc(RS);			if(ch == 'g' && isdigit(ios_peekc(RS)))				ch = ios_getc(RS);			read_token(ctx, ch, false);			if(ctx->buf[strlen(ctx->buf)-1] == '#')				ctx->tokval = mk_sym(ctx->buf, true);			else{				x = strtol(ctx->buf, &end, 10);				if(*end != '\0' || ctx->buf[0] == '\0')					parse_error(ctx, "invalid gensym label: #%s", ctx->buf);				ctx->tokval = fixnum(x);			}			ctx->toktype = TOK_GENSYM;		}else if(symchar(c)){			read_token(ctx, ch, false); 			c = tolower(c);			if(((c == 'b' && (base = 2)) ||			    (c == 'o' && (base = 8)) ||			    (c == 'd' && (base = 10)) ||			    (c == 'x' && (base = 16))) && (isdigit_base(ctx->buf[1], base) || ctx->buf[1] == '-')){				if(!sl_read_numtok(&ctx->buf[1], &ctx->tokval, base))					parse_error(ctx, "invalid base %d constant: %s", base, &ctx->buf[1]);				ctx->ws = false;				return (ctx->toktype = TOK_NUM);			} 			ctx->toktype = TOK_SHARPSYM;			ctx->tokval = mk_sym(ctx->buf, true);		}else{			parse_error(ctx, "unknown read macro");		}	}else if(c == ','){		ctx->toktype = TOK_COMMA;		ch = ios_peekc(RS);		if(ch == IOS_EOF)			return ctx->toktype;		if(ch == '@')			ctx->toktype = TOK_COMMAAT;		else if(ch == '.')			ctx->toktype = TOK_COMMADOT;		else{			ctx->ws = false;			return ctx->toktype;		}		ios_getc(RS);	}else{		bool ok = read_token(ctx, c, 0);		const char *s = ctx->buf;		if(!ok){			if(s[0] == '.' && s[1] == 0){				ctx->ws = false;				return (ctx->toktype = TOK_DOT);			}			if(sl_read_numtok(s, &ctx->tokval, 10)){				ctx->ws = false;				return (ctx->toktype = TOK_NUM);			}		}		ctx->toktype = TOK_SYM;		if(s[0] == 'N' && s[1] == 'I' && s[2] == 'L' && s[3] == 0)			ctx->tokval = sl_nil;		else if(s[1] == 0 && s[0] == 'T')			ctx->tokval = sl_t;		else{			ctx->tokval = mk_sym(s, true);			if(s[strlen(s)-1] == '#')				ctx->toktype = TOK_GENSYM;		}	}	ctx->ws = false;	return ctx->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);	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(s > 0 && rewrite_refs){		((usize*)ptr(v))[0] |= VEC_GROWN;		vec_elt(v, 0) = newv;		sl_gc(false);	}	return POP();} static sl_vread_vec(Rctx *ctx, sl_v label, u32int closer){	sl_v v = sl_emptyvec, elt;	int i = 0;	PUSH_SAFE(v);	if(label != sl_unbound)		ptrhash_put(&sl.readstate->backrefs, (void*)label, (void*)v);	while(peek(ctx) != closer){		if(ios_eof(RS))			parse_error(ctx, "unexpected EOI");		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;			if(label != sl_unbound)				ptrhash_put(&sl.readstate->backrefs, (void*)label, (void*)v);		}		elt = do_read_sexpr(ctx, sl_unbound);		v = sl.sp[-1];		assert(i < vec_size(v));		vec_elt(v, i) = elt;		i++;	}	take(ctx);	if(i > 0)		vec_setsize(v, i, VEC_VEC);	return POP();} static sl_vread_verbatim(Rctx *ctx){	char *temp;	usize i = 0, sz = sizeof(ctx->buf);	char *buf = ctx->buf; 	while(1){		if(i >= sz-UTFmax){ // -UTFmax: leaves room for longest utf8 sequence			sz *= 2;			if(buf == ctx->buf){				if((temp = MEM_ALLOC(sz)) != nil)					memcpy(temp, ctx->buf, i);			}else				temp = MEM_REALLOC(buf, sz);			if(temp == nil){				if(buf == ctx->buf)					MEM_FREE(buf);				parse_error(ctx, "out of memory reading verbatim string");			}			buf = temp;		}		int c = ios_getc(RS);		if(c == IOS_EOF){			if(buf != ctx->buf)				MEM_FREE(buf);			parse_error(ctx, "unexpected EOI in verbatim string");		}		if(c == 0xc2 && ios_peekc(RS) == 0xbb){ // »			ios_getc(RS);			if(buf[i-1] != '\\')

Lines 1–500 of 859. Load more