~pmikkelsen/lpa: Do some work on functions

9 files changed, 235 insertions(+), 27 deletions(-)

M array.c
M dat.h
M eval.c
M fns.h
M fs.c
M memory.c
M parse.c
M util.c
M value.c

M array.c => array.c +20 -0

@@ 151,6 151,26 @@ printarray(Array *a)
 	return buf;
 }
 
+char *
+printfunc(Function *f) /* Doesn't really belong here.. */
+{
+	char buf[2048]; /* TODO: fixed size :) */
+	char *p = buf;
+
+	p += sprint(p, "∇");
+	if(f->ast->funcresult)
+		p += sprint(p, "%s←", f->ast->funcresult->name);
+	if(f->ast->funcleftarg)
+		p += sprint(p, "%s ", f->ast->funcleftarg->name);
+	p += sprint(p, "%s", f->ast->funcname->name);
+	if(f->ast->funcrightarg)
+		p += sprint(p, " %s", f->ast->funcrightarg->name);
+	for(uvlong i = 0; i < f->ast->funclocals->childcount; i++)
+		p += sprint(p, ";%s", f->ast->funclocals->children[i]->name);
+	sprint(p, "\n∇");
+	return buf;
+}
+
 Array *
 simplifyarray(Array *a)
 {

M dat.h => dat.h +50 -2

@@ 13,6 13,9 @@ enum DataTag
 	DataAst,
 	DataByteCode,
 	DataValueStack,
+	DataCallStack,
+	DataFunction,
+	DataLocalList,
 
 	DataMax,
 };


@@ 172,6 175,8 @@ enum AstTag
 	AstLater, /* parse at runtime */
 };
 
+typedef struct ByteCode ByteCode;
+
 typedef struct Ast Ast;
 struct Ast
 {


@@ 206,7 211,6 @@ enum Nameclass
 	NameclassFunc, /* Function value */
 };
 
-typedef struct ByteCode ByteCode;
 struct ByteCode
 {
 	uvlong count;


@@ 221,10 225,13 @@ enum Instr
 	IStrand,
 	IMonadic,
 	IDyadic,
+	ICall,
 	IClear,
 	IParse,
 	IDone,
-	IJump,
+	IReturn,
+	IAssign,
+	ILocal,
 };
 
 typedef struct ValueStack ValueStack;


@@ 232,4 239,45 @@ struct ValueStack
 {
 	uvlong count;
 	void **values;
+};
+
+typedef struct Local Local;
+struct Local
+{
+	uvlong id;
+	void *value;
+};
+
+typedef struct LocalList LocalList;
+struct LocalList
+{
+	uvlong count;
+	Local *list;
+};
+
+typedef struct CallFrame CallFrame;
+struct CallFrame
+{
+	/* Values stored when the frame is pushed */
+	ByteCode *code;
+	uvlong offset;
+
+	/* Old values of symbols before they were localised */
+	LocalList *locals;
+};
+
+typedef struct CallStack CallStack;
+struct CallStack
+{
+	uvlong count;
+	CallFrame *frames;
+};
+
+typedef struct Function Function;
+struct Function
+{
+	Ast *ast;
+	uvlong symbol;
+	ByteCode *code;
+	int prim;
 };=
\ No newline at end of file

M eval.c => eval.c +135 -20

@@ 39,6 39,21 @@ emitptr(ByteCode *c, void *p)
 }
 
 static void
+emitlocal(ByteCode *c, Symtab *s, Ast *a, int assign)
+{
+	if(a == nil)
+		return;
+
+	uvlong id = sym(s, a->name);
+	emitbyte(c, ILocal);
+	emituvlong(c, id);
+	if(assign){
+		emitbyte(c, IAssign);
+		emituvlong(c, id);
+	}
+}
+
+static void
 codegensub(Session *s, Module *m, ByteCode *c, Ast *a)
 {
 	char *err;


@@ 53,6 68,39 @@ codegensub(Session *s, Module *m, ByteCode *c, Ast *a)
 		}
 		emitbyte(c, IDone);
 		break;
+	case AstFunc:
+		/* Emit bytecode for the function body */
+		{
+			Function *fn = alloc(DataFunction);
+			fn->ast = a;
+			fn->symbol = sym(m->symtab, a->funcname->name);
+			fn->code = alloc(DataByteCode);
+			emitbyte(fn->code, IPushConst);
+			emitptr(fn->code, fn);
+			emitlocal(fn->code, m->symtab, fn->ast->funcname, 1);
+			emitlocal(fn->code, m->symtab, fn->ast->funcresult, 0);
+			emitlocal(fn->code, m->symtab, fn->ast->funcleftarg, 1);
+			emitlocal(fn->code, m->symtab, fn->ast->funcrightarg, 1);
+			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, IReturn);
+
+			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);
+		}
+		break;
 	case AstName:
 		emitbyte(c, ILookup);
 		emituvlong(c, sym(m->symtab, a->name));


