shithub: lpa

Info  •  Files  •  Log  •  Branches

Work on parsing and evaluation

--- a/array.c

+++ b/array.c

@@ -226,6 +226,11 @@

 	char buf[2048]; /* TODO: fixed size :) */

 	char *p = buf;

+	if(f->ast == nil){

+		sprint(p, "%s", primsymb(f->prim));

+		return buf;

+	}

+	

 	p += sprint(p, "∇");

 	if(f->ast->funcresult)

 		p += sprint(p, "%s←", f->ast->funcresult->name);

--- a/dat.h

+++ b/dat.h

@@ -161,6 +161,7 @@

 	AstName,

 	AstLocals,

 	AstAssign,

+	AstNiladic,

 	AstMonadic,

 	AstDyadic,

 	AstConst,

@@ -217,14 +218,15 @@

 	IPushPrim,

 	ILookup,

 	IStrand,

+	INiladic,

 	IMonadic,

 	IDyadic,

-	IClear,

 	IParse,

-	IDone,

 	IReturn,

 	IAssign,

 	ILocal,

+	IPop,

+	IDisplay,

 };

 typedef struct ValueStack ValueStack;

@@ -268,8 +270,10 @@

 enum Valence

 {

-	Monadic = 1<<1,

-	Dyadic = 1<<2,

+	Niladic = 1,

+	Monadic = 2,

+	Dyadic = 4,

+	Variadic = 6,

 };

 typedef struct Function Function;

@@ -289,6 +293,8 @@

 	EAny, /* 0 = catch any error */

 	ESyntax,

 	EValue,

+	EInternal,

+	EDomain,

 	ErrorMax,

 };

--- a/error.c

+++ b/error.c

@@ -64,6 +64,8 @@

 	switch(c->num){

 	case ESyntax:	return "SYNTAX ERROR";

 	case EValue:	return "VALUE ERROR";

+	case EInternal:	return "INTERNAL ERROR";

+	case EDomain:	return "DOMAIN ERROR";

 	default:	return "ERROR ???";

 	}

 }

--- a/eval.c

+++ b/eval.c

@@ -50,6 +50,7 @@

 	if(assign){

 		emitbyte(c, IAssign);

 		emituvlong(c, id);

+		emitbyte(c, IPop);

 	}

 }

@@ -56,17 +57,15 @@

 static void

 codegensub(Session *s, Module *m, ByteCode *c, Ast *a)

 {

-	char *err;

 	uvlong i;

 	switch(a->tag){

 	case AstProg:

 		for(i = 0; i < a->childcount; i++){

-			if(i != 0)

-				emitbyte(c, IClear);

 			codegensub(s, m, c, a->children[i]);

+			emitbyte(c, IPop);

+			emitbyte(c, IDisplay);

 		}

-		emitbyte(c, IDone);

 		break;

 	case AstFunc:

 		/* Emit bytecode for the function body */

@@ -77,6 +76,10 @@

 				fn->valence = Dyadic;

 			else if(fn->ast->funcrightarg)

 				fn->valence = Monadic;

+			else

+				fn->valence = Niladic;

+			if(fn->ast->funcresult)

+				fn->hasresult = 1;

 			fn->symbol = sym(m->symtab, a->funcname->name);

 			fn->code = alloc(DataByteCode);

@@ -90,7 +93,7 @@

 				emitlocal(fn->code, m->symtab, fn->ast->funclocals->children[i], 0);

 			for(i = 0; i < a->childcount; i++){

 				codegensub(s, m, fn->code, a->children[i]);

-				emitbyte(fn->code, IClear);

+				emitbyte(fn->code, IPop);

 			}

 			if(fn->ast->funcresult)

 				codegensub(s, m, fn->code, fn->ast->funcresult);

@@ -99,10 +102,6 @@

 			emitbyte(c, IPushConst);

 			emitptr(c, fn);

-			/* push the value twice so defining a function yields a function value.. */

-			emitbyte(c, IPushConst);

-			emitptr(c, fn);

-

 			emitbyte(c, IAssign);

 			emituvlong(c, fn->symbol);

 		}

@@ -127,6 +126,10 @@

 		emitbyte(c, IStrand);

 		emituvlong(c, a->childcount);

 		break;

+	case AstNiladic:

+		codegensub(s, m, c, a->func);

+		emitbyte(c, INiladic);

+		break;

 	case AstMonadic:

 		codegensub(s, m, c, a->right);

 		codegensub(s, m, c, a->func);

@@ -147,9 +150,7 @@

 		emitptr(c, a->tokens);

 		break;

 	default:

-		err = smprint("Don't know how to do codegen for ast type %d\n", a->tag);

-		appendlog(s, err);

-		free(err);

+		error(EInternal, "Don't know how to do codegen for ast type %d", a->tag);

 		break;

 	}

