shithub: lpa

Info  •  Files  •  Log  •  Branches

Add a few checks around function calls

--- a/dat.h

+++ b/dat.h

@@ -219,7 +219,6 @@

 	IStrand,

 	IMonadic,

 	IDyadic,

-	ICall,

 	IClear,

 	IParse,

 	IDone,

@@ -267,10 +266,19 @@

 	CallFrame *frames;

 };

+enum Valence

+{

+	Monadic = 1<<1,

+	Dyadic = 1<<2,

+};

+

 typedef struct Function Function;

 struct Function

 {

 	Ast *ast;

+	int valence;

+	int hasresult;

+

 	uvlong symbol;

 	ByteCode *code;

 	int prim;

--- a/eval.c

+++ b/eval.c

@@ -73,6 +73,11 @@

 		{

 			Function *fn = alloc(DataFunction);

 			fn->ast = a;

+			if(fn->ast->funcleftarg)

+				fn->valence = Dyadic;

+			else if(fn->ast->funcrightarg)

+				fn->valence = Monadic;

+

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

 			fn->code = alloc(DataByteCode);

 			emitbyte(fn->code, IPushConst);

@@ -84,10 +89,11 @@

 			for(i = 0; i < fn->ast->funclocals->childcount; i++)

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

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

-				if(i != 0)

-					emitbyte(fn->code, IClear);

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

+				emitbyte(fn->code, IClear);

 			}

+			if(fn->ast->funcresult)

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

 			emitbyte(fn->code, IReturn);

 			emitbyte(c, IPushConst);

@@ -124,19 +130,13 @@

 	case AstMonadic:

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

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

-		if(a->func->tag == AstPrim)

-			emitbyte(c, IMonadic);

-		else

-			emitbyte(c, ICall);

+		emitbyte(c, IMonadic);

 		break;

 	case AstDyadic:

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

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

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

-		if(a->func->tag == AstPrim)

-			emitbyte(c, IDyadic);

-		else

-			emitbyte(c, ICall);

+		emitbyte(c, IDyadic);

 		break;

 	case AstPrim:

 		emitbyte(c, IPushPrim);

@@ -181,13 +181,16 @@

 }

 static void

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

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

 {

 	s->count++;

 	s->frames = allocextra(s, s->count * sizeof(CallFrame));

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

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

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

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

 	s->frames[s->count-1].locals = alloc(DataLocalList);

+

+	*c = newcode;

+	*o = 0;

 }

 static void

@@ -248,12 +251,20 @@

 			{

 				Function *f = alloc(DataFunction);

 				f->prim = v;

+				f->valence = primvalence(v);

 				pushval(values, f);

 			}

 			break;

 		case ILookup:

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

-			pushval(values, symval(m->symtab, v)); /* TODO: value error? */

+			{

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

+				if(val == nil){

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

+					return nil;

+				}

+				pushval(values, val);

+			}

 			break;

 		case IStrand:

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

@@ -267,32 +278,36 @@

 			}

 			break;

 		case IMonadic:

-			{

-				Function *f = popval(values);

+			func = popval(values);

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

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

+				return nil;

+			}

+

+			if(func->code)

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

+			else{

 				Array *y = popval(values);

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

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

 				pushval(values, z);

 			}

 			break;

 		case IDyadic:

-			{

-				Function *f = popval(values);

+			func = popval(values);

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

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

+				return nil;

+			}

+

+			if(func->code)

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

+			else{

 				Array *x = popval(values);

 				Array *y = popval(values);

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

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

 				pushval(values, z);

 			}

 			break;

-		case ICall:

-			func = popval(values);

-			newcode = func->code;

-call:

-			pushcall(calls, c, o);

-			c = newcode;

-			o = 0;

-			print("CALLED:\n");

-			debugbc(c);

-			break;

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

 			while(values->count > 0)

 				popval(values);

@@ -313,7 +328,7 @@

 					newcode = alloc(DataByteCode);

 					codegensub(s, m, newcode, a);

 					emitbyte(newcode, IReturn);

-					goto call;

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

 				}

 			}

 			break;

@@ -322,8 +337,6 @@

 			break;

 		case IReturn:

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

-			print("RETURNED TO (%ulld)\n", o);

-			debugbc(c);

 			break;

 		case IAssign:

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

@@ -346,4 +359,4 @@

 	if(values->count != 0)

 		r = popval(values);

 	return r;

-}

\ No newline at end of file

+}

--- a/fns.h

+++ b/fns.h

@@ -31,6 +31,7 @@

 /* prim.c */

 char *primsymb(int);

 int primclass(int);

+int primvalence(int);

 int primid(char *);

 Array *primmonad(int, Array *);

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

--- a/prim.c

+++ b/prim.c

@@ -39,6 +39,17 @@

 }

 int

+primvalence(int id)

+{

+	int valence = 0;

+	if(primspecs[id].monad)

+		valence |= Monadic;

+	if(primspecs[id].dyad)

+		valence |= Dyadic;

+	return valence;

+}

+

+int

 primid(char *s)

 {

 	for(int i = 0; i < nelem(primspecs); i++){

--- a/util.c

+++ b/util.c

@@ -159,13 +159,10 @@

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

 			break;

 		case IMonadic:

-			print("MONADIC PRIM\n");

+			print("MONADIC CALL\n");

 			break;

 		case IDyadic:

-			print("DYADIC PRIM\n");

-			break;

-		case ICall:

-			print("CALL\n");

+			print("DYADIC CALL\n");

 			break;

 		case IClear:

 			print("CLEAR\n");