Artifact Content
Not logged in

Artifact c85d31e67d8ceb4bbe8e3f21772ee40ad0a46687


/**
 * Authors: k.inaba
 * License: NYSL 0.9982 http://www.kmonos.net/nysl/
 *
 * Evaluator for Polemy programming language.
 */
module polemy.eval;
import polemy._common;
import polemy.failure;
import polemy.ast;
import polemy.parse;
import polemy.value;
import polemy.layer;
import std.typecons;
import std.stdio;

///
Table createGlobalContext()
{
	auto ctx = new Table;
	ctx.set("+", ValueLayer, native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data + rhs.data);} ));
	ctx.set("-", ValueLayer, native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data - rhs.data);} ));
	ctx.set("*", ValueLayer, native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data * rhs.data);} ));
	ctx.set("/", ValueLayer, native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data / rhs.data);} ));
	ctx.set("%", ValueLayer, native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data % rhs.data);} ));
	ctx.set("||", ValueLayer, native( (IntValue lhs, IntValue rhs){return new IntValue(BigInt((lhs.data!=0) || (rhs.data!=0) ? 1:0));} ));
	ctx.set("&&", ValueLayer, native( (IntValue lhs, IntValue rhs){return new IntValue(BigInt((lhs.data!=0) && (rhs.data!=0) ? 1:0));} ));
	ctx.set("<", ValueLayer, native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs < rhs ? 1: 0));} ));
	ctx.set(">", ValueLayer, native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs > rhs ? 1: 0));} ));
	ctx.set("<=", ValueLayer, native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs <= rhs ? 1: 0));} ));
	ctx.set(">=", ValueLayer, native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs >= rhs ? 1: 0));} ));
	ctx.set("==", ValueLayer, native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs == rhs ? 1: 0));} ));
	ctx.set("!=", ValueLayer, native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs != rhs ? 1: 0));} ));
	ctx.set("print", ValueLayer, native( (Value a){
		writeln(a);
		return new IntValue(BigInt(0));
	}));
	ctx.set("if", ValueLayer, native( (IntValue x, FunValue ft, FunValue fe){
		auto toRun = (x.data==0 ? fe : ft);
		// [TODO] fill positional information
		return toRun.invoke(null, ValueLayer, toRun.definitionContext());
//		return toRun.invoke(pos, lay, toRun.definitionContext());
	}));
	ctx.set("_isint", ValueLayer, native( (Value v){return new IntValue(BigInt(cast(IntValue)v is null ? 0 : 1));} ));
	ctx.set("_isstr", ValueLayer, native( (Value v){return new IntValue(BigInt(cast(StrValue)v is null ? 0 : 1));} ));
	ctx.set("_isfun", ValueLayer, native( (Value v){return new IntValue(BigInt(cast(FunValue)v is null ? 0 : 1));} ));
	ctx.set("_isundefined", ValueLayer, native( (Value v){return new IntValue(BigInt(cast(UndValue)v is null ? 0 : 1));} ));
	ctx.set("_istable", ValueLayer, native( (Value v){return new IntValue(BigInt(cast(Table)v is null ? 0 : 1));} ));
	ctx.set(".", ValueLayer, native( (Table t, StrValue s){
		return (t.has(s.data, ValueLayer) ? t.get(s.data, ValueLayer) : new UndValue);
	}) );
	ctx.set(".?", ValueLayer, native( (Table t, StrValue s){
		return new IntValue(BigInt(t.has(s.data, ValueLayer) ? 1 : 0));
	}) );
	ctx.set(".=", ValueLayer, native( (Table t, StrValue s, Value v){
		auto t2 = new Table(t, Table.Kind.NotPropagateSet);
		t2.set(s.data, ValueLayer, v);
		return t2;
	}) );
	ctx.set("{}", ValueLayer, native( (){
		return new Table;
	}) );
	return ctx;
}

/// Entry point of this module

Tuple!(Value,"val",Table,"ctx") evalString(S,T...)(S str, T fn_ln_cn)
{
	return eval( polemy.parse.parseString(str, fn_ln_cn) );
}

