Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/vis12/src/compiler/simplify/eval.sml
ViewVC logotype

Annotation of /branches/vis12/src/compiler/simplify/eval.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1140 - (view) (download)
Original Path: trunk/src/compiler/simplify/eval.sml

1 : jhr 231 (* eval.sml
2 :     *
3 : jhr 435 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 : jhr 231 * All rights reserved.
5 :     *
6 :     * Evaluation of "static" expressions.
7 :     *)
8 :    
9 : jhr 236 structure Eval : sig
10 : jhr 231
11 : jhr 1140 (* raised if there is an error due to faulty code or input values (e.g., loading an
12 :     * image of the wrong shape.
13 :     *)
14 :     exception Error of string list
15 :    
16 : jhr 236 datatype value
17 :     = BV of bool
18 :     | SV of string
19 :     | IV of IntInf.int
20 : jhr 1116 | RV of real
21 :     | TV of value list (* tensors: values will either be RV or TV *)
22 :     | ImgV of ImageInfo.info * Var.var
23 : jhr 236
24 : jhr 269 val evalStatics : Var.Set.set * Simple.block -> value Var.Map.map
25 : jhr 236
26 :     end = struct
27 :    
28 : jhr 234 structure Ty = Types
29 :     structure BV = BasisVars
30 : jhr 231 structure S = Simple
31 :     structure VMap = Var.Map
32 : jhr 269 structure VSet = Var.Set
33 : jhr 231 structure VTbl = Var.Tbl
34 :    
35 : jhr 1140 exception Error of string list
36 :    
37 : jhr 231 datatype value
38 :     = BV of bool
39 : jhr 234 | SV of string
40 : jhr 231 | IV of IntInf.int
41 : jhr 1116 (* FIXME: we probably should use FloatLit.float values instead of reals! *)
42 :     | RV of real
43 :     | TV of value list (* tensors: values will either be RV or TV *)
44 :     | ImgV of ImageInfo.info * Var.var
45 : jhr 231
46 : jhr 234 fun toString (BV b) = Bool.toString b
47 :     | toString (IV i) = IntInf.toString i
48 :     | toString (SV s) = concat["\"", String.toString s, "\""]
49 : jhr 1116 | toString (RV r) = Real.toString r
50 :     | toString (TV _) = "tensor"
51 :     (* FIXME: should include x in output *)
52 :     | toString (ImgV(info, x)) = ImageInfo.toString info
53 : jhr 231
54 :     val tbl : (value list -> value) VTbl.hash_table = let
55 :     val tbl = VTbl.mkTable (128, Fail "Eval table")
56 :     fun intBinOp rator [IV a, IV b] = IV(rator(a, b))
57 : jhr 1116 fun tensorBinOp rator [v1, v2] = let
58 :     fun f (TV v1, TV v2) = TV(ListPair.mapEq f (v1, v2))
59 :     | f (RV r1, RV r2) = RV(rator(r1, r2))
60 :     in
61 :     f (v1, v2)
62 :     end
63 :     fun realBinOp rator [RV a, RV b] = RV(rator(a, b))
64 :     fun realUnOp rator [RV a] = RV(rator a)
65 : jhr 231 fun intCmp rator [IV a, IV b] = BV(rator(a, b))
66 : jhr 1116 fun realCmp rator [RV a, RV b] = BV(rator(a, b))
67 : jhr 234 fun boolCmp rator [BV a, BV b] = BV(rator(a, b))
68 :     fun stringCmp rator [SV a, SV b] = BV(rator(a, b))
69 : jhr 231 in
70 :     List.app (VTbl.insert tbl) [
71 :     (BV.add_ii, intBinOp (op +)),
72 :     (BV.add_tt, tensorBinOp (op +)),
73 :     (BV.sub_ii, intBinOp (op -)),
74 :     (BV.sub_tt, tensorBinOp (op -)),
75 : jhr 234 (BV.mul_ii, intBinOp (op * )),
76 :     (BV.mul_rr, realBinOp (op * )),
77 :     (*
78 : jhr 231 (BV.mul_rt, tensorOp Op.Scale),
79 :     (BV.mul_tr, fn (y, sv, [t, r]) => tensorOp Op.Scale (y, sv, [r, t])),
80 : jhr 234 *)
81 : jhr 231 (BV.div_ii, intBinOp IntInf.quot),
82 : jhr 234 (BV.div_rr, realBinOp (op /)),
83 :     (*
84 : jhr 231 (BV.div_tr, tensorOp Op.InvScale),
85 : jhr 234 *)
86 : jhr 231 (BV.lt_ii, intCmp (op <)),
87 :     (BV.lt_rr, realCmp (op <)),
88 :     (BV.lte_ii, intCmp (op <=)),
89 :     (BV.lte_rr, realCmp (op <=)),
90 :     (BV.gte_ii, intCmp (op >=)),
91 :     (BV.gte_rr, realCmp (op >=)),
92 :     (BV.gt_ii, intCmp (op >)),
93 :     (BV.gt_rr, realCmp (op >)),
94 : jhr 234 (BV.equ_bb, boolCmp (op =)),
95 : jhr 231 (BV.equ_ii, intCmp (op =)),
96 : jhr 234 (BV.equ_ss, stringCmp (op =)),
97 : jhr 231 (BV.equ_rr, realCmp Real.==),
98 : jhr 234 (BV.neq_bb, boolCmp (op <>)),
99 : jhr 231 (BV.neq_ii, intCmp (op <>)),
100 : jhr 234 (BV.neq_ss, stringCmp (op <>)),
101 : jhr 231 (BV.neq_rr, realCmp Real.!=),
102 : jhr 245 (BV.neg_i, fn [IV i] => IV(~i)),
103 : jhr 234 (*
104 : jhr 231 (BV.neg_t, tensorOp Op.Neg),
105 : jhr 245 (BV.neg_f, fn [FV fld] => FV(FieldDef.neg fld)),
106 : jhr 231 (BV.op_at, fn (y, _, xs) => assign(y, Op.Probe, xs)),
107 : jhr 245 (BV.op_D, fn [FV fld] => FV(FieldDef.diff fld)),
108 : jhr 231 (BV.op_norm, tensorOp Op.Norm),
109 : jhr 245 *)
110 :     (BV.op_not, fn [BV b] => BV(not b)),
111 : jhr 231 (*
112 : jhr 245 (BV.fn_CL, fn (y, _, xs) => assign(y, Op.CL, xs)),
113 : jhr 269 (BV.op_convolve, fn [Img info, KV h] => FV(FieldDef.CONV(0, info, h))),
114 :     (BV.fn_convolve, fn [KV h, Img info] => FV(FieldDef.CONV(0, info, h))),
115 : jhr 1116 *)
116 : jhr 245 (BV.fn_cos, realUnOp Math.cos),
117 :     (*
118 : jhr 231 (BV.fn_dot, vectorOp Op.Dot),
119 :     (BV.fn_inside, fn (y, _, xs) => assign(y, Op.Inside, xs)),
120 : jhr 234 *)
121 :     (BV.fn_max, realBinOp Real.min),
122 :     (BV.fn_min, realBinOp Real.max),
123 :     (BV.fn_modulate, tensorBinOp (op * )),
124 :     (BV.fn_pow, realBinOp Real.Math.pow),
125 : jhr 231 (*
126 :     (BV.fn_principleEvec, vectorOp Op.PrincipleEvec),
127 : jhr 234 *)
128 : jhr 245 (BV.fn_sin, realUnOp Math.sin),
129 : jhr 1116 (*
130 : jhr 231 (BV.kn_bspln3, kernel Kernel.bspln3),
131 :     (BV.kn_bspln5, kernel Kernel.bspln5),
132 :     (BV.kn_ctmr, kernel Kernel.ctmr),
133 :     (BV.kn_tent, kernel Kernel.tent),
134 : jhr 1116 (BV.kn_c1tent, kernel Kernel.c1tent),
135 :     (BV.kn_c2ctmr, kernel Kernel.c2ctmr),
136 :     *)
137 : jhr 245 (BV.i2r, fn [IV i] => RV(real(IntInf.toInt i)))
138 : jhr 231 ];
139 :     tbl
140 :     end
141 :    
142 : jhr 1116 fun loadImage ([Ty.DIM dim, Ty.SHAPE shp], SV filename) = let
143 : jhr 245 val Ty.DimConst d = TypeUtil.resolveDim dim
144 : jhr 1140 val dd = let
145 :     val Ty.Shape dd = TypeUtil.resolveShape shp
146 :     fun doDim (Ty.DimConst d) = d
147 :     | doDim (Ty.DimVar d) = let val Ty.DimConst d = TypeUtil.resolveDim d in d end
148 :     in
149 :     List.map doDim dd
150 :     end
151 :     val info as ImageInfo.ImgInfo{dim, ty=(rng, _), ...} = ImageInfo.getInfo filename
152 :     fun rngToS [] = "real"
153 :     | rngToS dd = concat["tensor[", String.concatWith "," (List.map Int.toString dd), "]"]
154 :     fun error msg = raise Error("image file \"" :: filename :: "\" " :: msg)
155 : jhr 234 in
156 : jhr 245 (* check that the expected dimension and actual dimension match *)
157 :     if (d <> dim)
158 : jhr 1140 then error ["has dimension ", Int.toString dim, ", expected ", Int.toString d]
159 :     (* check that the expected shape and actual shape match *)
160 :     else if not(ListPair.allEq (op =) (dd, rng))
161 :     then error ["has range ", rngToS rng, ", expected ", rngToS dd]
162 : jhr 245 else ();
163 : jhr 1116 info
164 : jhr 234 end
165 :    
166 : jhr 231 fun evalVar env x = (case VMap.find (env, x)
167 :     of SOME v => v
168 :     | NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)
169 :     (* end case *))
170 :    
171 : jhr 269 fun apply (env, f, mvs, xs) =
172 :     if List.all (fn x => VMap.inDomain(env, x)) xs
173 :     then (* try *)(
174 : jhr 231 if Var.same(f, BV.fn_load)
175 : jhr 1116 then let
176 :     val [imgName] = xs
177 :     in
178 :     SOME(ImgV(loadImage(mvs, evalVar env imgName), imgName))
179 :     end
180 : jhr 231 else (case VTbl.find tbl f
181 : jhr 269 of SOME evalFn => SOME(evalFn (List.map (evalVar env) xs))
182 :     | NONE => NONE
183 : jhr 231 (* end case *))
184 : jhr 1140 ) handle ex as Error msg => raise ex
185 :     | ex => (
186 :     TextIO.output (TextIO.stdErr, concat [
187 :     Var.uniqueNameOf f, "(",
188 :     String.concatWith "," (List.map Var.uniqueNameOf xs),
189 :     ") fails with exception ", exnName ex, "\n"
190 :     ]);
191 : jhr 269 raise ex)
192 :     else NONE
193 :    
194 :     fun evalExp (env, e) = (case e
195 :     of S.E_Var x => VMap.find (env, x)
196 :     | S.E_Lit(Literal.Int i) => SOME(IV i)
197 :     | S.E_Lit(Literal.Float f) => SOME(RV(FloatLit.toReal f))
198 :     | S.E_Lit(Literal.String s) => SOME(SV s)
199 :     | S.E_Lit(Literal.Bool b) => SOME(BV b)
200 :     | S.E_Tuple _ => raise Fail "E_Tuple"
201 :     | S.E_Apply(f, mvs, xs, _) => apply(env, f, mvs, xs)
202 : jhr 1116 | S.E_Cons xs => (case evalArgs(env, xs)
203 :     of NONE => NONE
204 :     | SOME vs => SOME(TV vs)
205 :     (* end case *))
206 :     | S.E_Slice(x, indices, _) => (case VMap.find (env, x)
207 :     of SOME v => let
208 :     fun slice (TV vs, SOME ix :: ixs) = (case VMap.find (env, ix)
209 :     of SOME(IV i) => slice (List.nth(vs, IntInf.toInt i), ixs)
210 :     | NONE => raise Subscript
211 :     (* end case *))
212 :     | slice (TV vs, NONE :: ixs) =
213 :     TV(List.map (fn v => slice(v, ixs)) vs)
214 :     | slice (v, []) = v
215 :     in
216 :     SOME(slice(v, indices)) handle Subscript => NONE
217 :     end
218 :     | _ => NONE
219 :     (* end case *))
220 : jhr 269 | S.E_Input(ty, name, optDefault) => raise Fail "impossible"
221 : jhr 1116 | S.E_LoadImage info => SOME(ImgV info)
222 : jhr 269 (* end case *))
223 :    
224 : jhr 1116 and evalArgs (env, args) = let
225 :     fun eval ([], vs) = SOME(List.rev vs)
226 :     | eval (x::xs, vs) = (case VMap.find(env, x)
227 :     of SOME v => eval(xs, v::vs)
228 :     | NONE => NONE
229 :     (* end case *))
230 :     in
231 :     eval (args, [])
232 :     end
233 :    
234 :     fun getInput (ty, name, optDefault) = (case ty
235 :     of Ty.T_Bool =>
236 :     Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)
237 :     | Ty.T_Int =>
238 :     Inputs.getInput(name, (Option.map IV) o IntInf.fromString, optDefault)
239 :     | Ty.T_String => Inputs.getInput(name, fn s => SOME(SV s), optDefault)
240 :     | Ty.T_Tensor(Ty.Shape[]) =>
241 :     Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault)
242 :     | Ty.T_Tensor(Ty.Shape[Ty.DimConst d]) => let
243 :     fun fromString s = let
244 :     (* first split into fields by "," *)
245 :     val flds = String.fields (fn #"," => true | _ => false) s
246 :     (* then tokenize by white space and flatten *)
247 :     val toks = List.concat(List.map (String.tokens Char.isSpace) flds)
248 :     (* then convert to reals *)
249 :     val vals = List.map (RV o valOf o Real.fromString) toks
250 :     in
251 :     if (List.length vals = d)
252 :     then SOME(TV(vals))
253 :     else NONE
254 :     end
255 :     handle _ => NONE
256 :     in
257 :     Inputs.getInput(name, fromString, optDefault)
258 :     end
259 :     | Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs"
260 :     | _ => raise Fail(concat[
261 :     "input ", name, " has invalid type ", TypeUtil.toString ty
262 :     ])
263 :     (* end case *))
264 :    
265 : jhr 269 fun evalStatics (statics, blk) = let
266 :     fun evalBlock (env, S.Block stms) = let
267 :     exception Done of value VMap.map
268 :     fun evalStm (stm, env) = (case stm
269 : jhr 1116 of S.S_Var _ => raise Fail "unexpected variable decl"
270 :     | S.S_Assign(x, S.E_Input(ty, name, optDefault)) =>
271 : jhr 269 if VSet.member(statics, x)
272 :     then let
273 :     val optDefault = Option.map (evalVar env) optDefault
274 : jhr 1116 val input = getInput (ty, name, optDefault)
275 : jhr 269 in
276 :     case input
277 :     of SOME v => VMap.insert(env, x, v)
278 :     | NONE => raise Fail("error getting required input " ^ name)
279 :     (* end case *)
280 :     end
281 :     else env
282 :     | S.S_Assign(x, e) => (case evalExp(env, e)
283 :     of SOME v =>
284 : jhr 340 (Log.msg(concat["eval assignment: ", Var.uniqueNameOf x, " = ", toString v, "\n"]);
285 : jhr 269 VMap.insert(env, x, v)
286 :     )
287 :     | NONE => env
288 :     (* end case *))
289 :     | S.S_IfThenElse(x, b1, b2) => (case VMap.find(env, x)
290 :     of SOME(BV true) => evalBlock(env, b1)
291 :     | SOME(BV false) => evalBlock(env, b2)
292 :     | SOME _ => raise Fail "type error"
293 :     | NONE => raise (Done env)
294 :     (* end case *))
295 : jhr 511 | S.S_New _ => raise Fail "unexpected new strand"
296 : jhr 269 | S.S_Die => raise Fail "unexpected die"
297 :     | S.S_Stabilize => raise Fail "unexpected stabilize"
298 : jhr 234 (* end case *))
299 : jhr 231 in
300 : jhr 269 (List.foldl evalStm env stms) handle Done env => env
301 : jhr 231 end
302 : jhr 236 in
303 : jhr 269 evalBlock (VMap.empty, blk)
304 : jhr 236 end
305 :    
306 : jhr 231 end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0