@@ -175,11 +176,19 @@

 popval(ValueStack *s)

 {

 	if(s->count == 0)

-		sysfatal("popval on empty value stack");

+		error(EInternal, "popval on empty value stack");

 	s->count--; /* no realloc */

 	return s->values[s->count];

 }

+static void *

+peekval(ValueStack *s)

+{

+	if(s->count == 0)

+		error(EInternal, "peekval on empty value stack");

+	return s->values[s->count-1];

+}

+

 static void

 pushcall(CallStack *s, ByteCode *newcode, ByteCode **c, uvlong *o)

 {

@@ -197,7 +206,7 @@

 popcall(CallStack *s, Symtab *t, ByteCode **c, uvlong *o)

 {

 	if(s->count == 0)

-		sysfatal("popcall on empty call stack");

+		error(EInternal, "popcall on empty call stack");

 	s->count--; /* no realloc */

 	*c = s->frames[s->count].code;

 	*o = s->frames[s->count].offset;

@@ -220,6 +229,26 @@

 	symset(s, id, nil);

 }

+static int

+nextinstr(CallStack *calls, ByteCode *c, uvlong o)

+{

+	if(o < c->count && c->instrs[o] != IReturn)

+		return c->instrs[o];

+	if(calls->count == 0)

+		return -1;

+	else{

+		CallFrame f = calls->frames[calls->count-1];

+		return f.code->instrs[f.offset];

+	}

+}

+

+static void

+checkarray(void *val)

+{

+	if(val == nil || getalloctag(val) != DataArray)

+		error(EDomain, "non-array value where an array was expected");

+}

+

 static void *

 evalbc(Session *s, Module *m, ByteCode *c)

 {

@@ -230,12 +259,11 @@

 	uvlong o, v;

 	Function *func;

 	void *r;

+	Array *x, *y, *z;

 	values = alloc(DataValueStack);

 	calls = alloc(DataCallStack);

-	debugbc(c);

-

 	o = 0;

 	while(o < c->count){

 		int instr = c->instrs[o];

@@ -252,6 +280,7 @@

 				Function *f = alloc(DataFunction);

 				f->prim = v;

 				f->valence = primvalence(v);

+				f->hasresult = 1;

 				pushval(values, f);

 			}

 			break;

@@ -259,10 +288,8 @@

 			o += getuvlong(c->instrs+o, &v);

 			{

 				void *val = symval(m->symtab, v);

-				if(val == nil){

-					appendlog(s, "VALUE ERROR\n");

-					return nil;

-				}

+				if(val == nil)

+					error(EValue, "%s is undefined", symname(m->symtab, v));

 				pushval(values, val);

 			}

 			break;

@@ -271,47 +298,85 @@

 			{

 				Array *x = allocarray(TypeArray, 1, v);

 				setshape(x, 0, v);

-				for(uvlong i = 0; i < v; i++)

-					setarray(x, i, popval(values));

+				for(uvlong i = 0; i < v; i++){

+					z = popval(values);

+					checkarray(z);

+					setarray(x, i, z);

+				}

 				x = simplifyarray(x);

 				pushval(values, x);

 			}

 			break;

-		case IMonadic:

+		case INiladic:

 			func = popval(values);

-			if(!(func->valence & Monadic)){

-				appendlog(s, "ERROR: Function not monadic!\n");

-				return nil;

+			if(func->valence != Niladic){

+				int next = nextinstr(calls, c, o);

+				if(next == IAssign || IPop){

+					pushval(values, func);

+					break;

+				}else

+					error(ESyntax, "Function %s is not niladic", funcname(func));

 			}

-			if(func->code)

+			if(func->code){

+				if(!func->hasresult){

+					if(nextinstr(calls, c, o) == IPop)

+						pushval(values, nil); /* fake result */

+					else

+						error(ESyntax, "Function %s does not produce a result", funcname(func));

+				}

 				pushcall(calls, func->code, &c, &o);

-			else{

-				Array *y = popval(values);

-				Array *z = primmonad(func->prim, y);

+			}else{

+				z = primnilad(func->prim);

 				pushval(values, z);

 			}

 			break;

-		case IDyadic:

+		case IMonadic:

+			/* FIXME: more duplicated code with INiladic and IDyadic than i would like */

 			func = popval(values);

-			if(!(func->valence & Dyadic)){

-				appendlog(s, "ERROR: Function not dyadic!\n");

-				return nil;

+			y = popval(values);

+			if(!(func->valence & Monadic))

+				error(ESyntax, "Function %s is not monadic", funcname(func));

+			checkarray(y);

+

+			if(func->code){

+				if(!func->hasresult){

+					if(nextinstr(calls, c, o) == IPop)

+						pushval(values, nil); /* fake result */

+					else

+						error(ESyntax, "Function %s does not produce a result", funcname(func));

+				}

+				pushval(values, y);

+				pushcall(calls, func->code, &c, &o);

+			}else{

+				z = primmonad(func->prim, y);

+				pushval(values, z);

 			}

+			break;

+		case IDyadic:

+			func = popval(values);

+			x = popval(values);

+			y = popval(values);

+			if(!(func->valence & Dyadic))

+				error(ESyntax, "Function %s is not dyadic", funcname(func));

+			checkarray(x);

+			checkarray(y);

-			if(func->code)

+			if(func->code){

+				if(!func->hasresult){

+					if(nextinstr(calls, c, o) == IPop)

+						pushval(values, nil); /* fake result */

+					else

+						error(ESyntax, "Function %s does not produce a result", funcname(func));

+				}

+				pushval(values, y);

+				pushval(values, x);

 				pushcall(calls, func->code, &c, &o);

-			else{

-				Array *x = popval(values);

-				Array *y = popval(values);

-				Array *z = primdyad(func->prim, x, y);

+			}else{

+				z = primdyad(func->prim, x, y);

 				pushval(values, z);

 			}

 			break;

-		case IClear: /* TODO: get rid of this instruction. It shouldn't be there, and it is wrong */

-			while(values->count > 0)

-				popval(values);

-			break;

 		case IParse:

 			/* parse at runtime and emit code */

 			o += getuvlong(c->instrs+o, &v);

@@ -324,31 +389,44 @@

 				pushcall(calls, newcode, &c, &o);

 			}

 			break;

-		case IDone:

-			goto done;

-			break;

 		case IReturn:

 			popcall(calls, m->symtab, &c, &o);

 			break;

 		case IAssign:

 			o += getuvlong(c->instrs+o, &v);

-			symset(m->symtab, v, popval(values));

+			{

+				void *val = popval(values);

+				symset(m->symtab, v, val);

+

+				if(nextinstr(calls, c, o) == IPop)

+					val = nil;

+				pushval(values, val);

+			}

 			break;

 		case ILocal:

 			o += getuvlong(c->instrs+o, &v);

 			pushlocal(calls, m->symtab, v);

 			break;

+		case IPop:

+			r = popval(values);

+			if(nextinstr(calls, c, o) == IDisplay && r != nil)

+				appendlog(s, printval(r));

+			break;

+		case IDisplay:

+			/* nothing to do, IPop checks for it */

+			break;

 		default:

-			appendlog(s, "unknown instruction in evalbc\n");

-			return nil;

+			error(EInternal, "unknown instruction in evalbc: %d", instr);

 		}

 	}

-done:

 	r = nil;

-	print("Final value stack size: %ulld\n", values->count);

-	print("Final call stack size: %ulld\n", calls->count);

-	if(values->count != 0)

+	if(values->count > 1)

+		error(EInternal, "Value stack size is %ulld", values->count);

+	if(calls->count > 0)

+		error(EInternal, "Call stack size is %ulld", calls->count);

+

+	if(values->count == 1)

 		r = popval(values);

 	return r;

 }

--- a/fns.h

+++ b/fns.h

@@ -43,11 +43,13 @@

 int primclass(int);

 int primvalence(int);

 int primid(char *);

+Array *primnilad(int);

 Array *primmonad(int, Array *);

 Array *primdyad(int, Array *, Array *);

 /* scan.c */

 TokenList *scan(char *);

+char *printtok(Token);

 /* session.c */

 void initsessions(void);

@@ -74,6 +76,7 @@

 void debugast(Ast *, int);

 void debugbc(ByteCode *);

 int getuvlong(u8int *, uvlong *);

+char *funcname(Function *);

 /* value.c */

 char *printval(void *);

--- a/parse.c

+++ b/parse.c

@@ -60,7 +60,7 @@

 match(TokenList *tokens, int tag)

 {

 	if(peek(tokens) != tag)

-		error(ESyntax, "Unexpected token (match failed)");

+		error(ESyntax, "Unexpected token: %s", printtok(tokens->tokens[tokens->offset]));

 	tokens->offset++;

 }

@@ -258,7 +258,6 @@

 		class = nameclass(name, symtab, func);

 		t->tokens[i].nameclass = class;

 		if(class == 0){ /* We don't know how to parse it until runtime */

-			print("nameclass 0 name: %s funcname: %s\n", name, func ? func->funcname->name : "<no func>");

 			if(symtab)

 				error(EValue, "%s is undefined", name);

@@ -300,13 +299,17 @@

 	if(peekclass(t) == NameclassFunc){

 func:

 		expr = alloc(DataAst);

-		if(val){

-			expr->tag = AstDyadic;

-			expr->left = val;

-		}else

-			expr->tag = AstMonadic;

 		expr->func = parsefunc(t);

-		expr->right = parseexprsub(t);

+		if(val == nil && (isexprsep(t) || peek(t) == TokRparen))

+			expr->tag = AstNiladic;

+		else{

+			if(val){

+				expr->tag = AstDyadic;

+				expr->left = val;

+			}else

+				expr->tag = AstMonadic;

+			expr->right = parseexprsub(t);

+		}

 		val = expr;

 		goto end;

 	}

--- a/prim.c

+++ b/prim.c

@@ -17,13 +17,14 @@

 struct {

 	char *spelling;

 	int nameclass;

+	Array *(*nilad)(void);

 	Array *(*monad)(Array *);

 	Array *(*dyad)(Array *, Array *);

 } primspecs[] = {

-	"⊢", NameclassFunc, primfn_same, primfn_right,

-	"⊣", NameclassFunc, primfn_same, primfn_left,

-	"+", NameclassFunc, nil, nil,

-	"-", NameclassFunc, nil, nil,

+	"⊢", NameclassFunc, nil, primfn_same, primfn_right,

+	"⊣", NameclassFunc, nil, primfn_same, primfn_left,

+	"+", NameclassFunc, nil, nil, nil,

+	"-", NameclassFunc, nil, nil, nil,

 };

 char *

@@ -61,14 +62,21 @@

 }

 Array *

+primnilad(int id)

+{

+	if(primspecs[id].nilad)

+		return primspecs[id].nilad();

+	else

+		error(EInternal, "primitive %s has no niladic definition", primsymb(id));

+}

+

+Array *

 primmonad(int id, Array *y)

 {

 	if(primspecs[id].monad)

 		return primspecs[id].monad(y);

-	else{

-		print("primitive %s has no monadic definition! (acts like ⊢)\n", primsymb(id));

-		return y;

-	}

+	else

+		error(EInternal, "primitive %s has no monadic definition", primsymb(id));

 }

 Array *

@@ -76,10 +84,8 @@

 {

 	if(primspecs[id].dyad)

 		return primspecs[id].dyad(x, y);

-	else{

-		print("primitive %s has no dyadic definition! (acts like ⊣)\n", primsymb(id));

-		return x;

-	}

+	else

+		error(EInternal, "primitive %s has no dyadic definition", primsymb(id));

 }

 /* monadic functions */

--- a/scan.c

+++ b/scan.c

@@ -83,4 +83,60 @@

 	}

 	newtok(tokens, TokEnd);

 	return tokens;

+}