/// Entry point of this module

Tuple!(Value,"val",Table,"ctx") evalFile(S, T...)(S filename, T ln_cn)
{
	return eval( polemy.parse.parseFile(filename, ln_cn) );
}

/// Entry point of this module

Tuple!(Value,"val",Table,"ctx") eval(AST e)
{
	Table ctx = createGlobalContext();
	return typeof(return)(eval(e, ctx, false, ValueLayer), ctx);
}

Value invokeFunction(in LexPosition pos, Value _f, AST[] args, Table callerCtx, Layer lay, bool AlwaysMacro=false)
{
	if(auto f = cast(FunValue)_f)
	{
		Table ctx = new Table(f.definitionContext(), Table.Kind.NotPropagateSet);
		foreach(i,p; f.params())
			if( p.layers.empty )
				if(lay==MacroLayer)
					ctx.set(p.name, lay, macroEval(args[i], callerCtx, AlwaysMacro));
				else
					ctx.set(p.name, lay, eval(args[i], callerCtx, true, lay));
			else
				foreach(argLay; p.layers)
					if(argLay==MacroLayer)
						ctx.set(p.name, argLay, macroEval(args[i], callerCtx, AlwaysMacro));
					else
						ctx.set(p.name, argLay, eval(args[i], callerCtx, true, argLay));
		return f.invoke(pos, lay, ctx);
	}
	throw genex!RuntimeException(pos, "tried to call non-function");
}

Value lift(in LexPosition pos, Value v, Layer lay, Table callerCtx)
{
	// similar to invoke Function, but with only one argument bound to ValueLayer
	Value _f = callerCtx.get(lay, SystemLayer, pos);
	if(auto f = cast(FunValue)_f)
	{
		Table ctx = new Table(f.definitionContext(), Table.Kind.NotPropagateSet);
		auto ps = f.params();
		if( ps.length != 1 )
			throw genex!RuntimeException(pos, "lift function must take exactly one argument at "~ValueLayer~" layer");
		if( ps[0].layers.length==0 || ps[0].layers.length==1 && ps[0].layers[0]==ValueLayer )
		{
			ctx.set(ps[0].name, ValueLayer, v);
			return f.invoke(pos, ValueLayer, ctx);
		}
		else
			throw genex!RuntimeException(pos, "lift function must take exactly one argument at "~ValueLayer~" layer");
	}
	throw genex!RuntimeException(pos, "tried to call non-function");
}

/// Entry point of this module
/// If splitCtx = true, then inner variable declaration do not overwrite ctx.
/// lay is the layer ID for evaluation (standard value semantics uses ValueLayer).

Value eval(AST e, Table ctx, bool splitCtx, Layer lay)
{
	return e.match(
		(StrLiteral e)
		{
			Value v = new StrValue(e.data);
			if( lay == ValueLayer )
				return v;
			else
				return lift(e.pos,v,lay,ctx);
		},
		(IntLiteral e)
		{
			Value v = new IntValue(e.data);
			if( lay == ValueLayer )
				return v;
			else // rise
				return lift(e.pos,v,lay,ctx);
		},
		(VarExpression e)
		{
			if( lay == ValueLayer )
				return ctx.get(e.name, lay, e.pos);
			try {
				return ctx.get(e.name, lay, e.pos);
			} catch( Throwable ) { // [TODO] more precise...
				return lift(e.pos, ctx.get(e.name, ValueLayer, e.pos), lay, ctx);
			}
		},
		(LayExpression e)
		{
			if( e.layer == MacroLayer )
				return macroEval(e.expr, ctx, false);
			else
				return eval(e.expr, ctx, true, e.layer);
		},
		(LetExpression e)
		{
			// for letrec, we need this, but should avoid overwriting????
			// ctx.set(e.var, ValueLayer, new UndefinedValue, e.pos);
			if(splitCtx)
				ctx = new Table(ctx, Table.Kind.NotPropagateSet);
			Value v = eval(e.init, ctx, true, lay);
			ctx.set(e.name, (e.layer.length ? e.layer : lay), v, e.pos);
			return eval(e.expr, ctx, false, lay);
		},
		(FuncallExpression e)
		{
			return invokeFunction(e.pos, eval(e.fun, ctx, true, lay), e.args, ctx, lay);
		},
		(FunLiteral e)
		{
			Value[Value[]][Layer] memo;
			AST macroMemo = null; // cache

			// funvalue need not be rised
			// no, need to be rised !!  suppose @t(fib)("int")
			return new UserDefinedFunValue(e, ctx);
		},
		delegate Value (AST e)
		{
			throw genex!RuntimeException(e.pos, sprintf!"Unknown Kind of Expression %s"(typeid(e)));
		}
	);
}

