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 ///
17 Table createGlobalContext()
18 {
19 auto ctx = new Table;
20 ctx.set("+", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data + rhs.data);} ));
21 ctx.set("-", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data - rhs.data);} ));
22 ctx.set("*", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data * rhs.data);} ));
23 ctx.set("/", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data / rhs.data);} ));
24 ctx.set("%", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(lhs.data % rhs.data);} ));
25 ctx.set("||", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(BigInt((lhs.data!=0) || (rhs.data!=0) ? 1:0));} ));
26 ctx.set("&&", "@v", native( (IntValue lhs, IntValue rhs){return new IntValue(BigInt((lhs.data!=0) && (rhs.data!=0) ? 1:0));} ));
27 ctx.set("<", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs < rhs ? 1: 0));} ));
28 ctx.set(">", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs > rhs ? 1: 0));} ));
29 ctx.set("<=", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs <= rhs ? 1: 0));} ));
30 ctx.set(">=", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs >= rhs ? 1: 0));} ));
31 ctx.set("==", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs == rhs ? 1: 0));} ));
32 ctx.set("!=", "@v", native( (Value lhs, Value rhs){return new IntValue(BigInt(lhs != rhs ? 1: 0));} ));
33 ctx.set("print", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
34 foreach(a; args)
35 write(a);
36 writeln("");
37 return new IntValue(BigInt(178));
38 }));
39 ctx.set("if", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
40 if( args.length != 3 )
41 throw genex!RuntimeException(pos, "if takes three arguments!!");
42 if( auto x = cast(IntValue)args[0] )
43 if( auto ft = cast(FunValue)args[1] )
44 if( auto fe = cast(FunValue)args[2] )
45 return (x.data == 0 ? fe : ft).call(pos,lay,[]);
46 throw genex!RuntimeException(pos, "type mismatch in if");
47 }));
48 ctx.set("_isint", "@v", native( (Value v){return new IntValue(BigInt(cast(IntValue)v is null ? 0 : 1));} ));
49 ctx.set("_isstr", "@v", native( (Value v){return new IntValue(BigInt(cast(StrValue)v is null ? 0 : 1));} ));
50 ctx.set("_isfun", "@v", native( (Value v){return new IntValue(BigInt(cast(FunValue)v is null ? 0 : 1));} ));
51 ctx.set("_isundefined", "@v", native( (Value v){return new IntValue(BigInt(cast(UndValue)v is null ? 0 : 1));} ));
52 ctx.set("_istable", "@v", native( (Value v){return new IntValue(BigInt(cast(Table)v is null ? 0 : 1));} ));
53 ctx.set(".", "@v", native( (Table t, StrValue s){
54 return (t.has(s.data, "@v") ? t.get(s.data, "@v") : new UndValue);
55 }) );
56 ctx.set(".?", "@v", native( (Table t, StrValue s){
57 return new IntValue(BigInt(t.has(s.data, "@v") ? 1 : 0));
58 }) );
59 ctx.set(".=", "@v", native( (Table t, StrValue s, Value v){
60 auto t2 = new Table(t, Table.Kind.NotPropagateSet);
61 t2.set(s.data, "@v", v);
62 return t2;
63 }) );
64 ctx.set("{}", "@v", native( (){
65 return new Table;
66 }) );
67 return ctx;
68 }
69
70 /// Entry point of this module
71
72 Tuple!(Value,"val",Table,"ctx") evalString(S,T...)(S str, T fn_ln_cn)
73 {
74 return eval( polemy.parse.parseString(str, fn_ln_cn) );
75 }
76
77 /// Entry point of this module
78
79 Tuple!(Value,"val",Table,"ctx") evalFile(S, T...)(S filename, T ln_cn)
80 {
81 return eval( polemy.parse.parseFile(filename, ln_cn) );
82 }
83
84 /// Entry point of this module
85
86 Tuple!(Value,"val",Table,"ctx") eval(AST e)
87 {
88 Table ctx = createGlobalContext();
89 return typeof(return)(eval(e, ctx, false, "@v"), ctx);
90 }
91
92 /// Entry point of this module
93 /// If splitCtx = true, then inner variable declaration do not overwrite ctx.
94 /// lay is the layer ID for evaluation (standard value semantics uses "@v").
95
96 Value eval(AST e, Table ctx, bool splitCtx, Layer lay)
97 {
98 return e.match(
99 (StrLiteral e)
100 {
101 Value v = new StrValue(e.data);
102 if( lay == "@v" )
103 return v;
104 else // rise
105 return (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v", [v]);
106 },
107 (IntLiteral e)
108 {
109 Value v = new IntValue(e.data);
110 if( lay == "@v" )
111 return v;
112 else // rise
113 return (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v", [v]);
114 },
115 (VarExpression e)
116 {
117 if( lay == "@v" )
118 return ctx.get(e.var, lay, e.pos);
119 try {
120 return ctx.get(e.var, lay, e.pos);
121 } catch( Throwable ) { // [TODO] more precise...
122 // rise from @v
123 return (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v",
124 [ctx.get(e.var, "@v", e.pos)]
125 );
126 }
127 },
128 (LayeredExpression e)
129 {
130 if( e.lay == "@macro" )
131 return macroEval(e.expr, ctx, false);
132 else
133 return eval(e.expr, ctx, false, e.lay);
134 },
135 (LetExpression e)
136 {
137 // for letrec, we need this, but should avoid overwriting????
138 // ctx.set(e.var, "@v", new UndefinedValue, e.pos);
139 Value v = eval(e.init, ctx, true, lay);
140 if(splitCtx)
141 ctx = new Table(ctx, Table.Kind.NotPropagateSet);
142 ctx.set(e.var, (e.layer.length ? e.layer : lay), v, e.pos);
143 return eval(e.expr, ctx, false, lay);
144 },
145 (FuncallExpression e)
146 {
147 Value _f = eval(e.fun, ctx, true, lay);
148 if( auto f = cast(FunValue)_f ) {
149 Value[] args;
150 foreach(a; e.args)
151 args ~= eval(a, ctx, true, lay);
152 return f.call(e.pos, lay, args);
153 }
154 throw genex!RuntimeException(e.pos, "Non-funcion is applied");
155 },
156 (FunLiteral e)
157 {
158 Value[Value[]][Layer] memo;
159 AST macroMemo = null; // cache
160
161 // funvalue need not be rised
162 // no, need to be rised !! suppose @t(fib)("int")
163 return new FunValue(delegate Value(immutable LexPosition pos, string lay, Value[] args){
164 // TODO: only auto raised ones need memo? no?
165 // auto memoization
166 if( lay != "@v" && lay != "@macro" )
167 {
168 if( auto memolay = lay in memo )
169 if( auto pv = args in *memolay )
170 return *pv;
171 memo[lay][args] = (cast(FunValue)ctx.get(lay, "(system)", e.pos)).call(e.pos, "@v",
172 [new UndValue]
173 );
174 }
175
176 if( e.params.length != args.length )
177 throw genex!RuntimeException(e.pos, sprintf!"Argument Number Mismatch (%d required but %d given)"
178 (e.params.length, args.length));
179 Table ctxNeo = new Table(ctx, Table.Kind.NotPropagateSet);
180 foreach(i,p; e.params)
181 ctxNeo.set(p.name, lay, args[i]);
182
183 // @macro run!!!
184 if( lay == "@macro" )
185 return macroEval(e.funbody, ctxNeo, false);
186 if( macroMemo is null )
187 macroMemo = tableToAST("@v",macroEval(e.funbody, ctxNeo, true));
188 auto v = eval(macroMemo, ctxNeo, true, lay);
189
190 //auto v = eval(e.funbody, ctxNeo, true, lay);
191 // auto memoization
192 if( lay != "@v" && lay != "@macro" )
193 memo[lay][args] = v;
194 return v;
195 });
196 },
197 delegate Value (AST e)
198 {
199 throw genex!RuntimeException(e.pos, sprintf!"Unknown Kind of Expression %s"(typeid(e)));
200 }
201 );
202 }
203
204 // [TODO] Optimization
205 Value macroEval(AST e, Table ctx, bool AlwaysMacro)
206 {
207 Layer theLayer = "@v";
208
209 Table pos = new Table;
210 pos.set("filename", theLayer, new StrValue(e.pos.filename));
211 pos.set("lineno", theLayer, new IntValue(BigInt(e.pos.lineno)));
212 pos.set("column", theLayer, new IntValue(BigInt(e.pos.column)));
213 return e.match(
214 (StrLiteral e)
215 {
216 Table t = new Table;
217 t.set("pos", theLayer, pos);
218 t.set("is", theLayer, new StrValue("str"));
219 t.set("data", theLayer, new StrValue(e.data));
220 return t;
221 },
222 (IntLiteral e)
223 {
224 Table t = new Table;
225 t.set("pos", theLayer, pos);
226 t.set("is", theLayer, new StrValue("int"));
227 t.set("data", theLayer, new IntValue(e.data));
228 return t;
229 },
230 (VarExpression e)
231 {
232 try {
233 return ctx.get(e.var, "@macro", e.pos);
234 } catch( Throwable ) {// [TODO] more precies...
235 Table t = new Table;
236 t.set("pos", theLayer, pos);
237 t.set("is", theLayer, new StrValue("var"));
238 t.set("name", theLayer, new StrValue(e.var));
239 return cast(Value)t;
240 }
241 },
242 (LayeredExpression e)
243 {
244 if( AlwaysMacro )
245 {
246 Table t = new Table;
247 t.set("pos", theLayer, pos);
248 t.set("is", theLayer, new StrValue("lay"));
249 t.set("layer", theLayer, new StrValue(e.lay));
250 t.set("expr", theLayer, macroEval(e.expr,ctx,AlwaysMacro));
251 return cast(Value)t;
252 }
253 else
254 {
255 return eval(e.expr, ctx, true, e.lay);
256 }
257 },
258 (LetExpression e)
259 {
260 Table t = new Table;
261 t.set("pos", theLayer, pos);
262 t.set("is", theLayer, new StrValue("let"));
263 t.set("name", theLayer, new StrValue(e.var));
264 t.set("init", theLayer, macroEval(e.init,ctx,AlwaysMacro));
265 t.set("expr", theLayer, macroEval(e.expr,ctx,AlwaysMacro));
266 return t;
267 },
268 (FuncallExpression e)
269 {
270 Value _f = macroEval(e.fun,ctx,AlwaysMacro);
271
272 // copy & pase from normal eval
273 // [TODO] sync with @layerd parameters.
274 if( auto f = cast(FunValue)_f ) {
275 Value[] args;
276 foreach(a; e.args)
277 args ~= macroEval(a, ctx, AlwaysMacro);
278 return f.call(e.pos, "@macro", args); // explicit @macro is the best???
279 }
280
281 Table t = new Table;
282 t.set("pos", theLayer, pos);
283 t.set("is", theLayer, new StrValue("app"));
284 t.set("fun", theLayer, _f);
285 Table args = new Table;
286 foreach_reverse(a; e.args) {
287 Table cons = new Table;
288 cons.set("car",theLayer,macroEval(a,ctx,AlwaysMacro));
289 cons.set("cdr",theLayer,args);
290 args = cons;
291 }
292 t.set("arg", theLayer, args);
293 return cast(Value)t;
294 },
295 (FunLiteral e)
296 {
297 Table t = new Table;
298 t.set("pos", theLayer, pos);
299 t.set("is", theLayer, new StrValue("fun"));
300 t.set("body", theLayer, macroEval(e.funbody,ctx,AlwaysMacro));
301 Table param = new Table;
302 foreach_reverse(p; e.params)
303 {
304 Table cons = new Table;
305 Table kv = new Table;
306 kv.set("name", theLayer, new StrValue(p.name));
307 foreach_reverse(lay; p.layers)
308 {
309 Table cons2 = new Table;
310 cons2.set("car", theLayer, new StrValue(lay));
311 cons2.set("cdr", theLayer, kv);
312 kv = cons2;
313 }
314 cons.set("car", theLayer, kv);
315 cons.set("cdr", theLayer, param);
316 param = cons;
317 }
318 t.set("param", theLayer, param);
319 return t;
320 },
321 delegate Value (AST e)
322 {
323 throw genex!RuntimeException(e.pos, sprintf!"Unknown Kind of Expression %s"(typeid(e)));
324 }
325 );
326 }
327
328 unittest
329 {
330 auto r = assert_nothrow( evalString(`var x = 21; x + x*x;`) );
331 assert_eq( r.val, new IntValue(BigInt(21+21*21)) );
332 assert_eq( r.ctx.get("x","@v"), new IntValue(BigInt(21)) );
333 assert_nothrow( r.ctx.get("x","@v") );
334 assert_throw!RuntimeException( r.ctx.get("y","@v") );
335 }
336 unittest
337 {
338 auto r = assert_nothrow( evalString(`var x = 21; var x = x + x*x;`) );
339 assert_eq( r.val, new IntValue(BigInt(21+21*21)) );
340 assert_eq( r.ctx.get("x","@v"), new IntValue(BigInt(21+21*21)) );
341 assert_nothrow( r.ctx.get("x","@v") );
342 assert_throw!RuntimeException( r.ctx.get("y","@v") );
343 }
344 unittest
345 {
346 assert_eq( evalString(`let x=1; let y=(let x=2); x`).val, new IntValue(BigInt(1)) );
347 assert_eq( evalString(`let x=1; let y=(let x=2;fun(){x}); y()`).val, new IntValue(BigInt(2)) );
348 }
349 unittest
350 {
351 assert_eq( evalString(`@a x=1; @b x=2; @a(x)`).val, new IntValue(BigInt(1)) );
352 assert_eq( evalString(`@a x=1; @b x=2; @b(x)`).val, new IntValue(BigInt(2)) );
353 assert_eq( evalString(`let x=1; let _ = (@a x=2;2); x`).val, new IntValue(BigInt(1)) );
354 assert_throw!Throwable( evalString(`let x=1; let _ = (@a x=2;2); @a(x)`) );
355 }
356
357 unittest
358 {
359 assert_eq( evalString(`var fac = fun(x){
360 if(x)
361 { x*fac(x-1); }
362 else
363 { 1; };
364 };
365 fac(10);`).val, new IntValue(BigInt(10*9*8*5040)));
366 assert_eq( evalString(`var fib = fun(x){
367 if(x<2)
368 { 1; }
369 else
370 { fib(x-1) + fib(x-2); };
371 };
372 fib(5);`).val, new IntValue(BigInt(8)));
373 }
374
375 unittest
376 {
377 assert_throw!Throwable( evalString(`@@s(x){x}; @s "+"=fun(x,y){x-y};@s(1+2)`) );
378 assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){x-y};1+2`).val, new IntValue(BigInt(3)) );
379 assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){@v(@s(x)-@s(y))};1+2`).val, new IntValue(BigInt(3)) );
380 assert_eq( evalString(`@@s(x){x}; @s "+"=fun(x,y){@v(@s(x)-@s(y))};@s(1+2)`).val, new IntValue(BigInt(-1)) );
381 }
382
383 unittest
384 {
385 assert_eq( evalString(`@@t = fun(x){x+1}; @t(123)`).val, new IntValue(BigInt(124)) );
386 }