shithub: lpa

ref: ee1ed56428b090dd694f50b49f4957c4d2e11bc2
dir: /eval.c/

#include <u.h>
#include <libc.h>
#include <thread.h>

#include "dat.h"
#include "fns.h"

static ByteCode *codegen(Session *, Module *, Ast *);
static void *evalbc(Session *, Module *, ByteCode *);

void *
eval(Session *s, Ast *a)
{
	/* Evaluate some ast in module m in session s. */
	Module *m = s->modules->modules[0]; /* TODO: this isn't nice */
	ByteCode *code = codegen(s, m, a);
	return evalbc(s, m, code);
}

static void
emitbyte(ByteCode *c, u8int i)
{
	c->count += 1;
	c->instrs = allocextra(c, c->count);
	c->instrs[c->count-1] = i;
}

static void
emituvlong(ByteCode *c, uvlong v)
{
	for(int i = 0; i < sizeof(v); i++)
		emitbyte(c, (v>>(8*i)) & 0xFF);
}

static void
emitptr(ByteCode *c, void *p)
{
	emituvlong(c, (uvlong)p);
}

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, IDone);
		break;
	case AstName:
		emitbyte(c, ILookup);
		emituvlong(c, sym(m->symtab, a->name));
		break;
	case AstConst:
		emitbyte(c, IPushConst);
		emitptr(c, a->val); /* TODO: better to have consts array and emit index? */
		break;
	case AstStrand:
		/* right to left */
		for(i = a->childcount; i > 0; i--)
			codegensub(s, m, c, a->children[i-1]);
		emitbyte(c, IStrand);
		emituvlong(c, a->childcount);
		break;
	case AstMonadic:
		codegensub(s, m, c, a->right);
		codegensub(s, m, c, a->func);
		emitbyte(c, IMonadic);
		break;
	case AstDyadic:
		codegensub(s, m, c, a->right);
		codegensub(s, m, c, a->left);
		codegensub(s, m, c, a->func);
		emitbyte(c, IDyadic);
		break;
	case AstPrim:
		emitbyte(c, IPushPrim);
		emituvlong(c, a->prim); /* TODO: waste of space */
		break;
	case AstLater:
		emitbyte(c, IParse);
		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);
		break;
	}

}

static ByteCode *
codegen(Session *s, Module *m, Ast *a)
{
	ByteCode *c = alloc(DataByteCode);
	codegensub(s, m, c, a);
	return c;
}

static void
pushval(ValueStack *s, void *v)
{
	s->count += 1;
	s->values = allocextra(s, s->count * sizeof(v));
	s->values[s->count-1] = v;
}

static void *
popval(ValueStack *s)
{
	if(s->count == 0)
		sysfatal("popval on empty value stack");
	s->count--; /* no realloc */
	return s->values[s->count];
}

static void *
evalbc(Session *s, Module *m, ByteCode *c)
{
	ValueStack *values;
	uvlong o, v;
	int prim = 0;
	void *r;

	values = alloc(DataValueStack);
	debugbc(c);

	o = 0;
	while(o < c->count){
		int instr = c->instrs[o];
		o++;

		switch(instr){
		case IPushConst:
			o += getuvlong(c->instrs+o, &v);
			pushval(values, (void*)v);
			break;
		case IPushPrim:
			o += getuvlong(c->instrs+o, &v);
			prim = v;
			break;
		case ILookup:
			o += getuvlong(c->instrs+o, &v);
			pushval(values, symval(m->symtab, v)); /* TODO: value error? */
			break;
		case IStrand:
			o += getuvlong(c->instrs+o, &v);
			{
				Array *x = allocarray(TypeArray, 1, v);
				setshape(x, 0, v);
				for(uvlong i = 0; i < v; i++)
					setarray(x, i, popval(values));
				x = simplifyarray(x);
				pushval(values, x);
			}
			break;
		case IMonadic:
			appendlog(s, "NOTE: monadic call acts like ⊢\n");
			break;
		case IDyadic:
			USED(prim);
			appendlog(s, "NOTE: dyadic call acts like ⊣\n");
			popval(values);
			break;
		case IClear:
			while(values->count > 0)
				popval(values);
			break;
		case IParse:
			/* parse at runtime and emit code */
			o += getuvlong(c->instrs+o, &v);
			{
				char *err;
				TokenList *t = (TokenList *)v;
				Ast *a = parse(t, m->symtab, &err);
				if(!a){
					appendlog(s, "RUNTIME PARSE: ");
					appendlog(s, err);
					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);
				}
			}
			break;
		case IDone:
			goto done;
			break;
		case IJump:
			getuvlong(c->instrs+o, &v);
			o = v;
			break;
		default:
			appendlog(s, "unknown instruction in evalbc\n");
			return nil;
		}
	}

done:
	r = nil;
	if(values->count != 0)
		r = popval(values);
	return r;
}