Artifact Content
Not logged in

Artifact 5c2f449580dd9555da2e3b8cabdf6b154b9b5d46


/**
 * 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.lex : LexPosition;
import polemy.ast;
import polemy.parse;
import polemy.value;
import std.typecons;
import std.stdio;

// [todo] move to value.d

FunValue nativef(Value delegate(immutable LexPosition pos, Layer lay, Value[] args) dg)
{
	return new FunValue(dg);
}

FunValue native(R,T...)(R delegate (T) dg)
{
	return nativef( delegate Value(immutable LexPosition pos, Layer lay, Value[] args) {
		if( lay != "@v" )
			throw genex!RuntimeException(pos, "only @v layer can call native function");
		if( T.length != args.length )
			throw genex!RuntimeException(pos, "argument number mismatch!");
		T typed_args;
		foreach(i, Ti; T)
		{
			typed_args[i] = cast(Ti) args[i];
			if( typed_args[i] is null )
				throw genex!RuntimeException(pos, sprintf!"type mismatch on the argument %d"(i+1));
		}
		try {
			return dg(typed_args);
		} catch( RuntimeException e ) {
			throw e.pos is null ? new RuntimeException(pos, e.msg, e.file, e.line) : e;
		}
	});
}

///
Table createGlobalContext()
{
	auto ctx = new Table;
	ctx.set("+", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data + rhs.data);} ));
	ctx.set("-", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data - rhs.data);} ));
	ctx.set("*", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data * rhs.data);} ));
	ctx.set("/", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data / rhs.data);} ));
	ctx.set("%", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data % rhs.data);} ));
	ctx.set("||", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(BigInt((lhs.data!=0) || (rhs.data!=0) ? 1:0));} ));
	ctx.set("&&", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(BigInt((lhs.data!=0) && (rhs.data!=0) ? 1:0));} ));
	ctx.set("<", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs < rhs ? 1: 0));} ));
	ctx.set(">", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs > rhs ? 1: 0));} ));
	ctx.set("<=", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs <= rhs ? 1: 0));} ));
	ctx.set(">=", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs >= rhs ? 1: 0));} ));
	ctx.set("==", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs == rhs ? 1: 0));} ));
	ctx.set("!=", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs != rhs ? 1: 0));} ));
	ctx.set("print", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
		foreach(a; args)
			write(a);
		writeln("");
		return new IntValue(BigInt(178));
	}));
	ctx.set("if", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
		if( args.length != 3 )
			throw genex!RuntimeException(pos, "if takes three arguments!!");
		if( auto x = cast(IntValue)args[0] )
		if( auto ft = cast(FunValue)args[1] )
		if( auto fe = cast(FunValue)args[2] )
			return (x.data == 0 ? fe : ft).call(pos,lay,[]);
		throw genex!RuntimeException(pos, "type mismatch in if");
	}));
	ctx.set("_isint", "@v", native( (Value v){return new IntValue(BigInt(cast(IntValue)v is null ? 0 : 1));} ));
	ctx.set("_isstr", "@v", native( (Value v){return new IntValue(BigInt(cast(StrValue)v is null ? 0 : 1));} ));
	ctx.set("_isfun", "@v", native( (Value v){return new IntValue(BigInt(cast(FunValue)v is null ? 0 : 1));} ));
	ctx.set("_isundefined", "@v", native( (Value v){return new IntValue(BigInt(cast(UndValue)v is null ? 0 : 1));} ));
	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, "@v"), ctx);
}

/// 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 "@v").

Value eval(AST e, Table ctx, bool splitCtx, Layer lay)
{
	return e.match(
		(StrLiteral e)
		{
			Value v = new StrValue(e.data);
			if( lay == "@v" )
				return v;
			else // rise
				return (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v", [v]);
		},
		(IntLiteral e)
		{
			Value v = new IntValue(e.data);
			if( lay == "@v" )
				return v;
			else // rise
				return (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v", [v]);
		},
		(VarExpression e)
		{
			if( lay == "@v" )
				return ctx.get(e.var, lay, e.pos);
			try {
				return ctx.get(e.var, lay, e.pos);
			} catch( Throwable ) { // [TODO] more precise...
				// rise from @v
				return (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v", 
					[ctx.get(e.var, "@v", e.pos)]
				);
			}
		},
		(LayeredExpression e)
		{
			return eval(e.expr, ctx, false, e.lay);
		},
		(LetExpression e)
		{
			// for letrec, we need this, but should avoid overwriting????
			// ctx.set(e.var, "@v", new UndefinedValue, e.pos);
			Value v = eval(e.init, ctx, true, lay);
			if(splitCtx)
				ctx = new Table(ctx, Table.Kind.NotPropagateSet);
			ctx.set(e.var, (e.layer.length ? e.layer : lay), v, e.pos);
			return eval(e.expr, ctx, false, lay);
		},
		(FuncallExpression e)
		{
			Value _f = eval(e.fun, ctx, true, lay);
			if( auto f = cast(FunValue)_f ) {
				Value[] args;
				foreach(a; e.args)
					args ~= eval(a, ctx, true, lay);
				return f.call(e.pos, lay, args);
			}
			throw genex!RuntimeException(e.pos, "Non-funcion is applied");
		},
		(FunLiteral e)
		{
			Value[Value[]][Layer] memo;

			// funvalue need not be rised
			// no, need to be rised !!  suppose @t(fib)("int")
			return new FunValue(delegate Value(immutable LexPosition pos, string lay, Value[] args){
				// TODO: only auto raised ones need memo? no?
				// auto memoization
				if( lay != "@v" )
				{
					if( auto memolay = lay in memo )
						if( auto pv = args in *memolay )
							return *pv;
					memo[lay][args] = (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v", 
						[new UndValue]
					);
				}
				
				if( e.params.length != args.length )
					throw genex!RuntimeException(e.pos, sprintf!"Argument Number Mismatch (%d required but %d given)"
						(e.params.length, args.length));
				Table ctxNeo = new Table(ctx, Table.Kind.NotPropagateSet);
				foreach(i,p; e.params)
					ctxNeo.set(p.name, lay, args[i]);
				auto v = eval(e.funbody, ctxNeo, true, lay);
				// auto memoization
				if( lay != "@v" )
					memo[lay][args] = v;
				return v;
			});
		},
		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","@v"), new IntValue(BigInt(21)) );
	assert_nothrow( r.ctx.get("x","@v") );
	assert_throw!RuntimeException( r.ctx.get("y","@v") );
}
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","@v"), new IntValue(BigInt(21+21*21)) );
	assert_nothrow( r.ctx.get("x","@v") );
	assert_throw!RuntimeException( r.ctx.get("y","@v") );
}
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(10);`).val, new IntValue(BigInt(89)));
}

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){@v(@s(x)-@s(y))};1+2`).val, new IntValue(BigInt(3)) );
	assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){@v(@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)) );
}