@@ 71,13 119,19 @@ codegensub(Session *s, Module *m, ByteCode *c, Ast *a)
 	case AstMonadic:
 		codegensub(s, m, c, a->right);
 		codegensub(s, m, c, a->func);
-		emitbyte(c, IMonadic);
+		if(a->func->tag == AstPrim)
+			emitbyte(c, IMonadic);
+		else
+			emitbyte(c, ICall);
 		break;
 	case AstDyadic:
 		codegensub(s, m, c, a->right);
 		codegensub(s, m, c, a->left);
 		codegensub(s, m, c, a->func);
-		emitbyte(c, IDyadic);
+		if(a->func->tag == AstPrim)
+			emitbyte(c, IDyadic);
+		else
+			emitbyte(c, ICall);
 		break;
 	case AstPrim:
 		emitbyte(c, IPushPrim);


@@ 107,7 161,7 @@ codegen(Session *s, Module *m, Ast *a)
 static void
 pushval(ValueStack *s, void *v)
 {
-	s->count += 1;
+	s->count++;
 	s->values = allocextra(s, s->count * sizeof(v));
 	s->values[s->count-1] = v;
 }


@@ 121,15 175,57 @@ popval(ValueStack *s)
 	return s->values[s->count];
 }
 
+static void
+pushcall(CallStack *s, 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].locals = alloc(DataLocalList);
+}
+
+static void
+popcall(CallStack *s, Symtab *t, ByteCode **c, uvlong *o)
+{
+	if(s->count == 0)
+		sysfatal("popcall on empty call stack");
+	s->count--; /* no realloc */
+	*c = s->frames[s->count].code;
+	*o = s->frames[s->count].offset;
+
+	LocalList *locals = s->frames[s->count].locals;
+	for(uvlong i = 0; i < locals->count; i++)
+		symset(t, locals->list[i].id, locals->list[i].value);
+}
+
+static void
+pushlocal(CallStack *c, Symtab *s, uvlong id)
+{
+	CallFrame f = c->frames[s->count-1];
+
+	f.locals->count++;
+	f.locals->list = allocextra(f.locals, sizeof(Local) * f.locals->count);
+	f.locals->list[f.locals->count-1].id = id;
+	f.locals->list[f.locals->count-1].value = symval(s, id);
+
+	symset(s, id, nil);
+}
+
 static void *
 evalbc(Session *s, Module *m, ByteCode *c)
 {
 	ValueStack *values;
+	CallStack *calls;
+
+	ByteCode *newcode;
 	uvlong o, v;
-	int prim = 0;
+	Function *func;
 	void *r;
 
 	values = alloc(DataValueStack);
+	calls = alloc(DataCallStack);
+
 	debugbc(c);
 
 	o = 0;


@@ 144,7 240,11 @@ evalbc(Session *s, Module *m, ByteCode *c)
 			break;
 		case IPushPrim:
 			o += getuvlong(c->instrs+o, &v);
-			prim = v;
+			{
+				Function *f = alloc(DataFunction);
+				f->prim = v;
+				pushval(values, f);
+			}
 			break;
 		case ILookup:
 			o += getuvlong(c->instrs+o, &v);


@@ 165,11 265,20 @@ evalbc(Session *s, Module *m, ByteCode *c)
 			appendlog(s, "NOTE: monadic call acts like ⊢\n");
 			break;
 		case IDyadic:
-			USED(prim);
-			appendlog(s, "NOTE: dyadic call acts like ⊣\n");
+			appendlog(s, "NOTE: dyadic call acts like ⊢\n");
 			popval(values);
 			break;
-		case IClear:
+		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);
 			break;


@@ 186,24 295,28 @@ evalbc(Session *s, Module *m, ByteCode *c)
 					appendlog(s, "\n");
 					return nil;
 				}else{
-					uvlong next = o;
-					uvlong start = c->count;
-					codegensub(s, m, c, a);
-					emitbyte(c, IJump);
-					emituvlong(c, next);
-					o = start; /* jump to new code */
-					/* TODO: this adds code every time the instruction is run */
-					print("updated bytecode:\n");
-					debugbc(c);
+					newcode = alloc(DataByteCode);
+					codegensub(s, m, newcode, a);
+					emitbyte(newcode, IReturn);
+					goto call;
 				}
 			}
 			break;
 		case IDone:
 			goto done;
 			break;
