Artifact Content
Not logged in

Artifact 969111acf2042a227ed03ae4805bfc7fb5dccb4d


/**
 * 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 polemy.value;
import polemy.valueconv;
import std.signals;

/// Objects for maitaining global environment and evaluation of expression on it
class Evaluator
{
public:
	/// Evaluate the AST
	Value evalAST(AST e)
		{ return getLayerEval(ValueLayer).macroAndEval(e, theContext, LayerEval.OverwriteCtx); }

	/// Evaluate the string
	Value evalString(S,T...)(S str, T fn_ln_cn)
		{ return evalAST(parseString(str,fn_ln_cn)); }

	/// Evaluate the file
	Value evalFile(S,T...)(S filename, T ln_cn)
		{ return evalAST(parseFile(filename,ln_cn)); }

	/// Get the global context
	Table globalContext()
		{ return theContext; }

	/// Initialize evaluator with empty context
	this()
	{
		theContext = new Table;
		theLayers[ValueLayer]    = new ValueLayerEval;
		theLayers[MacroLayer]    = new MacroLayerEval;
		theLayers[RawMacroLayer] = new RawMacroLayerEval;
	}

private:
	Table            theContext;
	LayerEval[Layer] theLayers;

	/// Get the layer evaluator from layer ID
	LayerEval getLayerEval(Layer lay)
	{
		if(auto p = lay in theLayers)
			return *p;
		return theLayers[lay] = new UserDefinedLayerEval(lay);
	}

	/// Interface of layers
	abstract class LayerEval
	{
		enum : bool { CascadeCtx=false, OverwriteCtx=true };

		/// Concrete layers should implement these
		protected Layer layerID();
		protected Value eval_( Die e, Table ctx, bool ctxMod );///
		protected Value eval_( Str e, Table ctx, bool ctxMod );///
		protected Value eval_( Int e, Table ctx, bool ctxMod );///
		protected Value eval_( Var e, Table ctx, bool ctxMod );///
		protected Value eval_( Lay e, Table ctx, bool ctxMod );///
		protected Value eval_( Let e, Table ctx, bool ctxMod );///
		protected Value eval_( App e, Table ctx, bool ctxMod );///
		protected Value eval_( Fun e, Table ctx, bool ctxMod );///

		/// Should override this also, if the layer may return null for optimization
		Value evalToNonNull( AST e, Table ctx, bool ctxMod = CascadeCtx )
			{ return eval(e,ctx,ctxMod); }

		/// Do macro expansion first, and then eval. Should override this also if it is NOT macro layer.
		Value macroAndEval( AST e, Table ctx, bool ctxMod = CascadeCtx )
			{ return evalToNonNull(e,ctx,ctxMod); }

		/// dynamic-overload-resolution
		Value eval( AST e, Table ctx, bool ctxMod = CascadeCtx )
		{
			enum funName = "eval_";                 // modify here for customization
			alias TypeTuple!(e,ctx,ctxMod) params;  // modify here for customization

			alias typeof(__traits(getOverloads, this, funName)) ovTypes;
			alias staticMap!(firstParam, ovTypes)              fstTypes;
			alias DerivedToFront!(fstTypes)             fstTypes_sorted;
			foreach(i, T; fstTypes_sorted)
				static if( is(T == typeof(params[0])) ) {} else if( auto _x = cast(T)params[0] )
					return __traits(getOverloads, this, funName)[i](_x, params[1..$]);

			// modify here to customize the default behavior
			assert(false, text("eval() for ",typeid(e)," [",e.pos,"] is not defined"));
		}

		/// Function calling convention.
		/// Run all arugment AST in the appropriate layer and invoke the function.
		Value invokeFunction(Value f_, AST[] args, Table ctx, LexPosition pos, string callstackmsg)
		{
			FunValue f = cast(FunValue)f_;
			if( f is null )
				throw genex!RuntimeException(pos, text("tried to call non-function: ",f));
			if( f.params().length != args.length )
				throw genex!RuntimeException(pos,
					sprintf!("%d arguments required but %d passed")(f.params().length, args.length));

			Table newCtx = new Table(f.definitionContext(), Table.Kind.NotPropagateSet);
			foreach(i,p; f.params())
				if( p.layers.empty )
					newCtx.set(p.name, layerID(), this.evalToNonNull(args[i], ctx));
				else
					foreach(argLay; p.layers)
					{
						Layer ll = argLay;
						if( isMacroLayer(argLay) && typeid(this)!=typeid(MacroLayerEval) )
							ll = RawMacroLayer; // explicit @macro invokes (rawmacro)
						newCtx.set(p.name, argLay, getLayerEval(ll).evalToNonNull(args[i], ctx));
					}
			scope _ = new PushCallStack(pos, callstackmsg);
			return f.invoke(layerID(), newCtx, pos);
		}

		/// Lift the value v to the current layer
		Value lift(Value v, Table ctx, LexPosition pos)
		{
			// functions are automatically lifted by itself
			if( cast(FunValue) v )
				return v;

			Layer lay = layerID();

			// load the lift function
			if( !ctx.has(lay, LiftLayer) )
				throw genex!RuntimeException(pos, "lift function for "~lay~" is not registered" );

			Value    f_ = ctx.get(lay, LiftLayer, pos);
			FunValue f  = cast(FunValue) f_;
			if( f is null )
				throw genex!RuntimeException(pos,
					text("non-function ", f_, " is registered as the lift function for ", lay));
			if( f.params().length != 1 || f.params()[0].layers.length>=1 )
				throw genex!RuntimeException(pos,
					text("lift function must take exactly 1 neutral parameter:",lay));

			// invokeFunction
			Table newCtx = new Table(f.definitionContext(), Table.Kind.NotPropagateSet);
			newCtx.set(f.params()[0].name, ValueLayer, v);
			scope _ = new PushCallStack(pos, "lift to "~lay);
			return f.invoke(ValueLayer, newCtx, pos);
		}
	}

	/// Evaluator for standard @value semantics
	class ValueLayerEval : LayerEval
	{
		override Layer layerID()
		{
			return ValueLayer;
		}
		override Value eval_( Die e, Table ctx, bool ctxMod )
		{
			throw genex!RuntimeException(e.pos, "undefined case");
		}
		override Value eval_( Str e, Table ctx, bool ctxMod )
		{
			return new StrValue(e.data);
		}
		override Value eval_( Int e, Table ctx, bool ctxMod )
		{
			return new IntValue(e.data);
		}
		override Value eval_( Var e, Table ctx, bool ctxMod )
		{
			return ctx.get(e.name, layerID(), e.pos);
		}
		override Value eval_( Lay e, Table ctx, bool ctxMod )
		{
			return getLayerEval(e.layer).evalToNonNull(e.expr, ctx);
		}
		override Value eval_( Let e, Table ctx, bool ctxMod )
		{
			if( !ctxMod )
				ctx = new Table(ctx, Table.Kind.NotPropagateSet);
			Value ri = this.eval(e.vdef, ctx);
			ctx.set(e.name, e.layer.empty ? layerID(): e.layer, ri);
			return this.eval(e.expr, ctx, OverwriteCtx);
		}
		override Value eval_( App e, Table ctx, bool ctxMod )
		{
			Value f = this.eval( e.fun, ctx, CascadeCtx );
			return this.invokeFunction(f, e.args, ctx, e.pos, getNameIfPossible(e.fun));
		}
		override Value eval_( Fun e, Table ctx, bool ctxMod )
		{
			return createNewFunction(e, ctx);
		}
		override Value macroAndEval( AST e, Table ctx, bool ctxMod )
		{
			// incremental execution of let-expressions
			if(auto le = cast(Let)e)
			{
				AST ai = runMacro(le.vdef, ctx);

				if( !ctxMod )
					ctx = new Table(ctx, Table.Kind.NotPropagateSet);

				Value vi = this.eval(ai, ctx);
				ctx.set(le.name, le.layer.empty ? layerID() : le.layer, vi);
				return this.macroAndEval(le.expr, ctx, OverwriteCtx);
			}
			else
				return this.eval(runMacro(e,ctx,ctxMod), ctx, ctxMod);
		}
	}

	/// Evaluator for user-defined layer
	class UserDefinedLayerEval : ValueLayerEval
	{
		Layer theID;
		mixin SimpleConstructor;

		override Layer layerID()
		{
			return theID;
		}
		override Value eval_( Die e, Table ctx, bool ctxMod )
		{
			return this.lift(new BottomValue, ctx, e.pos);
		}
		override Value eval_( Str e, Table ctx, bool ctxMod )
		{
			return this.lift(super.eval_(e,ctx,ctxMod), ctx, e.pos);
		}
		override Value eval_( Int e, Table ctx, bool ctxMod )
		{
			return this.lift(super.eval_(e,ctx,ctxMod), ctx, e.pos);
		}
		override Value eval_( Var e, Table ctx, bool ctxMod )
		{
			if( ctx.has(e.name, layerID()) )
				return ctx.get(e.name, layerID());
			Value v;
			try { v = ctx.get(e.name, ValueLayer, e.pos); }
			catch ( RuntimeException ) {
				throw genex!RuntimeException(e.pos, e.name~" not found in layer "~layerID()~" nor "~ValueLayer);
			}
			return this.lift(v, ctx, e.pos);
		}
	}

	// Macro layer. For optimization, if AST didn't change it returns null
	class MacroLayerEval : LayerEval
	{
		override Layer layerID()
		{
			return MacroLayer;
		}
		override Value evalToNonNull( AST e, Table ctx, bool ctxMod = CascadeCtx )
		{
			Value v = this.eval(e, ctx, ctxMod);
			return v is null ? ast2table(e) : v;
		}
		override Value eval_( Die e, Table ctx, bool ctxMod )
		{
			return null;
		}
		override Value eval_( Str e, Table ctx, bool ctxMod )
		{
			return null;
		}
		override Value eval_( Int e, Table ctx, bool ctxMod )
		{
			return null;
		}
		override Value eval_( Var e, Table ctx, bool ctxMod )
		{
			if( ctx.has(e.name, layerID()) )
				return ctx.get(e.name, layerID(), e.pos);
			return null;
		}
		override Value eval_( Lay e, Table ctx, bool ctxMod )
		{
			return getLayerEval(e.layer).eval(e.expr,ctx);
		}
		override Value eval_( Let e, Table ctx, bool ctxMod )
		{
			if( !ctxMod )
				ctx = new Table(ctx, Table.Kind.NotPropagateSet);

			Value ai = this.eval(e.vdef, ctx);
			ctx.set(e.name, NoopLayer, null);
			Value ae = this.eval(e.expr, ctx, OverwriteCtx);

			if( ai is null && ae is null ) return null;
			if( ai is null ) ai = ast2table(e.vdef);
			if( ae is null ) ae = ast2table(e.expr);

			return ast2table(e, delegate Value (AST _){
				if(_ is e.vdef) { return ai; }
				if(_ is e.expr) { return ae; }
				assert(false);
			});
		}
		override Value eval_( App e, Table ctx, bool ctxMod )
		{
			Value f = this.eval( e.fun, ctx );
			if(auto ff = cast(FunValue)f)
				return this.invokeFunction(ff, e.args, ctx, e.pos, getNameIfPossible(e.fun));
			else
			{
				bool allNull = (f is null);
				Value[] vas;
				foreach(a; e.args)
				{
					Value va = this.eval(a, ctx, CascadeCtx);
					if(va !is null) allNull = false;
					vas ~= va;
				}
				if( allNull )
					return null;
				return ast2table(e, delegate Value (AST _){
					if(_ is e.fun) return (f is null ? ast2table(e.fun) : f);
					foreach(i,a; e.args) if(_ is a) return (vas[i] is null ? ast2table(a) : vas[i]);
					assert(false);
				});
			}
		}
		override Value eval_( Fun e, Table ctx, bool ctxMod )
		{
			ctx = new Table(ctx, Table.Kind.NotPropagateSet);
			foreach(p; e.params)
				ctx.set(p.name, NoopLayer, null);
			Value af = this.eval(e.funbody, ctx);
			if( af is null )
				return null;
			return ast2table(e, (AST _){if(_ is e.funbody)return af; assert(false);});
		}
	}

	/// (rawmacro) layer. almost same as @macro, but the Layer expression becomes AST, too.
	class RawMacroLayerEval : MacroLayerEval
	{
		override Value eval_( Lay e, Table ctx, bool ctxMod )
		{
			Value ae = this.eval(e.expr, ctx);
			return ae is null ? null
			       : ast2table(e, delegate Value (AST _){if(_ is e.expr)return ae; assert(false);});
		}
	}

private: // short utils

	string getNameIfPossible(AST e)
	{
		if(auto v = cast(Var)e)
			return v.name;
		return "";
	}

	AST runMacro(AST e, Table ctx, bool ctxMod=LayerEval.CascadeCtx)
	{
		Value v = getLayerEval(RawMacroLayer).eval(e, ctx, ctxMod);
		return (v is null ? e : polemy2d!(AST)(v, e.pos));
	}

private:
	Value createNewFunction(Fun e, Table ctx)
	{
		class UserDefinedFunValue : FunValue
		{
			Fun   ast;
			Table defCtx;
			override const(Parameter[]) params() { return ast.params; }
			override Table definitionContext()   { return defCtx; }

			this(Fun ast, Table defCtx) { this.ast=ast; this.defCtx=defCtx; }
			override string toString() const
				{ return sprintf!"(function:%x:%x)"(cast(void*)ast, cast(void*)defCtx); }
			override int opCmp(Object rhs) {
				if(auto r = cast(UserDefinedFunValue)rhs) {
					if(auto c = typeid(void*).compare(cast(void*)ast, cast(void*)r.ast))
						return c;
					if(auto c = typeid(void*).compare(cast(void*)defCtx, cast(void*)r.defCtx))
						return c;
					return 0;// [TODO] avoid using pointer value...
				}
				if(auto r = cast(Value)rhs) return typeid(this).opCmp(typeid(r));
				throw genex!RuntimeException("comparison with value and something other");
			}
			override hash_t toHash() {
				return (cast(hash_t)cast(void*)ast) + (cast(hash_t)cast(void*)defCtx);
			}

			AST[void*] mandeCache;
			static class MemokeyType
			{
				void* a; Layer b; Table c;
				mixin SimpleClass;
			}
			static Tuple!(Value,int)[MemokeyType] memo;

			override Value invoke(Layer lay, Table ctx, LexPosition pos)
			{
				auto evlay = getLayerEval(lay);
				auto nonMemoizedRun = (){ return evlay.macroAndEval(ast.funbody, ctx); };

				if( !isUserDefinedLayer(lay) )
					return nonMemoizedRun();

				// automatic memoized co-recursive execution
				MemokeyType memokey = new MemokeyType(cast(void*)ast, lay, ctx);
				if(auto p = memokey in memo)
				{
					if( ++(*p)[1] >= 2 ) // [TODO] is 2 really enough??
						return (*p)[0];
				}
				else
				{
					Value v;
					try { v = evlay.lift(new BottomValue, ctx, pos); } catch { v = new BottomValue; }
					memo[memokey] = tuple(v, 0);
				}

				Value r = nonMemoizedRun();
				memo[memokey] = tuple(r, 9999);
				return r;
			}
		}
		return new UserDefinedFunValue(e,ctx);
	}

public:
	/// Add primitive function to the global context
	void addPrimitive(R,T...)(string name, Layer defLay, R delegate (T) dg)
	{
		class NativeFunValue : FunValue
		{
			override const(Parameter[]) params() { return params_data; }
			override Table definitionContext()   { return theContext; }

			override string toString() { return sprintf!"(native:%x)"(dg.funcptr); }
			override int opCmp(Object rhs) {
				if(auto r = cast(NativeFunValue)rhs) return typeid(typeof(dg)).compare(&dg,&r.dg);
				if(auto r = cast(Value)rhs)          return typeid(this).opCmp(typeid(r));
				throw genex!RuntimeException("comparison with value and something other");
			}
			override hash_t toHash() const {
				return typeid(dg).getHash(&dg);
			}

			R delegate(T) dg;
			Parameter[] params_data;

			this(R delegate(T) dg)
			{
				this.dg = dg;
				foreach(i, Ti; T)
					params_data ~= new Parameter(text(i), []);
			}

			override Value invoke(Layer lay, Table ctx, LexPosition pos)
			{
				if( lay != defLay )
					throw genex!RuntimeException(pos,
						text("only ", defLay, " layer can call native function: ", name));
				T typed_args;
				foreach(i, Ti; T) {
					Value vi = ctx.get(text(i), ValueLayer, pos);
					typed_args[i] = cast(Ti) vi;
					if( typed_args[i] is null )
						throw genex!RuntimeException(pos,
							sprintf!"type mismatch on the argument %d of native function %s. %s required but %s passed."(i+1,name,typeid(Ti),vi));
				}
				try {
					return dg(typed_args);
				} catch( RuntimeException e ) {
					throw e.pos is null ? new RuntimeException(pos, e.msg, e.file, e.line) : e;
				}
			}
		}
		theContext.set(name, defLay, new NativeFunValue(dg));
	}
}

version(unittest)
	import polemy.runtime;

unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	assert_eq( e.evalString(`
@@foo(x){x*2};
@foo "+" (x,y){x};
@foo(3+4)
`), new IntValue(6) );
}

unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	auto r = assert_nothrow( e.evalString(`var x = 21; x + x*x;`) );
	assert_eq( r, new IntValue(BigInt(21+21*21)) );
	assert_eq( e.globalContext.get("x",ValueLayer), new IntValue(BigInt(21)) );
	assert_nothrow( e.globalContext.get("x",ValueLayer) );
	assert_throw!RuntimeException( e.globalContext.get("y",ValueLayer) );
}

unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	auto r = assert_nothrow( e.evalString(`var x = 21; var x = x + x*x;`) );
	assert_eq( r, new IntValue(BigInt(21+21*21)) );
	assert_eq( e.globalContext.get("x",ValueLayer), new IntValue(21+21*21) );
	assert_nothrow( e.globalContext.get("x",ValueLayer) );
	assert_throw!RuntimeException( e.globalContext.get("y",ValueLayer) );
}
unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	assert_eq( e.evalString(`let x=1; let y=(let x=2); x`), new IntValue(1) ); 
	assert_eq( e.evalString(`let x=1; let y=(let x=2;fun(){x}); y()`), new IntValue(2) ); 
}

unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	assert_eq( e.evalString(`@a x=1; @b x=2; @a(x)`), new IntValue(BigInt(1)) );
	assert_eq( e.evalString(`@a x=1; @b x=2; @b(x)`), new IntValue(BigInt(2)) );
	assert_eq( e.evalString(`let x=1; let _ = (@a x=2;2); x`), new IntValue(BigInt(1)) );
	e = new Evaluator;
	assert_throw!Throwable( e.evalString(`let x=1; let _ = (@a x=2;2); @a(x)`) );
}

unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	assert_eq( e.evalString(`
		@@s(x){x};
		@s "+" = fun(x, y) {@value(
			@s(x) - @s(y)
		)};
		@s(1 + 2)
	`), new IntValue(BigInt(-1)) );
}

unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	assert_eq( e.evalString(`
@@3(x){x};
def incr(x) { x+1 };
@ 3 incr(x) {@value( if @ 3(x)+1< 3 then @3(x)+1 else 0 )};
def fb(n @value @3) { @3(n) };
fb(incr(incr(incr(0))))
	`), new IntValue(BigInt(0)) );
}

unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	assert_nothrow( e.evalString(`
@macro twice(x) { x; x };
def main() { twice(1) };
main()
	`) );
}
unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	assert_throw!RuntimeException( e.evalString(`case 1`) );
	assert_nothrow( e.evalString(`case 1 when 1: 2`) );

	// this is a shorthand for
	//   @macro x = fun(){} in @macro(x)
	// so it is ok to fail, but it is really incovenient on REPL
	assert_nothrow( e.evalString(`@macro x=fun(){}`) );
}

unittest
{
	auto e = new Evaluator;
	enrollRuntimeLibrary(e);
	assert_throw!RuntimeException( e.evalString(`...`) );
	assert_eq( e.evalString(`@@foo(x){x}; @foo(...)`), new BottomValue );
}