// [TODO] Optimization
Value macroEval(AST e, Table ctx, bool AlwaysMacro)
{
	Layer theLayer = ValueLayer;

	Table makeCons(Value a, Value d)
	{
		Table t = new Table;
		t.set("car", theLayer, a);
		t.set("cdr", theLayer, d);
		return t;
	}

	Table pos = new Table;
	if( e.pos !is null ) {
		pos.set("filename", theLayer, new StrValue(e.pos.filename));
		pos.set("lineno",   theLayer, new IntValue(BigInt(e.pos.lineno)));
		pos.set("column",   theLayer, new IntValue(BigInt(e.pos.column)));
	} else {
		pos.set("filename", theLayer, new StrValue("nullpos"));
		pos.set("lineno",   theLayer, new IntValue(BigInt(0)));
		pos.set("column",   theLayer, new IntValue(BigInt(0)));
	}

	return e.match(
		(StrLiteral e)
		{
			Table t = new Table;
			t.set("pos",  theLayer, pos);
			t.set("is",   theLayer, new StrValue("str"));
			t.set("data", theLayer, new StrValue(e.data));
			return t;
		},
		(IntLiteral e)
		{
			Table t = new Table;
			t.set("pos",  theLayer, pos);
			t.set("is",   theLayer, new StrValue("int"));
			t.set("data", theLayer, new IntValue(e.data));
			return t;
		},
		(VarExpression e)
		{
			try {
				return ctx.get(e.name, MacroLayer, e.pos);
			} catch( Throwable ) {// [TODO] more precies...
				Table t = new Table;
				t.set("pos",  theLayer, pos);
				t.set("is",   theLayer, new StrValue("var"));
				t.set("name", theLayer, new StrValue(e.name));
				return cast(Value)t;
			}
		},
		(LayExpression e)
		{
			if( AlwaysMacro )
			{
				Table t = new Table;
				t.set("pos",   theLayer, pos);
				t.set("is",    theLayer, new StrValue("lay"));
				t.set("layer", theLayer, new StrValue(e.layer));
				t.set("expr",  theLayer, macroEval(e.expr,ctx,AlwaysMacro));
				return cast(Value)t;
			}
			else
			{
				if( e.layer == MacroLayer )
					return macroEval(e.expr, ctx, false);
				else
					return eval(e.expr, ctx, true, e.layer);
			}
		},
		(LetExpression e)
		{
			Table t = new Table;
			t.set("pos",  theLayer, pos);
			t.set("is",   theLayer, new StrValue("let"));
			t.set("name", theLayer, new StrValue(e.name));
			t.set("init", theLayer, macroEval(e.init,ctx,AlwaysMacro));
			t.set("expr", theLayer, macroEval(e.expr,ctx,AlwaysMacro));
			return t;
		},
		(FuncallExpression e)
		{
			Value _f = macroEval(e.fun,ctx,AlwaysMacro);

			if( auto f = cast(FunValue)_f )
				return invokeFunction(e.pos, f, e.args, ctx, MacroLayer, AlwaysMacro);

			Table t = new Table;
			t.set("pos",  theLayer, pos);
			t.set("is",   theLayer, new StrValue("app"));
			t.set("fun",  theLayer, _f);
			Table args = new Table;
			foreach_reverse(a; e.args) {
				Table cons = new Table;
				cons.set("car",theLayer,macroEval(a,ctx,AlwaysMacro));
				cons.set("cdr",theLayer,args);
				args = cons;
			}
			t.set("args", theLayer, args);
			return cast(Value)t;
		},
		(FunLiteral e)
		{
			Table t = new Table;
			t.set("pos",   theLayer, pos);
			t.set("is",    theLayer, new StrValue("fun"));
			t.set("funbody",  theLayer, macroEval(e.funbody,ctx,AlwaysMacro));
			Table params = new Table;
			foreach_reverse(p; e.params)
			{
				Table lays = new Table;
				foreach_reverse(lay; p.layers)
					lays = makeCons(new StrValue(lay), lays);
				Table kv = new Table;
				kv.set("name", theLayer, new StrValue(p.name));
				kv.set("layers", theLayer, lays);
				Table cons = new Table;
				params = makeCons(kv, params);
			}
			t.set("params", theLayer, params);
			return t;
		},
		delegate Value (AST e)
		{
			throw genex!RuntimeException(e.pos, sprintf!"Unknown Kind of Expression %s"(typeid(e)));
		}
	);
}