+

+char *

+printtok(Token t)

+{

+	char buf[1024];

+	char *p = buf;

+

+	switch(t.tag){

+	case TokNumber:

+		sprint(p, "number");

+		break;

+	case TokName: 

+		sprint(p, "name");

+		break;

+	case TokLparen:

+		sprint(p, "(");

+		break;

+	case TokRparen:

+		sprint(p, ")");

+		break;

+	case TokLbrack:

+		sprint(p, "[");

+		break;

+	case TokRbrack:

+		sprint(p, "]");

+		break;

+	case TokLbrace:

+		sprint(p, "{");

+		break;

+	case TokRbrace:

+		sprint(p, "}");

+		break;

+	case TokNewline:

+		sprint(p, "newline");

+		break;

+	case TokDiamond:

+		sprint(p, "⋄");

+		break;

+	case TokPrimitive:

+		sprint(p, "primitive");

+		break;

+	case TokDel:

+		sprint(p, "∇");

+		break;

+	case TokLarrow:

+		sprint(p, "←");

+		break;

+	case TokSemi:

+		sprint(p, ";");

+		break;

+	default:

+		sprint(p, "???");

+	}

+

+	return buf;

 }

\ No newline at end of file

--- a/session.c

+++ b/session.c

@@ -42,7 +42,7 @@

 		if(strlen(buf) > 0 && buf[0] == ')')

 			systemcmd(s, buf+1, 0);

