5 files changed, 70 insertions(+), 40 deletions(-)

M dat.h
M eval.c
M fns.h
M prim.c
M util.c

@@ 219,7 219,6 @@ enum Instr
 	IStrand,
 	IMonadic,
 	IDyadic,
-	ICall,
 	IClear,
 	IParse,
 	IDone,


@@ 267,10 266,19 @@ struct CallStack
 	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;

@@ 73,6 73,11 @@ codegensub(Session *s, Module *m, ByteCode *c, Ast *a)
 		{
 			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 @@ codegensub(Session *s, Module *m, ByteCode *c, Ast *a)
 			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 @@ codegensub(Session *s, Module *m, ByteCode *c, Ast *a)
 	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 @@ popval(ValueStack *s)
 }
 
 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 @@ evalbc(Session *s, Module *m, ByteCode *c)
 			{
 				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 @@ evalbc(Session *s, Module *m, ByteCode *c)
 			}
 			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 @@ call:
 					newcode = alloc(DataByteCode);
 					codegensub(s, m, newcode, a);
 					emitbyte(newcode, IReturn);
-					goto call;
+					pushcall(calls, newcode, &c, &o);
 				}
 			}
 			break;


@@ 322,8 337,6 @@ call:
 			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 @@ done:
 	if(values->count != 0)
 		r = popval(values);
 	return r;
-}>
\ No newline at end of file
+}

@@ 31,6 31,7 @@ Ast *parse(TokenList *, Symtab *, char **);
 /* prim.c */
 char *primsymb(int);
 int primclass(int);
+int primvalence(int);
 int primid(char *);
 Array *primmonad(int, Array *);
 Array *primdyad(int, Array *, Array *);

@@ 39,6 39,17 @@ primclass(int id)
 }
 
 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++){

@@ 159,13 159,10 @@ debugbc(ByteCode *c)
 			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");