-		case IJump:
-			getuvlong(c->instrs+o, &v);
-			o = v;
+		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);
+			symset(m->symtab, v, popval(values));
+			break;
+		case ILocal:
+			o += getuvlong(c->instrs+o, &v);
+			pushlocal(calls, m->symtab, v);
 			break;
 		default:
 			appendlog(s, "unknown instruction in evalbc\n");


@@ 213,6 326,8 @@ evalbc(Session *s, Module *m, ByteCode *c)
 
 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)
 		r = popval(values);
 	return r;

M fns.h => fns.h +1 -0

@@ 6,6 6,7 @@ void setarray(Array *, usize, Array *);
 void setshape(Array *, int, usize);
 Array *simplifyarray(Array *);
 char *printarray(Array *);
+char *printfunc(Function *);
 
 /* eval.c */
 void *eval(Session *s, Ast *);

M fs.c => fs.c +5 -0

@@ 280,6 280,11 @@ symbolrw(Req *r)
 		char *buf = requeststr(r);
 		void *v = parseval(session, buf, &err);
 		free(buf);
+		if(v && getalloctag(v) == DataFunction){
+			Function *f = v;
+			if(strcmp(symb->name, f->ast->funcname->name) != 0)
+				err = "Function name must match symbol name";
+		}
 		if(!err)
 			symset(symb->table, symb->id, v);
 	}

M memory.c => memory.c +3 -0

@@ 36,6 36,9 @@ DataSpec dataspecs[DataMax] = {
 	[DataAst] = {.size = sizeof(Ast) },
 	[DataByteCode] = {.size = sizeof(ByteCode) },
 	[DataValueStack] = {.size = sizeof(ValueStack) },
+	[DataCallStack] = {.size = sizeof(CallStack) },
+	[DataFunction] = {.size = sizeof(Function) },
+	[DataLocalList] = {.size = sizeof(LocalList) },
 };
 
 void *

M parse.c => parse.c +4 -1

@@ 136,6 136,9 @@ nameclass(char *name, Symtab *s, Ast *func)
 		case DataArray:
 			class = NameclassArray;
 			break;
+		case DataFunction:
+			class = NameclassFunc;
+			break;
 		/* more cases here in the future */
 		}
 	}else{


@@ 193,6 196,7 @@ parsefuncdef(TokenList *t)
 			parseseps(t, 1);
 	}
 	match(t, TokDel);
+
 	return func;
 }
 


@@ 368,7 372,6 @@ parsename(TokenList *t)
 static Ast *
 parsefunc(TokenList *t)
 {
-	/* TODO: parse primitives as well */
 	Ast *func;
 	if(peek(t) == TokName && peekclass(t) == NameclassFunc)
 		func = parsename(t);

M util.c => util.c +15 -4

@@ 159,10 159,13 @@ debugbc(ByteCode *c)
 			print("STRAND %ulld\n", v);
 			break;
 		case IMonadic:
-			print("MONADIC\n");
+			print("MONADIC PRIM\n");
 			break;
 		case IDyadic:
-			print("DYADIC\n");
+			print("DYADIC PRIM\n");
+			break;
+		case ICall:
+			print("CALL\n");
 			break;
 		case IClear:
 			print("CLEAR\n");


@@ 174,13 177,21 @@ debugbc(ByteCode *c)
 		case IDone:
 			print("DONE\n");
 			break;
-		case IJump:
+		case IReturn:
+			print("RETURN\n");
+			break;
+		case IAssign:
+			o += getuvlong(c->instrs+o, &v);
+			print("ASSIGN %ulld\n", v);
+			break;
+		case ILocal:
 			o += getuvlong(c->instrs+o, &v);
-			print("JUMP %ulld\n", v);
+			print("LOCAL %ulld\n", v);
 			break;
 		default:
 			print("???");
 			return;
 		}
 	}
+	print("\n");
 }=
\ No newline at end of file

M value.c => value.c +2 -0

@@ 18,6 18,8 @@ printval(void *v)
 		switch(tag){
 		case DataArray:
 			return smprint("%s\n", printarray(v));
+		case DataFunction:
+			return smprint("%s\n", printfunc(v));
 		default:
 			return smprint("some value of type %d\n", tag);
 		}