Index: .poseidon
==================================================================
--- .poseidon
+++ .poseidon
@@ -37,10 +37,11 @@
<name>polemy\failure.d</name>
<name>polemy\fresh.d</name>
<name>polemy\layer.d</name>
<name>polemy\lex.d</name>
<name>polemy\parse.d</name>
+ <name>polemy\runtime.d</name>
<name>polemy\value.d</name>
<name>tricks\test.d</name>
<name>tricks\tricks.d</name>
</source>
<interface />
Index: doc/candydoc/modules.ddoc
==================================================================
--- doc/candydoc/modules.ddoc
+++ doc/candydoc/modules.ddoc
@@ -8,6 +8,7 @@
$(MODULE polemy.fresh)
$(MODULE polemy.lex)
$(MODULE polemy.parse)
$(MODULE polemy.ast)
$(MODULE polemy.eval)
+ $(MODULE polemy.runtime)
$(MODULE polemy.value)
Index: main.d
==================================================================
--- main.d
+++ main.d
@@ -8,27 +8,28 @@
import std.stdio;
import std.algorithm;
import std.array;
import polemy.value;
import polemy.failure;
+import polemy.layer;
import polemy.parse;
import polemy.ast;
import polemy.eval;
-import polemy.layer;
enum VersionNoMajor = 0;
enum VersionNoMinor = 1;
enum VersionNoRev = 0;
/// Read-Eval-Print-Loop
class REPL
{
+Evaluator ev;
/// Load the prelude environment
this()
{
- ctx = createGlobalContext();
+ ev = new Evaluator;
}
/// Print the version number etc.
void greet()
{
@@ -36,11 +37,11 @@
}
/// Run one file on the global scope
void runFile(string filename)
{
- eval(parseFile(filename), ctx, false, ValueLayer);
+ ev.evalFile(filename);
}
/// Repeat the singleInteraction
void replLoop()
{
@@ -76,11 +77,11 @@
{ buf = ""; lineno = nextlineno; }
buf ~= s;
nextlineno ++;
try
- { lastVal = eval(parseString(buf, "<REPL>", lineno), ctx, false, ValueLayer); }
+ { lastVal = ev.evalString(buf, "<REPL>", lineno); }
catch( UnexpectedEOF )
{ return false; } // wait
buf = "";
lineno = nextlineno;
return true;
Index: polemy/_common.d
==================================================================
--- polemy/_common.d
+++ polemy/_common.d
@@ -12,5 +12,7 @@
public import std.bigint;
public import std.conv : text;
public import std.exception;
public import std.range;
public import std.stdio : DBG = writeln;
+public import std.typecons;
+public import std.typetuple;
Index: polemy/ast.d
==================================================================
--- polemy/ast.d
+++ polemy/ast.d
@@ -16,11 +16,11 @@
mixin SimpleConstructor;
mixin SimplePatternMatch;
}
///
-class IntLiteral : AST
+class Int : AST
{
BigInt data;
mixin SimpleClass;
this(LexPosition pos, int n) {super(pos); data = n;}
this(LexPosition pos, long n) {super(pos); data = n;}
@@ -27,43 +27,43 @@
this(LexPosition pos, BigInt n) {super(pos); data = n;}
this(LexPosition pos, string n) {super(pos); data = BigInt(n);}
}
///
-class StrLiteral : AST
+class Str : AST
{
string data;
mixin SimpleClass;
}
///
-class VarExpression : AST
+class Var : AST
{
string name;
mixin SimpleClass;
}
///
-class LayExpression : AST
+class Lay : AST
{
Layer layer;
AST expr;
mixin SimpleClass;
}
///
-class LetExpression : AST
+class Let : AST
{
string name;
Layer layer;
AST init;
AST expr;
mixin SimpleClass;
}
///
-class FuncallExpression : AST
+class App : AST
{
AST fun;
AST[] args;
this(LexPosition pos, AST fun, AST[] args...)
{ super(pos); this.fun=fun; this.args=args.dup; }
@@ -77,11 +77,11 @@
Layer[] layers;
mixin SimpleClass;
}
///
-class FunLiteral : AST
+class Fun : AST
{
Parameter[] params;
AST funbody;
mixin SimpleClass;
}
@@ -93,16 +93,16 @@
{
///
template genEast(T)
{ T genEast(P...)(P ps) { return new T(LexPosition.dummy, ps); } }
- alias genEast!StrLiteral strl; ///
- alias genEast!IntLiteral intl; ///
+ alias genEast!Str strl; ///
+ alias genEast!Int intl; ///
auto fun(string[] xs, AST ps) {
- return genEast!FunLiteral(array(map!((string x){return new Parameter(x,[]);})(xs)),ps); }
- auto funp(Parameter[] xs, AST ps) { return genEast!FunLiteral(xs,ps); } ///
- alias genEast!VarExpression var; ///
- alias genEast!LayExpression lay; ///
- alias genEast!LetExpression let; ///
- alias genEast!FuncallExpression call; ///
+ return genEast!Fun(array(map!((string x){return new Parameter(x,[]);})(xs)),ps); }
+ auto funp(Parameter[] xs, AST ps) { return genEast!Fun(xs,ps); } ///
+ alias genEast!Var var; ///
+ alias genEast!Lay lay; ///
+ alias genEast!Let let; ///
+ alias genEast!App call; ///
auto param(string name, string[] lay...) { return new Parameter(name, lay); } ///
}
Index: polemy/eval.d
==================================================================
--- polemy/eval.d
+++ polemy/eval.d
@@ -1,389 +1,425 @@
-/**
- * Authors: k.inaba
- * License: NYSL 0.9982 http://www.kmonos.net/nysl/
- *
- * Evaluator for Polemy programming language.
- */
-module polemy.eval;
-import polemy._common;
+/**
+ * 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.ast;
+import polemy.parse;
+import polemy.value;
import polemy.layer;
-import std.typecons;
-import std.stdio;
-///
-Table createGlobalContext()
+class Evaluator
{
- 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)
+public:
+ this() { theContext = new Table; }
+
+ Value evalAST(AST e)
+ {
+ return eval(e, ValueLayer, theContext, OverwriteCtx);
+ }
+
+ Value evalString(S,T...)(S str, T fn_ln_cn)
+ {
+ return evalAST(parseString(str,fn_ln_cn));
+ }
+
+ Value evalFile(S,T...)(S filename, T ln_cn)
+ {
+ return evalAST(parseFile(filename,ln_cn));
+ }
+
+ Table globalContext()
+ {
+ return theContext;
+ }
+
+private:
+ Table theContext;
+
+private:
+ enum : bool { CascadeCtx=false, OverwriteCtx=true };
+
+ Value eval( AST e, Layer lay, Table ctx, bool overwriteCtx=CascadeCtx )
+ {
+ // dynamic-overload-resolution-pattern: modify here
+ enum funName = "eval";
+ alias TypeTuple!(e,lay,ctx,overwriteCtx) params;
+
+ // dynamic-overload-resolution-pattern: dispatch
+ 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..$]);
+
+ // dynamic-overload-resolution-pattern: default behavior
+ assert(false, text("eval() for ",typeid(e)," [",e.pos,"] is not defined"));
+ }
+
+private:
+ Value eval( Str e, Layer lay, Table ctx, bool overwriteCtx=CascadeCtx )
+ {
+ Value v = new StrValue(e.data);
+ if( lay==RawMacroLayer || lay==MacroLayer )
+ {
+ auto ast = new Table;
+ ast.set("pos", ValueLayer, fromPos(e.pos));
+ ast.set("is", ValueLayer, new StrValue("str"));
+ ast.set("data", ValueLayer, v);
+ return ast;
+ }
+ if( lay==ValueLayer )
+ return v;
+ return lift(v, lay, ctx, e.pos);
+ }
+
+ Value eval( Int e, Layer lay, Table ctx, bool overwriteCtx=CascadeCtx )
+ {
+ Value v = new IntValue(e.data);
+ if( lay==RawMacroLayer || lay==MacroLayer )
+ {
+ auto ast = new Table;
+ ast.set("pos", ValueLayer, fromPos(e.pos));
+ ast.set("is", ValueLayer, new StrValue("int"));
+ ast.set("data", ValueLayer, v);
+ return ast;
+ }
+ if( lay==ValueLayer )
+ return v;
+ return lift(v, lay, ctx, e.pos);
+ }
+
+ Value eval( Var e, Layer lay, Table ctx, bool overwriteCtx=CascadeCtx )
+ {
+ if( lay==RawMacroLayer || lay==MacroLayer )
+ {
+ if( ctx.has(e.name,MacroLayer) )
+ return ctx.get(e.name, MacroLayer, e.pos);
+ auto ast = new Table;
+ ast.set("pos", ValueLayer, fromPos(e.pos));
+ ast.set("is", ValueLayer, new StrValue("var"));
+ ast.set("name", ValueLayer, new StrValue(e.name));
+ return ast;
+ }
+ if( lay==ValueLayer || ctx.has(e.name, lay) )
+ return ctx.get(e.name, lay, e.pos);
+ return lift(ctx.get(e.name, ValueLayer, e.pos), lay, ctx, e.pos);
+ }
+
+ Value eval( App e, Layer lay, Table ctx, bool overwriteCtx=CascadeCtx )
+ {
+ Value f = eval( e.fun, lay, ctx );
+ if( lay==RawMacroLayer || lay==MacroLayer )
+ {
+ if( auto ff = cast(FunValue)f )
+ return invokeFunction(ff, e.args, MacroLayer, ctx, e.pos);
+ Table ast = new Table;
+ ast.set("pos", ValueLayer, fromPos(e.pos));
+ ast.set("is", ValueLayer, new StrValue("app"));
+ ast.set("fun", ValueLayer, f);
+ Table args = new Table;
+ foreach_reverse(a; e.args)
+ args = makeCons(eval(a, lay, ctx), args);
+ ast.set("args", ValueLayer, args);
+ return ast;
+ }
+ else
+ {
+ return invokeFunction(f, e.args, lay, ctx, e.pos);
+ }
+ }
+
+ Value eval( Fun e, Layer lay, Table ctx, bool overwriteCtx=CascadeCtx )
+ {
+ if( lay==RawMacroLayer || lay==MacroLayer )
+ {
+ Table t = new Table;
+ t.set("pos", ValueLayer, fromPos(e.pos));
+ t.set("is", ValueLayer, new StrValue("fun"));
+ t.set("funbody", ValueLayer, eval(e.funbody,lay,ctx));
+ Table params = new Table;
+ foreach_reverse(p; e.params)
+ {
+ Table lays = new Table;
+ foreach_reverse(l; p.layers)
+ lays = makeCons(new StrValue(l), lays);
+ Table kv = new Table;
+ kv.set("name", ValueLayer, new StrValue(p.name));
+ kv.set("layers", ValueLayer, lays);
+ Table cons = new Table;
+ params = makeCons(kv, params);
+ }
+ t.set("params", ValueLayer, params);
+ return t;
+ }
+ else
+ {
+ return createNewFunction(e, ctx);
+ }
+ }
+
+ Value eval( Lay e, Layer lay, Table ctx, bool overwriteCtx=CascadeCtx )
{
- 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);
+ if( lay == RawMacroLayer )
+ {
+ Value r = eval(e.expr, lay, ctx);
+ auto ast = new Table; // todo: pos
+ ast.set("pos", ValueLayer, fromPos(e.pos));
+ ast.set("is", ValueLayer, new StrValue("lay"));
+ ast.set("layer", ValueLayer, new StrValue(e.layer));
+ ast.set("expr", ValueLayer, r);
+ return ast;
+ }
+ else
+ return eval(e.expr, e.layer, ctx);
}
- throw genex!RuntimeException(pos, "tried to call non-function");
-}
-
-Value lift(in LexPosition pos, Value v, Layer lay, Table callerCtx)
-{
- // functions are automatically lifterd
- if( cast(FunValue) v )
- return v;
- // 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)
+ Value eval( Let e, Layer lay, Table ctx, bool overwriteCtx=CascadeCtx )
{
- 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 )
+ // todo @macro let
+ if( lay==RawMacroLayer || lay==MacroLayer )
{
- ctx.set(ps[0].name, ValueLayer, v);
- return f.invoke(pos, ValueLayer, ctx);
+ auto ast = new Table; // todo: pos
+ ast.set("pos", ValueLayer, fromPos(e.pos));
+ ast.set("is", ValueLayer, new StrValue("let"));
+ ast.set("name", ValueLayer, new StrValue(e.name));
+ ast.set("layer", ValueLayer, new StrValue(e.layer));
+ ast.set("init", ValueLayer, eval(e.init, lay, ctx));
+ ast.set("expr", ValueLayer, eval(e.expr, lay, ctx));
+ return ast;
}
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);
- if( ctx.has(e.name, lay, e.pos) )
- return ctx.get(e.name, lay, e.pos);
- else
- 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)
+ if( !overwriteCtx )
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 ri = eval(e.init, lay, ctx);
+ string theLayer = e.layer.empty ? (lay==RawMacroLayer ? MacroLayer : lay) : e.layer;
+ ctx.set(e.name, theLayer, ri);
+ return eval(e.expr, lay, ctx, OverwriteCtx);
+ }
+ }
+
+private:
+ Value invokeFunction(Value _f, AST[] args, Layer lay, Table ctx, LexPosition pos=null)
+ {
+ if(auto f = cast(FunValue)_f)
{
- return new UserDefinedFunValue(e, ctx);
- },
- delegate Value (AST e)
- {
- throw genex!RuntimeException(e.pos, sprintf!"Unknown Kind of Expression %s"(typeid(e)));
+ Table newCtx = new Table(f.definitionContext(), Table.Kind.NotPropagateSet);
+ foreach(i,p; f.params())
+ if( p.layers.empty )
+ newCtx.set(p.name, (lay==RawMacroLayer ? MacroLayer : lay), eval(args[i], lay, ctx));
+ else
+ foreach(argLay; p.layers)
+ newCtx.set(p.name, argLay, eval(args[i], argLay, ctx));
+ return f.invoke(pos, lay, newCtx);
}
- );
-}
+ throw genex!RuntimeException(pos, text("tried to call non-function: ",_f));
+ }
-// [TODO] Optimization
-Value macroEval(AST e, Table ctx, bool AlwaysMacro)
-{
- Layer theLayer = ValueLayer;
-
- Table makeCons(Value a, Value d)
+ Value lift(Value v, Layer lay, Table ctx, LexPosition pos=null)
{
- Table t = new Table;
- t.set("car", theLayer, a);
- t.set("cdr", theLayer, d);
- return t;
+ // functions are automatically lifterd
+ if( cast(FunValue) v )
+ return v;
+
+ // similar to invoke Function, but with only one argument bound to ValueLayer
+ if(auto f = cast(FunValue)ctx.get(lay, SystemLayer, pos))
+ {
+ Table newCtx = 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 )
+ {
+ newCtx.set(ps[0].name, ValueLayer, v);
+ return f.invoke(pos, ValueLayer, newCtx);
+ }
+ else
+ throw genex!RuntimeException(pos, "lift function must take exactly one argument at "~ValueLayer~" layer");
+ }
+ throw genex!RuntimeException(pos, "tried to call non-function");
}
- 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)
+ Value createNewFunction(Fun e, Table ctx)
+ {
+ class UserDefinedFunValue : FunValue
{
- 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)
- {
- if( ctx.has(e.name, MacroLayer, e.pos) )
- return ctx.get(e.name, MacroLayer, e.pos);
- else {
- 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;
+ 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 bool opEquals(Object rhs_) const /// member-by-member equality
+ {
+ if( auto rhs = cast(typeof(this))rhs_ )
+ return this.ast==rhs.ast && this.defCtx==rhs.defCtx;
+ assert(false, sprintf!"Cannot compare %s with %s"(typeid(this), typeid(rhs_)));
+ }
+ override hash_t toHash() const /// member-by-member hash
+ {
+ return typeid(this.ast).getHash(&this.ast) + typeid(this.defCtx).getHash(&this.defCtx);
}
- },
- (LayExpression e)
- {
- if( AlwaysMacro )
+ override int opCmp(Object rhs_) /// member-by-member compare
{
- 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;
+ if( auto rhs = cast(typeof(this))rhs_ )
+ {
+ if(auto i = this.ast.opCmp(rhs.ast))
+ return i;
+ return this.defCtx.opCmp(rhs.defCtx);
+ }
+ assert(false, sprintf!"Cannot compare %s with %s"(typeid(this), typeid(rhs_)));
}
- else
+
+ override Value invoke(LexPosition pos, Layer lay, Table ctx)
{
- if( e.layer == MacroLayer )
- return macroEval(e.expr, ctx, false);
- else
- return eval(e.expr, ctx, true, e.layer);
+ if( lay == MacroLayer )
+ return eval(ast.funbody, lay, ctx);
+ auto macroed = tableToAST(ValueLayer, eval(e.funbody, RawMacroLayer, ctx));
+ return eval(macroed, lay, ctx);
}
- },
- (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)
+ }
+ return new UserDefinedFunValue(e,ctx);
+ }
+
+public:
+ /// TODO: move up
+ /// TDOO: to other layers?
+ void addPrimitive(R,T...)(string name, Layer lay, R delegate (T) dg)
+ {
+ class NativeFunValue : FunValue
{
- 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;
+ Parameter[] params_data;
+ override string toString() { return sprintf!"(native:%x)"(dg.funcptr); }
+ override const(Parameter[]) params() { return params_data; }
+ override Table definitionContext() { return new Table; } // todo: cache
+ this(){
+ foreach(i, Ti; T)
+ params_data ~= new Parameter(text(i), []);
+ }
+ override Value invoke(LexPosition pos, Layer lay, Table ctx)
+ {
+ if( lay != ValueLayer )
+ throw genex!RuntimeException(pos, "only "~ValueLayer~" layer can call native function");
+ T typed_args;
+ foreach(i, Ti; T) {
+ typed_args[i] = cast(Ti) ctx.get(text(i), ValueLayer);
+ 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;
+ }
}
- 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)));
}
- );
+ theContext.set(name, lay, new NativeFunValue);
+ }
+}
+
+version(unittest) import polemy.runtime;
+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(BigInt(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(BigInt(1)) );
+ assert_eq( e.evalString(`let x=1; let y=(let x=2;fun(){x}); y()`), new IntValue(BigInt(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 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) );
+ 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){@ 3(x)+1}else{0} )};
+def fb(n @value @3) { @3(n) };
+fb(incr(incr(incr(0))))
+ `), new IntValue(BigInt(0)) );
}
-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)) );
+ auto e = new Evaluator;
+ enrollRuntimeLibrary(e);
+ assert_nothrow( e.evalString(`
+@macro twice(x) { x; x };
+def main() { twice(1) };
+main()
+ `) );
}
-
+/*
+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_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
Index: polemy/layer.d
==================================================================
--- polemy/layer.d
+++ polemy/layer.d
@@ -12,9 +12,10 @@
alias string Layer;
enum : Layer
{
- SystemLayer = "(system)", /// Predefined layer for internal data
- ValueLayer = "@value", /// Predefined layer for normal run
- MacroLayer = "@macro", /// Predefined layer for macro run
+ SystemLayer = "(system)", /// Predefined layer for internal data
+ ValueLayer = "@value", /// Predefined layer for normal run
+ MacroLayer = "@macro", /// Predefined layer for macro run
+ RawMacroLayer = "(rawmacro)", /// Predefined layer for raw-macro run
}
Index: polemy/parse.d
==================================================================
--- polemy/parse.d
+++ polemy/parse.d
@@ -100,14 +100,14 @@
auto e = tryEat("(")
? parseLambdaAfterOpenParen(pos) // let var ( ...
: (eat("=", "after "~kwd), E(0)); // let var = ...
if( moreDeclarationExists() )
- return new LetExpression(pos, var, SystemLayer, e, Body());
+ return new Let(pos, var, SystemLayer, e, Body());
else
- return new LetExpression(pos, var, SystemLayer, e,
- new LayExpression(pos, SystemLayer, new VarExpression(pos, var))
+ return new Let(pos, var, SystemLayer, e,
+ new Lay(pos, SystemLayer, new Var(pos, var))
);
}
else
{
string kwd = layer;
@@ -119,13 +119,13 @@
auto e = tryEat("(")
? parseLambdaAfterOpenParen(varpos) // let var ( ...
: (eat("=", "after "~kwd), E(0)); // let var = ...
if( moreDeclarationExists() )
- return new LetExpression(pos, var, layer, e, Body());
+ return new Let(pos, var, layer, e, Body());
else
- return new LetExpression(pos, var, layer, e, new VarExpression(varpos, var));
+ return new Let(pos, var, layer, e, new Var(varpos, var));
}
}
AST TopLevelExpression()
{
@@ -132,11 +132,11 @@
/// TopLevelExpression ::= Expression ([";"|"in"] Body?)?
auto pos = currentPosition();
auto e = E(0);
if( moreDeclarationExists() )
- return new LetExpression(pos, "_", "", e, Body());
+ return new Let(pos, "_", "", e, Body());
else
return e;
}
private bool moreDeclarationExists()
@@ -179,14 +179,14 @@
auto pos = currentPosition();
foreach(op; operator_perferences[level])
if( tryEat(op) )
if( op[0]=='.' )
return rec(
- new FuncallExpression(lhs.pos, new VarExpression(pos, op), lhs, parseId()));
+ new App(lhs.pos, new Var(pos, op), lhs, parseId()));
else
- return rec(
- new FuncallExpression(lhs.pos, new VarExpression(pos, op), lhs, E(level+1)));
+ return rec(
+ new App(lhs.pos, new Var(pos, op), lhs, E(level+1)));
return lhs;
}
if( operator_perferences.length <= level )
return Funcall();
@@ -211,11 +211,11 @@
if( !tryEat(",") ) {
eat(")", "after function parameters");
break;
}
}
- e = new FuncallExpression(e.pos, e, args);
+ e = new App(e.pos, e, args);
}
else if( tryEat("{") )
{
e = parseTableSetAfterBrace(e);
}
@@ -232,12 +232,12 @@
for(;;)
{
string key = eatId("for table key", AllowQuoted);
eat(":", "after table key");
AST val = E(0);
- e = new FuncallExpression(pos, new VarExpression(pos,".="),
- e, new StrLiteral(pos,key), val);
+ e = new App(pos, new Var(pos,".="),
+ e, new Str(pos,key), val);
if( !tryEat(",") )
{
eat("}", "for the end of table literal");
break;
}
@@ -252,34 +252,34 @@
auto pos = lex.front.pos;
if( lex.front.quoted )
{
scope(exit) lex.popFront;
- return new StrLiteral(pos, lex.front.str);
+ return new Str(pos, lex.front.str);
}
if( isNumber(lex.front.str) )
{
scope(exit) lex.popFront;
- return new IntLiteral(pos, BigInt(cast(string)lex.front.str));
+ return new Int(pos, BigInt(cast(string)lex.front.str));
}
if( tryEat("@") )
{
auto lay = "@"~eatId("for layer ID");
eat("(", "for layered execution");
auto e = Body();
eat(")", "after "~lay~"(...");
- return new LayExpression(pos, lay, e);
+ return new Lay(pos, lay, e);
}
if( tryEat("(") )
{
auto e = Body();
eat(")", "after parenthesized expression");
return e;
}
if( tryEat("{") )
{
- AST e = new FuncallExpression(pos, new VarExpression(pos,"{}"));
+ AST e = new App(pos, new Var(pos,"{}"));
return parseTableSetAfterBrace(e);
}
if( tryEat("if") )
{
eat("(", "after if");
@@ -294,15 +294,15 @@
if( tryEat("else") ) {
eat("{", "after else");
el = Body();
eat("}", "after else body");
}
- return new FuncallExpression(pos,
- new VarExpression(pos, "if"),
+ return new App(pos,
+ new Var(pos, "if"),
cond,
- new FunLiteral(thenPos, [], th),
- new FunLiteral(elsePos, [], el)
+ new Fun(thenPos, [], th),
+ new Fun(elsePos, [], el)
);
}
if( tryEat("case") )
{
return parsePatternMatch(pos);
@@ -311,11 +311,11 @@
{
eat("(", "after fun");
return parseLambdaAfterOpenParen(pos);
}
scope(exit) lex.popFront;
- return new VarExpression(pos, lex.front.str);
+ return new Var(pos, lex.front.str);
}
AST parsePatternMatch(LexPosition pos)
{
// case( pmExpr )cases
@@ -325,12 +325,12 @@
AST pmExpr = E(0);
eat(")", "after case");
string pmVar = freshVarName();
string pmTryFirst = freshVarName();
AST pmBody = parsePatternMatchCases(pmVar, pmTryFirst,
- new FuncallExpression(pos, new VarExpression(pos, pmTryFirst)));
- return new LetExpression(pos, pmVar, [], pmExpr, pmBody);
+ new App(pos, new Var(pos, pmTryFirst)));
+ return new Let(pos, pmVar, [], pmExpr, pmBody);
}
AST parsePatternMatchCases(string pmVar, string tryThisBranchVar, AST thenDoThis)
{
// when( pat ) { cBody }
@@ -345,25 +345,25 @@
eat("(", "after when");
auto pr = parsePattern();
eat(")", "after when");
eat("{", "after pattern");
AST cBody = Body();
- AST judgement = new FuncallExpression(pos, new VarExpression(pos, "if"),
- ppTest(pmVar, pr), new FunLiteral(pos,[],ppBind(pmVar, pr, cBody)),
- new VarExpression(pos, failBranchVar));
+ AST judgement = new App(pos, new Var(pos, "if"),
+ ppTest(pmVar, pr), new Fun(pos,[],ppBind(pmVar, pr, cBody)),
+ new Var(pos, failBranchVar));
eat("}", "after pattern clause");
return parsePatternMatchCases(pmVar, failBranchVar,
- new LetExpression(pos, tryThisBranchVar, [],
- new FunLiteral(pos,[],judgement), thenDoThis)
+ new Let(pos, tryThisBranchVar, [],
+ new Fun(pos,[],judgement), thenDoThis)
);
}
else
{
auto pos = currentPosition();
- AST doNothing = new FunLiteral(pos,[],
- new StrLiteral(pos, sprintf!"(pattern match failure:%s)"(pos)));
- return new LetExpression(currentPosition(), tryThisBranchVar, [], doNothing, thenDoThis);
+ AST doNothing = new Fun(pos,[],
+ new Str(pos, sprintf!"(pattern match failure:%s)"(pos)));
+ return new Let(currentPosition(), tryThisBranchVar, [], doNothing, thenDoThis);
}
}
// hageshiku tenuki
abstract class SinglePattern
@@ -370,31 +370,31 @@
{
string[] path;
mixin SimpleClass;
private AST access(string pmVar, string[] path) {
auto pos = currentPosition();
- AST e = new VarExpression(pos, pmVar);
+ AST e = new Var(pos, pmVar);
foreach(p; path)
- e = new FuncallExpression(pos, new VarExpression(pos, "."), e, new StrLiteral(pos, p));
+ e = new App(pos, new Var(pos, "."), e, new Str(pos, p));
return e;
}
private AST has(AST e, string k) {
auto pos = currentPosition();
return opAndAnd(
- new FuncallExpression(pos, new VarExpression(pos, "_istable"), e),
- new FuncallExpression(pos, new VarExpression(pos, ".?"), e, new StrLiteral(pos, k))
+ new App(pos, new Var(pos, "_istable"), e),
+ new App(pos, new Var(pos, ".?"), e, new Str(pos, k))
);
}
private AST opAndAnd(AST a, AST b) {
if( a is null ) return b;
if( b is null ) return a;
auto pos = currentPosition();
- return new FuncallExpression(pos,
- new VarExpression(pos, "if"),
+ return new App(pos,
+ new Var(pos, "if"),
a,
- new FunLiteral(pos, [], b),
- new FunLiteral(pos, [], new IntLiteral(pos, 0))
+ new Fun(pos, [], b),
+ new Fun(pos, [], new Int(pos, 0))
);
}
AST ppTest(string pmVar) {
AST c = null;
for(int i=0; i<path.length; ++i)
@@ -411,21 +411,21 @@
{
string name;
mixin SimpleClass;
AST ppBind(string pmVar, AST thenDoThis) {
auto pos = currentPosition();
- return new LetExpression(pos, name, [], access(pmVar,path), thenDoThis);
+ return new Let(pos, name, [], access(pmVar,path), thenDoThis);
}
}
class ConstantPattern : SinglePattern
{
AST e;
mixin SimpleClass;
AST ppTest(string pmVar) {
auto pos = currentPosition();
return opAndAnd( super.ppTest(pmVar),
- new FuncallExpression(pos, new VarExpression(pos,"=="), access(pmVar,path), e)
+ new App(pos, new Var(pos,"=="), access(pmVar,path), e)
);
}
}
SinglePattern[] parsePattern(string[] path = null)
@@ -443,11 +443,11 @@
}
}
else
{
AST e = E(0);
- if(auto ev = cast(VarExpression)e)
+ if(auto ev = cast(Var)e)
if(ev.name == "_")
result ~= new WildPattern(path);
else
result ~= new VarPattern(path, ev.name);
else
@@ -462,13 +462,13 @@
AST cond = null;
foreach(p; pats) {
AST c2 = p.ppTest(pmVar);
if( c2 !is null )
cond = cond is null ? c2
- : new FuncallExpression(pos, new VarExpression(pos,"&&"), cond, c2);
+ : new App(pos, new Var(pos,"&&"), cond, c2);
}
- return cond is null ? new IntLiteral(currentPosition(), 1) : cond;
+ return cond is null ? new Int(currentPosition(), 1) : cond;
}
AST ppBind(string pmVar, SinglePattern[] pats, AST thenDoThis)
{
foreach(p; pats)
@@ -477,11 +477,11 @@
}
AST parseId()
{
scope(exit) lex.popFront;
- return new StrLiteral(currentPosition(), lex.front.str);
+ return new Str(currentPosition(), lex.front.str);
}
AST parseLambdaAfterOpenParen(immutable LexPosition pos)
{
Parameter[] params;
@@ -494,11 +494,11 @@
}
}
eat("{", "after function parameters");
auto funbody = Body();
eat("}", "after function body");
- return new FunLiteral(pos, params, funbody);
+ return new Fun(pos, params, funbody);
}
Parameter parseParam()
{
string var;
@@ -556,11 +556,11 @@
return lex.front.str;
}
AST doNothingExpression()
{
- return new StrLiteral(currentPosition(), "(empty function body)");
+ return new Str(currentPosition(), "(empty function body)");
}
immutable(LexPosition) currentPosition()
{
return lex.empty ? null : lex.front.pos;
Index: polemy/value.d
==================================================================
--- polemy/value.d
+++ polemy/value.d
@@ -45,137 +45,11 @@
///
abstract class FunValue : Value
{
const(Parameter[]) params();
Table definitionContext();
- Value invoke(in LexPosition pos, Layer lay, Table ctx);
-}
-
-import polemy.eval; // circular...
-version = MacroCache;
-//version = AutoMemoization;
-//version = AutoRerun;
-
-///
-class UserDefinedFunValue : FunValue
-{
- FunLiteral ast;
- Table defCtx;
-
- this(FunLiteral 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 bool opEquals(Object rhs_) const /// member-by-member equality
- {
- if( auto rhs = cast(typeof(this))rhs_ )
- return this.ast==rhs.ast && this.defCtx==rhs.defCtx;
- assert(false, sprintf!"Cannot compare %s with %s"(typeid(this), typeid(rhs_)));
- }
- override hash_t toHash() const /// member-by-member hash
- {
- return typeid(this.ast).getHash(&this.ast) + typeid(this.defCtx).getHash(&this.defCtx);
- }
- override int opCmp(Object rhs_) /// member-by-member compare
- {
- if( auto rhs = cast(typeof(this))rhs_ )
- {
- if(auto i = this.ast.opCmp(rhs.ast))
- return i;
- return this.defCtx.opCmp(rhs.defCtx);
- }
- assert(false, sprintf!"Cannot compare %s with %s"(typeid(this), typeid(rhs_)));
- }
-
- private AST preprocessed_funbody;
- private Value[Value[]][Layer] memo;
-
- override const(Parameter[]) params() { return ast.params; }
- override Table definitionContext() { return defCtx; }
- override Value invoke(in LexPosition pos, Layer lay, Table ctx)
- {
- // TODO: only auto raised ones need memo? no?
- // how can we integrate re-run ??
- version(AutoMemoization)
- {
- Value[] memokey;
- if( lay != ValueLayer && lay != MacroLayer )
- {
- foreach(i,p; ast.params)
- memokey ~= ctx.get(p.name, lay); // lay?
- if( auto memolay = lay in memo )
- if( auto pv = memokey in *memolay )
- return *pv;
- memo[lay][memokey] = lift(ast.pos,new UndValue,lay,ctx);
- }
- }
-
- // @macro run!!!
- if( lay == MacroLayer )
- return macroEval(ast.funbody, ctx, false);
-
- version(MacroCache) {
- if( preprocessed_funbody is null ) {
- // .prototype!, forced macro cannot access parameters
- ctx.kill = true; scope(exit)ctx.kill=false;
- preprocessed_funbody = tableToAST(ValueLayer,macroEval(ast.funbody, ctx, true));
- }
- } else {
- if( preprocessed_funbody is null ) {
- // .prototype!, forced macro cannot access parameters
- ctx.kill = true; scope(exit)ctx.kill=false;
- preprocessed_funbody = tableToAST(ValueLayer,macroEval(ast.funbody, ctx, true));
- }
- }
-
- auto v = eval(preprocessed_funbody, ctx, true, lay);
- version(AutoMemoization)
- {
- if( lay != ValueLayer && lay != MacroLayer )
- {
- memo[lay][memokey] = v;
- version(AutoReRun)
- memo[lay][memokey] = eval(preprocessed_funbody, ctx, true, lay); // re-Run!!
- }
- }
- return v;
- }
-}
-
-///
-abstract class NativeFunValue : FunValue
-{
- Parameter[] params_data;
- override const(Parameter[]) params() { return params_data; }
- override Table definitionContext() { return new Table; } // todo: cache overrie
-}
-
-/// Named Constructor for FunValue
-
-FunValue native(R,T...)(R delegate (T) dg)
-{
- return new class NativeFunValue {
- this()
- {
- foreach(i, Ti; T)
- params_data ~= new Parameter(text(i), []);
- }
- override Value invoke(in LexPosition pos, Layer lay, Table ctx)
- {
- if( lay != ValueLayer )
- throw genex!RuntimeException(pos, "only "~ValueLayer~" layer can call native function");
- T typed_args;
- foreach(i, Ti; T) {
- typed_args[i] = cast(Ti) ctx.get(text(i), ValueLayer);
- 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;
- }
- }
- };
+ Value invoke(LexPosition pos, Layer lay, Table ctx);
}
/// Context (variable environment)
/// Simlar to prototype chain of ECMAScript etc.
/// But extended with the notion of "Layer"
@@ -186,18 +60,18 @@
bool kill = false; // to refactor
this( Table proto=null, Kind k = Kind.PropagateSet )
{ this.prototype = proto; this.kind = k; }
- void set(string i, Layer lay, Value v, in LexPosition pos=null)
+ void set(string i, Layer lay, Value v, LexPosition pos=null)
{
if( setIfExist(i, lay, v) )
return;
data[i][lay] = v;
}
- bool has(string i, Layer lay, in LexPosition pos=null)
+ bool has(string i, Layer lay) const
{
if( i in data ) {
if( lay !in data[i] )
return false;
if(kill)
@@ -204,14 +78,14 @@
return false;
return true;
}
if( prototype is null )
return false;
- return prototype.has(i, lay, pos);
+ return prototype.has(i, lay);
}
- Value get(string i, Layer lay, in LexPosition pos=null)
+ Value get(string i, Layer lay, LexPosition pos=null)
{
if( i in data ) {
// [TODO] consider forwarding to proto also in this case
if( lay !in data[i] )
throw genex!RuntimeException(pos, sprintf!"'%s' is not set in layer %s"(i,lay));
@@ -246,11 +120,14 @@
foreach(k, l2d; data)
foreach(l,d; l2d)
{
if(first) first=false; else result~=", ";
result ~= k;
- result ~= l;
+ if( l.empty )
+ result ~= "(emptylayer)";
+ else if( l != ValueLayer )
+ result ~= l;
result ~= ":";
result ~= text(cast(Value)d);
}
if( prototype !is null )
{
@@ -373,24 +250,24 @@
auto pos = extractPos(t);
switch(nodeType.data)
{
case "int":
if(auto v = t.access!IntValue(theLayer, "data"))
- return new IntLiteral(pos, v.data);
+ return new Int(pos, v.data);
throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"int", data:(not int)}`);
case "str":
if(auto v = t.access!StrValue(theLayer, "data"))
- return new StrLiteral(pos, v.data);
+ return new Str(pos, v.data);
throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"str", data:(not string)}`);
case "var":
if(auto v = t.access!StrValue(theLayer, "name"))
- return new VarExpression(pos, v.data);
+ return new Var(pos, v.data);
throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"var", name:(not string)}`);
case "lay":
if(auto v = t.access!StrValue(theLayer, "layer"))
if(auto e = t.access!Table(theLayer, "expr"))
- return new LayExpression(pos, v.data, tableToAST(theLayer,e));
+ return new Lay(pos, v.data, tableToAST(theLayer,e));
else
throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"lay", expr:(not table)}`);
throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"lay", layer:(not string)}`);
case "let":
if(auto n = t.access!StrValue(theLayer, "name"))
@@ -401,17 +278,17 @@
auto ee = tableToAST(theLayer, e);
auto bb = tableToAST(theLayer, b);
Layer lay="";
if(auto l = t.access!StrValue(theLayer, "layer"))
lay = l.data;
- return new LetExpression(pos, nn, lay, ee, bb);
+ return new Let(pos, nn, lay, ee, bb);
}
throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"let", name:"???", init:"???", expr:"???"}`);
case "app":
if(auto f = t.access!Table(theLayer, "fun"))
if(auto a = t.access!Table(theLayer, "args"))
- return new FuncallExpression(pos, tableToAST(theLayer,f), tableToASTList(theLayer,a));
+ return new App(pos, tableToAST(theLayer,f), tableToASTList(theLayer,a));
throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"app", fun:???, args:???}`);
case "fun":
if(auto p = t.access!Table(theLayer, "params"))
if(auto b = t.access!Table(theLayer, "funbody"))
{
@@ -438,12 +315,35 @@
continue;
}
throw genex!RuntimeException(cast(LexPosition)null, sprintf!`Invalid AST {bad fun params %s}`(v));
}
auto bb = tableToAST(theLayer, b);
- return new FunLiteral(pos,ps,bb);
+ return new Fun(pos,ps,bb);
}
throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"fun", param:???, body:???}`);
default:
throw genex!RuntimeException(cast(LexPosition)null, sprintf!`Invalid AST {is: "%s"} unknown`(nodeType.data));
}
}
+
+Table makeCons(Value a, Value d)
+{
+ Table t = new Table;
+ t.set("car", ValueLayer, a);
+ t.set("cdr", ValueLayer, d);
+ return t;
+}
+
+Table fromPos(LexPosition pos)
+{
+ Table t = new Table;
+ if( pos !is null ) {
+ t.set("filename", ValueLayer, new StrValue(pos.filename));
+ t.set("lineno", ValueLayer, new IntValue(BigInt(pos.lineno)));
+ t.set("column", ValueLayer, new IntValue(BigInt(pos.column)));
+ } else {
+ t.set("filename", ValueLayer, new StrValue("nullpos"));
+ t.set("lineno", ValueLayer, new IntValue(BigInt(0)));
+ t.set("column", ValueLayer, new IntValue(BigInt(0)));
+ }
+ return t;
+}
Index: sample/plusminus.pmy
==================================================================
--- sample/plusminus.pmy
+++ sample/plusminus.pmy
@@ -1,7 +1,7 @@
@@s(x){x};
-@s "+" = fun(x, y) {@v(
+@s "+" = fun(x, y) {@value(
@s(x) - @s(y)
)};
print( 1 + 2 );
print( @s(1 + 2) );
Index: tricks/tricks.d
==================================================================
--- tricks/tricks.d
+++ tricks/tricks.d
@@ -390,5 +390,12 @@
when!(D1, (x, y){return x + cast(int)y;}),
otherwise!({return 999;}),
when!(D2, (x){return x.length;})
), 999);
}
+
+/// Will be used for dynamic overload resolution pattern
+
+template firstParam(T)
+{
+ alias ParameterTypeTuple!(T)[0] firstParam;
+}