1 /**
2 * Authors: k.inaba
3 * License: NYSL 0.9982 http://www.kmonos.net/nysl/
4 *
5 * Evaluator for Polemy programming language.
6 */
7 module polemy.eval;
8 import polemy._common;
9 import polemy.lex : LexPosition;
10 import polemy.ast;
11 import polemy.parse;
12 import polemy.value;
13 import std.typecons;
14 import std.stdio;
15
16 // [todo] move to value.d
17
18 FunValue nativef(Value delegate(immutable LexPosition pos, Layer lay, Value[] args) dg)
19 {
20 return new FunValue(dg);
21 }
22
23 FunValue native(R,T...)(R delegate (T) dg)
24 {
25 return nativef( delegate Value(immutable LexPosition pos, Layer lay, Value[] args) {
26 if( lay != "@v" )
27 throw genex!RuntimeException(pos, "only @v layer can call native function");
28 if( T.length != args.length )
29 throw genex!RuntimeException(pos, "argument number mismatch!");
30 T typed_args;
31 foreach(i, Ti; T)
32 {
33 typed_args[i] = cast(Ti) args[i];
34 if( typed_args[i] is null )
35 throw genex!RuntimeException(pos, sprintf!"type mismatch on the argument %d"(i+1));
36 }
37 try {
38 return dg(typed_args);
39 } catch( RuntimeException e ) {
40 throw e.pos is null ? new RuntimeException(pos, e.msg, e.file, e.line) : e;
41 }
42 });
43 }
44
45 ///
46 Table createGlobalContext()
47 {
48 auto ctx = new Table;
49 ctx.set("+", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data + rhs.data);} ));
50 ctx.set("-", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data - rhs.data);} ));
51 ctx.set("*", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data * rhs.data);} ));
52 ctx.set("/", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data / rhs.data);} ));
53 ctx.set("%", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data % rhs.data);} ));
54 ctx.set("||", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(BigInt((lhs.data!=0) || (rhs.data!=0) ? 1:0));} ));
55 ctx.set("&&", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(BigInt((lhs.data!=0) && (rhs.data!=0) ? 1:0));} ));
56 ctx.set("<", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs < rhs ? 1: 0));} ));
57 ctx.set(">", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs > rhs ? 1: 0));} ));
58 ctx.set("<=", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs <= rhs ? 1: 0));} ));
59 ctx.set(">=", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs >= rhs ? 1: 0));} ));
60 ctx.set("==", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs == rhs ? 1: 0));} ));
61 ctx.set("!=", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs != rhs ? 1: 0));} ));
62 ctx.set("print", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
63 foreach(a; args)
64 write(a);
65 writeln("");
66 return new IntValue(BigInt(178));
67 }));
68 ctx.set("if", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
69 if( args.length != 3 )
70 throw genex!RuntimeException(pos, "if takes three arguments!!");
71 if( auto x = cast(IntValue)args[0] )
72 if( auto ft = cast(FunValue)args[1] )
73 if( auto fe = cast(FunValue)args[2] )
74 return (x.data == 0 ? fe : ft).call(pos,lay,[]);
75 throw genex!RuntimeException(pos, "type mismatch in if");
76 }));
77 ctx.set("_isint", "@v", native( (Value v){return new IntValue(BigInt(cast(IntValue)v is null ? 0 : 1));} ));
78 ctx.set("_isstr", "@v", native( (Value v){return new IntValue(BigInt(cast(StrValue)v is null ? 0 : 1));} ));
79 ctx.set("_isfun", "@v", native( (Value v){return new IntValue(BigInt(cast(FunValue)v is null ? 0 : 1));} ));
80 ctx.set("_isundefined", "@v", native( (Value v){return new IntValue(BigInt(cast(UndValue)v is null ? 0 : 1));} ));
81 return ctx;
82 }
83
84 /// Entry point of this module
85
86 Tuple!(Value,"val",Table,"ctx") evalString(S,T...)(S str, T fn_ln_cn)
87 {
88 return eval( polemy.parse.parseString(str, fn_ln_cn) );
89 }
90
91 /// Entry point of this module
92
93 Tuple!(Value,"val",Table,"ctx") evalFile(S, T...)(S filename, T ln_cn)
94 {
95 return eval( polemy.parse.parseFile(filename, ln_cn) );
96 }
97
98 /// Entry point of this module
99
100 Tuple!(Value,"val",Table,"ctx") eval(AST e)
101 {
102 Table ctx = createGlobalContext();
103 return typeof(return)(eval(e, ctx, false, "@v"), ctx);
104 }
105
106 /// Entry point of this module
107 /// If splitCtx = true, then inner variable declaration do not overwrite ctx.
108 /// lay is the layer ID for evaluation (standard value semantics uses "@v").
109
110 Value eval(AST e, Table ctx, bool splitCtx, Layer lay)
111 {
112 return e.match(
113 (StrLiteral e)
114 {
115 Value v = new StrValue(e.data);
116 if( lay == "@v" )
117 return v;
118 else // rise
119 return (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v", [v]);
120 },
121 (IntLiteral e)
122 {
123 Value v = new IntValue(e.data);
124 if( lay == "@v" )
125 return v;
126 else // rise
127 return (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v", [v]);
128 },
129 (VarExpression e)
130 {
131 if( lay == "@v" )
132 return ctx.get(e.var, lay, e.pos);
133 try {
134 return ctx.get(e.var, lay, e.pos);
135 } catch( Throwable ) { // [TODO] more precise...
136 // rise from @v
137 return (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v",
138 [ctx.get(e.var, "@v", e.pos)]
139 );
140 }
141 },
142 (LayeredExpression e)
143 {
144 return eval(e.expr, ctx, false, e.lay);
145 },
146 (LetExpression e)
147 {
148 // for letrec, we need this, but should avoid overwriting????
149 // ctx.set(e.var, "@v", new UndefinedValue, e.pos);
150 Value v = eval(e.init, ctx, true, lay);
151 if(splitCtx)
152 ctx = new Table(ctx, Table.Kind.NotPropagateSet);
153 ctx.set(e.var, (e.layer.length ? e.layer : lay), v, e.pos);
154 return eval(e.expr, ctx, false, lay);
155 },
156 (FuncallExpression e)
157 {
158 Value _f = eval(e.fun, ctx, true, lay);
159 if( auto f = cast(FunValue)_f ) {
160 Value[] args;
161 foreach(a; e.args)
162 args ~= eval(a, ctx, true, lay);
163 return f.call(e.pos, lay, args);
164 }
165 throw genex!RuntimeException(e.pos, "Non-funcion is applied");
166 },
167 (FunLiteral e)
168 {
169 Value[Value[]][Layer] memo;
170
171 // funvalue need not be rised
172 // no, need to be rised !! suppose @t(fib)("int")
173 return new FunValue(delegate Value(immutable LexPosition pos, string lay, Value[] args){
174 // TODO: only auto raised ones need memo? no?
175 // auto memoization
176 if( lay != "@v" )
177 {
178 if( auto memolay = lay in memo )
179 if( auto pv = args in *memolay )
180 return *pv;
181 memo[lay][args] = (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v",
182 [new UndValue]
183 );
184 }
185
186 if( e.params.length != args.length )
187 throw genex!RuntimeException(e.pos, sprintf!"Argument Number Mismatch (%d required but %d given)"
188 (e.params.length, args.length));
189 Table ctxNeo = new Table(ctx, Table.Kind.NotPropagateSet);
190 foreach(i,p; e.params)
191 ctxNeo.set(p.name, lay, args[i]);
192 auto v = eval(e.funbody, ctxNeo, true, lay);
193 // auto memoization
194 if( lay != "@v" )
195 memo[lay][args] = v;
196 return v;
197 });
198 },
199 delegate Value (AST e)
200 {
201 throw genex!RuntimeException(e.pos, sprintf!"Unknown Kind of Expression %s"(typeid(e)));
202 }
203 );
204 }
205
206 unittest
207 {
208 auto r = assert_nothrow( evalString(`var x = 21; x + x*x;`) );
209 assert_eq( r.val, new IntValue(BigInt(21+21*21)) );
210 assert_eq( r.ctx.get("x","@v"), new IntValue(BigInt(21)) );
211 assert_nothrow( r.ctx.get("x","@v") );
212 assert_throw!RuntimeException( r.ctx.get("y","@v") );
213 }
214 unittest
215 {
216 auto r = assert_nothrow( evalString(`var x = 21; var x = x + x*x;`) );
217 assert_eq( r.val, new IntValue(BigInt(21+21*21)) );
218 assert_eq( r.ctx.get("x","@v"), new IntValue(BigInt(21+21*21)) );
219 assert_nothrow( r.ctx.get("x","@v") );
220 assert_throw!RuntimeException( r.ctx.get("y","@v") );
221 }
222 unittest
223 {
224 assert_eq( evalString(`let x=1; let y=(let x=2); x`).val, new IntValue(BigInt(1)) );
225 assert_eq( evalString(`let x=1; let y=(let x=2;fun(){x}); y()`).val, new IntValue(BigInt(2)) );
226 }
227 unittest
228 {
229 assert_eq( evalString(`@a x=1; @b x=2; @a(x)`).val, new IntValue(BigInt(1)) );
230 assert_eq( evalString(`@a x=1; @b x=2; @b(x)`).val, new IntValue(BigInt(2)) );
231 assert_eq( evalString(`let x=1; let _ = (@a x=2;2); x`).val, new IntValue(BigInt(1)) );
232 assert_throw!Throwable( evalString(`let x=1; let _ = (@a x=2;2); @a(x)`) );
233 }
234
235 unittest
236 {
237 assert_eq( evalString(`var fac = fun(x){
238 if(x)
239 { x*fac(x-1); }
240 else
241 { 1; };
242 };
243 fac(10);`).val, new IntValue(BigInt(10*9*8*5040)));
244 assert_eq( evalString(`var fib = fun(x){
245 if(x<2)
246 { 1; }
247 else
248 { fib(x-1) + fib(x-2); };
249 };
250 fib(10);`).val, new IntValue(BigInt(89)));
251 }
252
253 unittest
254 {
255 assert_throw!Throwable( evalString(`@@s(x){x}; @s "+"=fun(x,y){x-y};@s(1+2)`) );
256 assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){x-y};1+2`).val, new IntValue(BigInt(3)) );
257 assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){@v(@s(x)-@s(y))};1+2`).val, new IntValue(BigInt(3)) );
258 assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){@v(@s(x)-@s(y))};@s(1+2)`).val, new IntValue(BigInt(-1)) );
259 }
260
261 unittest
262 {
263 assert_eq( evalString(`@@t = fun(x){x+1}; @t(123)`).val, new IntValue(BigInt(124)) );
264 }