unittest
{
	auto r = assert_nothrow( evalString(`var x = 21; x + x*x;`) );
	assert_eq( r.val, new IntValue(BigInt(21+21*21)) );
	assert_eq( r.ctx.get("x",ValueLayer), new IntValue(BigInt(21)) );
	assert_nothrow( r.ctx.get("x",ValueLayer) );
	assert_throw!RuntimeException( r.ctx.get("y",ValueLayer) );
}
unittest
{
	auto r = assert_nothrow( evalString(`var x = 21; var x = x + x*x;`) );
	assert_eq( r.val, new IntValue(BigInt(21+21*21)) );
	assert_eq( r.ctx.get("x",ValueLayer), new IntValue(BigInt(21+21*21)) );
	assert_nothrow( r.ctx.get("x",ValueLayer) );
	assert_throw!RuntimeException( r.ctx.get("y",ValueLayer) );
}
unittest
{
	assert_eq( evalString(`let x=1; let y=(let x=2); x`).val, new IntValue(BigInt(1)) ); 
	assert_eq( evalString(`let x=1; let y=(let x=2;fun(){x}); y()`).val, new IntValue(BigInt(2)) ); 
}
unittest
{
	assert_eq( evalString(`@a x=1; @b x=2; @a(x)`).val, new IntValue(BigInt(1)) );
	assert_eq( evalString(`@a x=1; @b x=2; @b(x)`).val, new IntValue(BigInt(2)) );
	assert_eq( evalString(`let x=1; let _ = (@a x=2;2); x`).val, new IntValue(BigInt(1)) );
	assert_throw!Throwable( evalString(`let x=1; let _ = (@a x=2;2); @a(x)`) );
}
/*
unittest
{
	assert_eq( evalString(`var fac = fun(x){
		if(x)
			{ x*fac(x-1); }
		else
			{ 1; };
	};
	fac(10);`).val, new IntValue(BigInt(10*9*8*5040)));
	assert_eq( evalString(`var fib = fun(x){
		if(x<2)
			{ 1; }
		else
			{ fib(x-1) + fib(x-2); };
	};
	fib(5);`).val, new IntValue(BigInt(8)));
}

unittest
{
	assert_throw!Throwable( evalString(`@@s(x){x}; @s "+"=fun(x,y){x-y};@s(1+2)`) );
	assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){x-y};1+2`).val, new IntValue(BigInt(3)) );
	assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){@value(@s(x)-@s(y))};1+2`).val, new IntValue(BigInt(3)) );
	assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){@value(@s(x)-@s(y))};@s(1+2)`).val, new IntValue(BigInt(-1)) );
}

unittest
{
	assert_eq( evalString(`@@t = fun(x){x+1}; @t(123)`).val, new IntValue(BigInt(124)) );
	// there was a bug that declaration in the first line of function definition
	// cannot be recursive
	assert_nothrow( evalString(`def foo() {
  def bar(y) { if(y<1) {0} else {bar(0)} };
  bar(1)
}; foo()`) );
}
*/