/**
* 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;
///
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));} ));
ctx.set("_istable", "@v", native( (Value v){return new IntValue(BigInt(cast(Table)v is null ? 0 : 1));} ));
ctx.set(".", "@v", native( (Table t, StrValue s){
return (t.has(s.data, "@v") ? t.get(s.data, "@v") : new UndValue);
}) );
ctx.set(".?", "@v", native( (Table t, StrValue s){
return new IntValue(BigInt(t.has(s.data, "@v") ? 1 : 0));
}) );
ctx.set(".=", "@v", native( (Table t, StrValue s, Value v){
auto t2 = new Table(t, Table.Kind.NotPropagateSet);
t2.set(s.data, "@v", v);
return t2;
}) );
ctx.set("{}", "@v", 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, "@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)
{
if( e.lay == "@macro" )
return macroEval(e.expr, ctx, false);
else
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;
AST macroMemo = null; // cache
// 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" && lay != "@macro" )
{
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]);
// @macro run!!!
if( lay == "@macro" )
return macroEval(e.funbody, ctxNeo, false);
if( macroMemo is null )
macroMemo = tableToAST("@v",macroEval(e.funbody, ctxNeo, true));
auto v = eval(macroMemo, ctxNeo, true, lay);
//auto v = eval(e.funbody, ctxNeo, true, lay);
// auto memoization
if( lay != "@v" && lay != "@macro" )
memo[lay][args] = v;
return v;
});
},
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 = "@v";
Table pos = new Table;
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)));
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.var, "@macro", 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.var));
return cast(Value)t;
}
},
(LayeredExpression 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.lay));
t.set("expr", theLayer, macroEval(e.expr,ctx,AlwaysMacro));
return cast(Value)t;
}
else
{
return eval(e.expr, ctx, true, e.lay);
}
},
(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.var));
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);
// copy & pase from normal eval
// [TODO] sync with @layerd parameters.
if( auto f = cast(FunValue)_f ) {
Value[] args;
foreach(a; e.args)
args ~= macroEval(a, ctx, AlwaysMacro);
return f.call(e.pos, "@macro", args); // explicit @macro is the best???
}
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("arg", 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("body", theLayer, macroEval(e.funbody,ctx,AlwaysMacro));
Table param = new Table;
foreach_reverse(p; e.params)
{
Table cons = new Table;
Table kv = new Table;
kv.set("name", theLayer, new StrValue(p.name));
foreach_reverse(lay; p.layers)
{
Table cons2 = new Table;
cons2.set("car", theLayer, new StrValue(lay));
cons2.set("cdr", theLayer, kv);
kv = cons2;
}
cons.set("car", theLayer, kv);
cons.set("cdr", theLayer, param);
param = cons;
}
t.set("param", theLayer, param);
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","@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(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){@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)) );
}