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 // [TODO] autogenerate these typechecks
21 ctx.set("+", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
22 if( args.length != 2 )
23 throw genex!RuntimeException(pos, "+ takes two arguments!!");
24 if( auto x = cast(IntValue)args[0] )
25 if( auto y = cast(IntValue)args[1] )
26 return new IntValue(x.data+y.data);
27 throw genex!RuntimeException(pos, "cannot add non-integers");
28 }));
29 ctx.set("-", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
30 if( args.length != 2 )
31 throw genex!RuntimeException(pos, "- takes two arguments!!");
32 if( auto x = cast(IntValue)args[0] )
33 if( auto y = cast(IntValue)args[1] )
34 return new IntValue(x.data-y.data);
35 throw genex!RuntimeException(pos, "cannot subtract non-integers");
36 }));
37 ctx.set("*", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
38 if( args.length != 2 )
39 throw genex!RuntimeException(pos, "* takes two arguments!!");
40 if( auto x = cast(IntValue)args[0] )
41 if( auto y = cast(IntValue)args[1] )
42 return new IntValue(x.data*y.data);
43 throw genex!RuntimeException(pos, "cannot multiply non-integers");
44 }));
45 ctx.set("/", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
46 if( args.length != 2 )
47 throw genex!RuntimeException(pos, "/ takes two arguments!!");
48 if( auto x = cast(IntValue)args[0] )
49 if( auto y = cast(IntValue)args[1] )
50 return new IntValue(x.data/y.data);
51 throw genex!RuntimeException(pos, "cannot divide non-integers");
52 }));
53 ctx.set("<", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
54 if( args.length != 2 )
55 throw genex!RuntimeException(pos, "< takes two arguments!!");
56 if( auto x = cast(IntValue)args[0] )
57 if( auto y = cast(IntValue)args[1] )
58 return new IntValue(BigInt(to!int(x.data < y.data)));
59 throw genex!RuntimeException(pos, "cannot compare non-integers");
60 }));
61 ctx.set(">", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
62 if( args.length != 2 )
63 throw genex!RuntimeException(pos, "> takes two arguments!!");
64 if( auto x = cast(IntValue)args[0] )
65 if( auto y = cast(IntValue)args[1] )
66 return new IntValue(BigInt(to!int(x.data>y.data)));
67 throw genex!RuntimeException(pos, "cannot compare non-integers");
68 }));
69 ctx.set("print", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
70 foreach(a; args)
71 write(a);
72 writeln("");
73 return new IntValue(BigInt(178));
74 }));
75 ctx.set("if", "@v", new FunValue(delegate Value(immutable LexPosition pos, Layer lay, Value[] args){
76 if( args.length != 3 )
77 throw genex!RuntimeException(pos, "if takes three arguments!!");
78 if( auto x = cast(IntValue)args[0] )
79 if( auto ft = cast(FunValue)args[1] )
80 if( auto fe = cast(FunValue)args[2] )
81 return (x.data == 0 ? fe : ft).call(pos,lay,[]);
82 throw genex!RuntimeException(pos, "type mismatch in if");
83 }));
84 return ctx;
85 }
86
87 /// Entry point of this module
88
89 Tuple!(Value,"val",Table,"ctx") evalString(S,T...)(S str, T fn_ln_cn)
90 {
91 return eval( polemy.parse.parseString(str, fn_ln_cn) );
92 }
93
94 /// Entry point of this module
95
96 Tuple!(Value,"val",Table,"ctx") evalFile(S, T...)(S filename, T ln_cn)
97 {
98 return eval( polemy.parse.parseFile(filename, ln_cn) );
99 }
100
101 /// Entry point of this module
102
103 Tuple!(Value,"val",Table,"ctx") eval(AST e)
104 {
105 Table ctx = createGlobalContext();
106 return typeof(return)(eval(e, ctx, false, "@v"), ctx);
107 }
108
109 /// Entry point of this module
110 /// If splitCtx = true, then inner variable declaration do not overwrite ctx.
111 /// lay is the layer ID for evaluation (standard value semantics uses "@v").
112
113 Value eval(AST _e, Table ctx, bool splitCtx, Layer lay)
114 {
115 if( auto e = cast(StrLiteral)_e )
116 {
117 return new StrValue(e.data);
118 }
119 else
120 if( auto e = cast(IntLiteral)_e )
121 {
122 return new IntValue(e.data);
123 }
124 else
125 if( auto e = cast(VarExpression)_e )
126 {
127 return ctx.get(e.var, lay, e.pos);
128 }
129 else
130 if( auto e = cast(LayeredExpression)_e )
131 {
132 return eval(e.expr, ctx, false, e.lay);
133 }
134 else
135 if( auto e = cast(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 else
146 if( auto e = cast(FuncallExpression)_e )
147 {
148 Value _f = eval(e.fun, ctx, true, lay);
149 if( auto f = cast(FunValue)_f ) {
150 Value[] args;
151 foreach(a; e.args)
152 args ~= eval(a, ctx, true, lay);
153 return f.call(e.pos, lay, args);
154 } else
155 throw genex!RuntimeException(e.pos, "Non-funcion is applied");
156 }
157 else
158 if( auto e = cast(FunLiteral)_e )
159 {
160 return new FunValue(delegate Value(immutable LexPosition pos, string lay, Value[] args){
161 if( e.params.length != args.length )
162 throw genex!RuntimeException(e.pos, sprintf!"Argument Number Mismatch (%d required but %d given)"
163 (e.params.length, args.length));
164 Table ctxNeo = new Table(ctx, Table.Kind.NotPropagateSet);
165 foreach(i,p; e.params)
166 ctxNeo.set(p, lay, args[i]);
167 return eval(e.funbody, ctxNeo, true, lay);
168 });
169 }
170 throw genex!RuntimeException(_e.pos, sprintf!"Unknown Kind of Expression %s"(typeid(_e)));
171 }
172
173 unittest
174 {
175 auto r = assert_nothrow( evalString(`var x = 21; x + x*x;`) );
176 assert_eq( r.val, new IntValue(BigInt(21+21*21)) );
177 assert_eq( r.ctx.get("x","@v"), new IntValue(BigInt(21)) );
178 assert_nothrow( r.ctx.get("x","@v") );
179 assert_throw!RuntimeException( r.ctx.get("y","@v") );
180 }
181 unittest
182 {
183 auto r = assert_nothrow( evalString(`var x = 21; var x = x + x*x;`) );
184 assert_eq( r.val, new IntValue(BigInt(21+21*21)) );
185 assert_eq( r.ctx.get("x","@v"), new IntValue(BigInt(21+21*21)) );
186 assert_nothrow( r.ctx.get("x","@v") );
187 assert_throw!RuntimeException( r.ctx.get("y","@v") );
188 }
189 unittest
190 {
191 assert_eq( evalString(`let x=1; let y=(let x=2); x`).val, new IntValue(BigInt(1)) );
192 assert_eq( evalString(`let x=1; let y=(let x=2;fun(){x}); y()`).val, new IntValue(BigInt(2)) );
193 }
194 unittest
195 {
196 assert_eq( evalString(`@a x=1; @b x=2; @a(x)`).val, new IntValue(BigInt(1)) );
197 assert_eq( evalString(`@a x=1; @b x=2; @b(x)`).val, new IntValue(BigInt(2)) );
198 assert_eq( evalString(`let x=1; let _ = (@a x=2;2); x`).val, new IntValue(BigInt(1)) );
199 assert_throw!Error( evalString(`let x=1; let _ = (@a x=2;2); @a(x)`) );
200 }
201
202 unittest
203 {
204 assert_eq( evalString(`var fac = fun(x){
205 if(x)
206 { x*fac(x-1); }
207 else
208 { 1; };
209 };
210 fac(10);`).val, new IntValue(BigInt(10*9*8*5040)));
211 assert_eq( evalString(`var fib = fun(x){
212 if(x<2)
213 { 1; }
214 else
215 { fib(x-1) + fib(x-2); };
216 };
217 fib(10);`).val, new IntValue(BigInt(89)));
218 }
219
220 unittest
221 {
222 assert_throw!Throwable( evalString(`@s "+"=fun(x,y){x-y};@s(1+2)`) );
223 assert_eq( evalString(`@s "+"=fun(x,y){x-y};1+2`).val, new IntValue(BigInt(3)) );
224 assert_eq( evalString(`@s "+"=fun(x,y){@v(@s(x)-@s(y))};1+2`).val, new IntValue(BigInt(3)) );
225 assert_eq( evalString(`@s "+"=fun(x,y){@v(@s(x)-@s(y))};@s(1+2)`).val, new IntValue(BigInt(-1)) );
226 }