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 511 - (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 236 datatype value
12 :     = BV of bool
13 :     | SV of string
14 :     | IV of IntInf.int
15 :     | TV of (int list * real list) (* tensors *)
16 :     | FV of FieldDef.field_def
17 :     | Img of ImageInfo.info
18 :     | KV of Kernel.kernel
19 :    
20 : jhr 269 val evalStatics : Var.Set.set * Simple.block -> value Var.Map.map
21 : jhr 236
22 :     end = struct
23 :    
24 : jhr 234 structure Ty = Types
25 :     structure BV = BasisVars
26 : jhr 231 structure S = Simple
27 :     structure VMap = Var.Map
28 : jhr 269 structure VSet = Var.Set
29 : jhr 231 structure VTbl = Var.Tbl
30 :    
31 :     datatype value
32 :     = BV of bool
33 : jhr 234 | SV of string
34 : jhr 231 | IV of IntInf.int
35 :     | TV of (int list * real list) (* tensors *)
36 :     | FV of FieldDef.field_def
37 : jhr 234 | Img of ImageInfo.info
38 : jhr 231 | KV of Kernel.kernel
39 :    
40 :     fun RV r = TV([], [r])
41 :    
42 : jhr 234 fun toString (BV b) = Bool.toString b
43 :     | toString (IV i) = IntInf.toString i
44 :     | toString (SV s) = concat["\"", String.toString s, "\""]
45 :     | toString (TV(s, v)) = "tensor"
46 :     | toString (FV fld) = FieldDef.toString fld
47 :     | toString (Img info) = ImageInfo.toString info
48 :     | toString (KV h) = Kernel.toString h
49 : jhr 231
50 :     val tbl : (value list -> value) VTbl.hash_table = let
51 :     val tbl = VTbl.mkTable (128, Fail "Eval table")
52 :     fun intBinOp rator [IV a, IV b] = IV(rator(a, b))
53 :     fun tensorBinOp rator [TV(s1, v1), TV(s2, v2)] =
54 :     TV(s1, ListPair.mapEq rator (v1, v2))
55 : jhr 234 fun realBinOp rator [TV([], [a]), TV([], [b])] = RV(rator(a, b))
56 : jhr 245 fun realUnOp rator [TV([], [a])] = RV(rator a)
57 : jhr 231 fun intCmp rator [IV a, IV b] = BV(rator(a, b))
58 :     fun realCmp rator [TV([], [a]), TV([], [b])] = BV(rator(a, b))
59 : jhr 234 fun boolCmp rator [BV a, BV b] = BV(rator(a, b))
60 :     fun stringCmp rator [SV a, SV b] = BV(rator(a, b))
61 : jhr 231 fun kernel h [] = KV h
62 :     in
63 :     List.app (VTbl.insert tbl) [
64 :     (BV.add_ii, intBinOp (op +)),
65 :     (BV.add_tt, tensorBinOp (op +)),
66 :     (BV.sub_ii, intBinOp (op -)),
67 :     (BV.sub_tt, tensorBinOp (op -)),
68 : jhr 234 (BV.mul_ii, intBinOp (op * )),
69 :     (BV.mul_rr, realBinOp (op * )),
70 :     (*
71 : jhr 231 (BV.mul_rt, tensorOp Op.Scale),
72 :     (BV.mul_tr, fn (y, sv, [t, r]) => tensorOp Op.Scale (y, sv, [r, t])),
73 : jhr 234 *)
74 : jhr 231 (BV.div_ii, intBinOp IntInf.quot),
75 : jhr 234 (BV.div_rr, realBinOp (op /)),
76 :     (*
77 : jhr 231 (BV.div_tr, tensorOp Op.InvScale),
78 : jhr 234 *)
79 : jhr 231 (BV.lt_ii, intCmp (op <)),
80 :     (BV.lt_rr, realCmp (op <)),
81 :     (BV.lte_ii, intCmp (op <=)),
82 :     (BV.lte_rr, realCmp (op <=)),
83 :     (BV.gte_ii, intCmp (op >=)),
84 :     (BV.gte_rr, realCmp (op >=)),
85 :     (BV.gt_ii, intCmp (op >)),
86 :     (BV.gt_rr, realCmp (op >)),
87 : jhr 234 (BV.equ_bb, boolCmp (op =)),
88 : jhr 231 (BV.equ_ii, intCmp (op =)),
89 : jhr 234 (BV.equ_ss, stringCmp (op =)),
90 : jhr 231 (BV.equ_rr, realCmp Real.==),
91 : jhr 234 (BV.neq_bb, boolCmp (op <>)),
92 : jhr 231 (BV.neq_ii, intCmp (op <>)),
93 : jhr 234 (BV.neq_ss, stringCmp (op <>)),
94 : jhr 231 (BV.neq_rr, realCmp Real.!=),
95 : jhr 245 (BV.neg_i, fn [IV i] => IV(~i)),
96 : jhr 234 (*
97 : jhr 231 (BV.neg_t, tensorOp Op.Neg),
98 : jhr 245 *)
99 :     (BV.neg_f, fn [FV fld] => FV(FieldDef.neg fld)),
100 :     (*
101 : jhr 231 (BV.op_at, fn (y, _, xs) => assign(y, Op.Probe, xs)),
102 : jhr 245 *)
103 :     (BV.op_D, fn [FV fld] => FV(FieldDef.diff fld)),
104 :     (*
105 : jhr 231 (BV.op_norm, tensorOp Op.Norm),
106 : jhr 245 *)
107 :     (BV.op_not, fn [BV b] => BV(not b)),
108 : jhr 231 (*
109 : jhr 245 (BV.fn_CL, fn (y, _, xs) => assign(y, Op.CL, xs)),
110 : jhr 231 *)
111 : jhr 269 (BV.op_convolve, fn [Img info, KV h] => FV(FieldDef.CONV(0, info, h))),
112 :     (BV.fn_convolve, fn [KV h, Img info] => FV(FieldDef.CONV(0, info, h))),
113 : jhr 245 (BV.fn_cos, realUnOp Math.cos),
114 :     (*
115 : jhr 231 (BV.fn_dot, vectorOp Op.Dot),
116 :     (BV.fn_inside, fn (y, _, xs) => assign(y, Op.Inside, xs)),
117 : jhr 234 *)
118 :     (BV.fn_max, realBinOp Real.min),
119 :     (BV.fn_min, realBinOp Real.max),
120 :     (BV.fn_modulate, tensorBinOp (op * )),
121 :     (BV.fn_pow, realBinOp Real.Math.pow),
122 : jhr 231 (*
123 :     (BV.fn_principleEvec, vectorOp Op.PrincipleEvec),
124 : jhr 234 *)
125 : jhr 245 (BV.fn_sin, realUnOp Math.sin),
126 : jhr 231 (BV.kn_bspln3, kernel Kernel.bspln3),
127 :     (BV.kn_bspln5, kernel Kernel.bspln5),
128 :     (BV.kn_ctmr, kernel Kernel.ctmr),
129 :     (BV.kn_tent, kernel Kernel.tent),
130 : jhr 245 (BV.i2r, fn [IV i] => RV(real(IntInf.toInt i)))
131 : jhr 231 ];
132 :     tbl
133 :     end
134 :    
135 : jhr 245 fun loadImage ([Ty.DIM dim, Ty.SHAPE shp], [SV filename]) = let
136 :     val Ty.DimConst d = TypeUtil.resolveDim dim
137 :     val Ty.Shape dd = TypeUtil.resolveShape shp
138 :     val info as ImageInfo.ImgInfo{dim, ...} = ImageInfo.getInfo filename
139 : jhr 234 in
140 : jhr 245 (* check that the expected dimension and actual dimension match *)
141 :     if (d <> dim)
142 :     then raise Fail(concat["image file \"", filename, "\" has wrong dimension"])
143 :     else ();
144 :     (* check that the expected shape and actual shape match *)
145 :     (* FIXME *)
146 : jhr 234 Img info
147 :     end
148 :    
149 : jhr 231 fun evalVar env x = (case VMap.find (env, x)
150 :     of SOME v => v
151 :     | NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)
152 :     (* end case *))
153 :    
154 : jhr 269 fun apply (env, f, mvs, xs) =
155 :     if List.all (fn x => VMap.inDomain(env, x)) xs
156 :     then (* try *)(
157 : jhr 231 if Var.same(f, BV.fn_load)
158 : jhr 269 then SOME(loadImage(mvs, List.map (evalVar env) xs))
159 : jhr 231 else (case VTbl.find tbl f
160 : jhr 269 of SOME evalFn => SOME(evalFn (List.map (evalVar env) xs))
161 :     | NONE => NONE
162 : jhr 231 (* end case *))
163 : jhr 240 ) handle ex => (
164 :     TextIO.output (TextIO.stdErr, concat [
165 :     Var.uniqueNameOf f, "(",
166 :     String.concatWith "," (List.map Var.uniqueNameOf xs),
167 :     ") fails with exception ", exnName ex, "\n"
168 :     ]);
169 : jhr 269 raise ex)
170 :     else NONE
171 :    
172 :     fun evalExp (env, e) = (case e
173 :     of S.E_Var x => VMap.find (env, x)
174 :     | S.E_Lit(Literal.Int i) => SOME(IV i)
175 :     | S.E_Lit(Literal.Float f) => SOME(RV(FloatLit.toReal f))
176 :     | S.E_Lit(Literal.String s) => SOME(SV s)
177 :     | S.E_Lit(Literal.Bool b) => SOME(BV b)
178 :     | S.E_Tuple _ => raise Fail "E_Tuple"
179 :     | S.E_Apply(f, mvs, xs, _) => apply(env, f, mvs, xs)
180 : jhr 232 | S.E_Cons xs => raise Fail "TODO: E_Cons"
181 : jhr 399 | S.E_Slice(e, indices, _) => raise Fail "TODO: E_Slice"
182 : jhr 269 | S.E_Input(ty, name, optDefault) => raise Fail "impossible"
183 :     | S.E_Field fld => SOME(FV fld)
184 :     | S.E_LoadImage info => SOME(Img info)
185 :     (* end case *))
186 :    
187 :     fun evalStatics (statics, blk) = let
188 :     fun evalBlock (env, S.Block stms) = let
189 :     exception Done of value VMap.map
190 :     fun evalStm (stm, env) = (case stm
191 :     of S.S_Assign(x, S.E_Input(ty, name, optDefault)) =>
192 :     if VSet.member(statics, x)
193 :     then let
194 :     val optDefault = Option.map (evalVar env) optDefault
195 :     val input = (case ty
196 :     of Ty.T_Bool =>
197 :     Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)
198 :     | Ty.T_Int =>
199 :     Inputs.getInput(name, (Option.map IV) o IntInf.fromString, optDefault)
200 :     | Ty.T_String => Inputs.getInput(name, fn s => SOME(SV s), optDefault)
201 :     | Ty.T_Tensor(Ty.Shape[]) =>
202 :     Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault)
203 :     | Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs"
204 :     | _ => raise Fail(concat[
205 :     "input ", name, " has invalid type ", TypeUtil.toString ty
206 :     ])
207 :     (* end case *))
208 :     in
209 :     case input
210 :     of SOME v => VMap.insert(env, x, v)
211 :     | NONE => raise Fail("error getting required input " ^ name)
212 :     (* end case *)
213 :     end
214 :     else env
215 :     | S.S_Assign(x, e) => (case evalExp(env, e)
216 :     of SOME v =>
217 : jhr 340 (Log.msg(concat["eval assignment: ", Var.uniqueNameOf x, " = ", toString v, "\n"]);
218 : jhr 269 VMap.insert(env, x, v)
219 :     )
220 :     | NONE => env
221 :     (* end case *))
222 :     | S.S_IfThenElse(x, b1, b2) => (case VMap.find(env, x)
223 :     of SOME(BV true) => evalBlock(env, b1)
224 :     | SOME(BV false) => evalBlock(env, b2)
225 :     | SOME _ => raise Fail "type error"
226 :     | NONE => raise (Done env)
227 :     (* end case *))
228 : jhr 511 | S.S_New _ => raise Fail "unexpected new strand"
229 : jhr 269 | S.S_Die => raise Fail "unexpected die"
230 :     | S.S_Stabilize => raise Fail "unexpected stabilize"
231 : jhr 234 (* end case *))
232 : jhr 231 in
233 : jhr 269 (List.foldl evalStm env stms) handle Done env => env
234 : jhr 231 end
235 : jhr 236 in
236 : jhr 269 evalBlock (VMap.empty, blk)
237 : jhr 236 end
238 :    
239 : jhr 231 end

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