-		else{	

+		else{

 			if(trap(EAny)){

 				appendlog(s, errdesc());

 				appendlog(s, ": ");

@@ -53,11 +53,7 @@

 			TokenList *tokens = scan(buf);

 			Ast *ast = parse(tokens, 0);

-			debugast(ast, 0);

-			void *val = eval(s, ast);

-			if(val)

-				appendlog(s, printval(val));

-

+			eval(s, ast);

 			endtrap();

 		}

 	}

--- a/util.c

+++ b/util.c

@@ -158,6 +158,9 @@

 			o += getuvlong(c->instrs+o, &v);

 			print("STRAND %ulld\n", v);

 			break;

+		case INiladic:

+			print("NILADIC CALL\n");

+			break;

 		case IMonadic:

 			print("MONADIC CALL\n");

 			break;

@@ -164,16 +167,10 @@

 		case IDyadic:

 			print("DYADIC CALL\n");

 			break;

-		case IClear:

-			print("CLEAR\n");

-			break;

 		case IParse:

 			o += getuvlong(c->instrs+o, &v);

 			print("PARSE %ulld\n", v);

 			break;

-		case IDone:

-			print("DONE\n");

-			break;

 		case IReturn:

 			print("RETURN\n");

 			break;

@@ -185,6 +182,12 @@

 			o += getuvlong(c->instrs+o, &v);

 			print("LOCAL %ulld\n", v);

 			break;

+		case IPop:

+			print("POP\n");

+			break;

+		case IDisplay:

+			print("DISPLAY\n");

+			break;

 		default:

 			print("???");

 			return;

@@ -191,4 +194,13 @@

 		}

 	}

 	print("\n");

+}

+

+char *

+funcname(Function *f)

+{

+	if(f->ast)

+		return f->ast->funcname->name;

+	else

+		return primsymb(f->prim);

 }

\ No newline at end of file

-- 

⑨