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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/src/compiler/simplify/eval.sml revision 245, Fri Aug 6 15:31:55 2010 UTC branches/vis12/src/compiler/simplify/eval.sml revision 1685, Sun Jan 22 15:23:36 2012 UTC
# Line 1  Line 1 
1  (* eval.sml  (* eval.sml
2   *   *
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * Evaluation of "static" expressions.   * Evaluation of "static" expressions.
# Line 8  Line 8 
8    
9  structure Eval : sig  structure Eval : sig
10    
11      (* 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      datatype value      datatype value
17        = BV of bool        = BV of bool
18        | SV of string        | SV of string
19        | IV of IntInf.int        | IV of IntInf.int
20        | TV of (int list * real list)    (* tensors *)        | RV of real
21        | FV of FieldDef.field_def        | TV of value list        (* tensors: values will either be RV or TV *)
22        | Img of ImageInfo.info        | ImgV of ImageInfo.info * Var.var
       | KV of Kernel.kernel  
23    
24      val evalStatics : Simple.block -> value Var.Map.map      val evalStatics : Var.Set.set * Simple.block -> value Var.Map.map
25    
26    end = struct    end = struct
27    
# Line 25  Line 29 
29      structure BV = BasisVars      structure BV = BasisVars
30      structure S = Simple      structure S = Simple
31      structure VMap = Var.Map      structure VMap = Var.Map
32        structure VSet = Var.Set
33      structure VTbl = Var.Tbl      structure VTbl = Var.Tbl
34    
35        exception Error of string list
36    
37      datatype value      datatype value
38        = BV of bool        = BV of bool
39        | SV of string        | SV of string
40        | IV of IntInf.int        | IV of IntInf.int
41        | TV of (int list * real list)    (* tensors *)  (* FIXME: we probably should use FloatLit.float values instead of reals! *)
42        | FV of FieldDef.field_def        | RV of real
43        | Img of ImageInfo.info        | TV of value list        (* tensors: values will either be RV or TV *)
44        | KV of Kernel.kernel        | ImgV of ImageInfo.info * Var.var
   
     fun RV r = TV([], [r])  
45    
46      fun toString (BV b) = Bool.toString b      fun toString (BV b) = Bool.toString b
47        | toString (IV i) = IntInf.toString i        | toString (IV i) = IntInf.toString i
48        | toString (SV s) = concat["\"", String.toString s, "\""]        | toString (SV s) = concat["\"", String.toString s, "\""]
49        | toString (TV(s, v)) = "tensor"        | toString (RV r) = Real.toString r
50        | toString (FV fld) = FieldDef.toString fld        | toString (TV _) = "tensor"
51        | toString (Img info) = ImageInfo.toString info  (* FIXME: should include x in output *)
52        | toString (KV h) = Kernel.toString h        | toString (ImgV(info, x)) = ImageInfo.toString info
53    
54      val tbl : (value list -> value) VTbl.hash_table = let      val tbl : (value list -> value) VTbl.hash_table = let
55            val tbl = VTbl.mkTable (128, Fail "Eval table")            val tbl = VTbl.mkTable (128, Fail "Eval table")
56            fun intBinOp rator [IV a, IV b] = IV(rator(a, b))            fun intBinOp rator [IV a, IV b] = IV(rator(a, b))
57            fun tensorBinOp rator [TV(s1, v1), TV(s2, v2)] =            fun tensorBinOp rator [v1, v2] = let
58                  TV(s1, ListPair.mapEq rator (v1, v2))                  fun f (TV v1, TV v2) = TV(ListPair.mapEq f (v1, v2))
59            fun realBinOp rator [TV([], [a]), TV([], [b])] = RV(rator(a, b))                    | f (RV r1, RV r2) = RV(rator(r1, r2))
60            fun realUnOp rator [TV([], [a])] = RV(rator a)                  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            fun intCmp rator [IV a, IV b] = BV(rator(a, b))            fun intCmp rator [IV a, IV b] = BV(rator(a, b))
66            fun realCmp rator [TV([], [a]), TV([], [b])] = BV(rator(a, b))            fun realCmp rator [RV a, RV b] = BV(rator(a, b))
67            fun boolCmp rator [BV a, BV b] = BV(rator(a, b))            fun boolCmp rator [BV a, BV b] = BV(rator(a, b))
68            fun stringCmp rator [SV a, SV b] = BV(rator(a, b))            fun stringCmp rator [SV a, SV b] = BV(rator(a, b))
           fun kernel h [] = KV h  
69            in            in
70              List.app (VTbl.insert tbl) [              List.app (VTbl.insert tbl) [
71                  (BV.add_ii,             intBinOp (op +)),                  (BV.add_ii,             intBinOp (op +)),
# Line 94  Line 102 
102                  (BV.neg_i,              fn [IV i] => IV(~i)),                  (BV.neg_i,              fn [IV i] => IV(~i)),
103  (*  (*
104                  (BV.neg_t,              tensorOp Op.Neg),                  (BV.neg_t,              tensorOp Op.Neg),
 *)  
105                  (BV.neg_f,              fn [FV fld] => FV(FieldDef.neg fld)),                  (BV.neg_f,              fn [FV fld] => FV(FieldDef.neg fld)),
 (*  
106                  (BV.op_at,              fn (y, _, xs) => assign(y, Op.Probe, xs)),                  (BV.op_at,              fn (y, _, xs) => assign(y, Op.Probe, xs)),
 *)  
107                  (BV.op_D,               fn [FV fld] => FV(FieldDef.diff fld)),                  (BV.op_D,               fn [FV fld] => FV(FieldDef.diff fld)),
 (*  
108                  (BV.op_norm,            tensorOp Op.Norm),                  (BV.op_norm,            tensorOp Op.Norm),
109  *)  *)
110                  (BV.op_not,             fn [BV b] => BV(not b)),                  (BV.op_not,             fn [BV b] => BV(not b)),
111  (*  (*
                 (BV.op_subscript,       fn (y, [SK, NK], xs) => ??),  
112                  (BV.fn_CL,              fn (y, _, xs) => assign(y, Op.CL, xs)),                  (BV.fn_CL,              fn (y, _, xs) => assign(y, Op.CL, xs)),
113                    (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  *)  *)
                 (BV.fn_convolve,        fn [KV h, Img info] => FV(FieldDef.CONV(info, h))),  
116                  (BV.fn_cos,             realUnOp Math.cos),                  (BV.fn_cos,             realUnOp Math.cos),
117  (*  (*
118                  (BV.fn_dot,             vectorOp Op.Dot),                  (BV.fn_dot,             vectorOp Op.Dot),
# Line 122  Line 126 
126                  (BV.fn_principleEvec,   vectorOp Op.PrincipleEvec),                  (BV.fn_principleEvec,   vectorOp Op.PrincipleEvec),
127  *)  *)
128                  (BV.fn_sin,             realUnOp Math.sin),                  (BV.fn_sin,             realUnOp Math.sin),
129    (*
130                  (BV.kn_bspln3,          kernel Kernel.bspln3),                  (BV.kn_bspln3,          kernel Kernel.bspln3),
131                  (BV.kn_bspln5,          kernel Kernel.bspln5),                  (BV.kn_bspln5,          kernel Kernel.bspln5),
132                  (BV.kn_ctmr,            kernel Kernel.ctmr),                  (BV.kn_ctmr,            kernel Kernel.ctmr),
133                  (BV.kn_tent,            kernel Kernel.tent),                  (BV.kn_tent,            kernel Kernel.tent),
134                    (BV.kn_c1tent,          kernel Kernel.c1tent),
135                    (BV.kn_c2ctmr,          kernel Kernel.c2ctmr),
136    *)
137                  (BV.i2r,                fn [IV i] => RV(real(IntInf.toInt i)))                  (BV.i2r,                fn [IV i] => RV(real(IntInf.toInt i)))
138                ];                ];
139              tbl              tbl
140            end            end
141    
142      fun loadImage ([Ty.DIM dim, Ty.SHAPE shp], [SV filename]) = let      fun loadImage ([Ty.DIM dim, Ty.SHAPE shp], SV filename) = let
143            val Ty.DimConst d = TypeUtil.resolveDim dim            val Ty.DimConst d = TypeUtil.resolveDim dim
144              val dd = let
145            val Ty.Shape dd = TypeUtil.resolveShape shp            val Ty.Shape dd = TypeUtil.resolveShape shp
146            val info as ImageInfo.ImgInfo{dim, ...} = ImageInfo.getInfo filename                  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            in            in
156            (* check that the expected dimension and actual dimension match *)            (* check that the expected dimension and actual dimension match *)
157              if (d <> dim)              if (d <> dim)
158                then raise Fail(concat["image file \"", filename, "\" has wrong dimension"])                then error ["has dimension ", Int.toString dim, ", expected ", Int.toString d]
               else ();  
159            (* check that the expected shape and actual shape match *)            (* check that the expected shape and actual shape match *)
160  (* FIXME *)              else if not(ListPair.allEq (op =) (dd, rng))
161              Img info                then error ["has range ", rngToS rng, ", expected ", rngToS dd]
162                  else ();
163                info
164            end            end
165    
166      fun evalVar env x = (case VMap.find (env, x)      fun evalVar env x = (case VMap.find (env, x)
# Line 150  Line 168 
168              | NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)              | NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)
169            (* end case *))            (* end case *))
170    
171      fun evalExp (env, e) = (case e      fun apply (env, f, mvs, xs) =
172             of S.E_Var x => evalVar env x            if List.all (fn x => VMap.inDomain(env, x)) xs
173              | S.E_Lit(Literal.Int i) => IV i              then (* try *)(
             | S.E_Lit(Literal.Float f) => RV(FloatLit.toReal f)  
             | S.E_Lit(Literal.String s) => SV s  
             | S.E_Lit(Literal.Bool b) => BV b  
             | S.E_Tuple _ => raise Fail "E_Tuple"  
             | S.E_Apply(f, mvs, xs, _) => (  
                 (* try *)(  
174                  if Var.same(f, BV.fn_load)                  if Var.same(f, BV.fn_load)
175                    then loadImage(mvs, List.map (evalVar env) xs)                    then let
176                        val [imgName] = xs
177                        in
178                          SOME(ImgV(loadImage(mvs, evalVar env imgName), imgName))
179                        end
180                    else (case VTbl.find tbl f                    else (case VTbl.find tbl f
181                       of SOME evalFn => evalFn (List.map (evalVar env) xs)                       of SOME evalFn => SOME(evalFn (List.map (evalVar env) xs))
182                        | NONE => raise Fail("Eval.exvalExp: unknown function " ^ Var.nameOf f)                        | NONE => NONE
183                      (* end case *))                      (* end case *))
184                  ) handle ex => (                  ) handle ex as Error msg => raise ex
185                           | ex => (
186                    TextIO.output (TextIO.stdErr, concat [                    TextIO.output (TextIO.stdErr, concat [
187                        Var.uniqueNameOf f, "(",                        Var.uniqueNameOf f, "(",
188                        String.concatWith "," (List.map Var.uniqueNameOf xs),                        String.concatWith "," (List.map Var.uniqueNameOf xs),
189                        ") fails with exception ", exnName ex, "\n"                        ") fails with exception ", exnName ex, "\n"
190                      ]);                      ]);
191                    raise ex))                raise ex)
192              | S.E_Cons xs => raise Fail "TODO: E_Cons"              else NONE
193              | S.E_Input(ty, name, optDefault) => let  
194                  val optDefault = Option.map (evalVar env) optDefault      fun evalExp (env, e) = (case e
195                  val SOME value = (case ty             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                | 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                | S.E_Input(ty, name, desc, optDefault) => raise Fail "impossible"
221                | S.E_LoadImage info => SOME(ImgV info)
222              (* end case *))
223    
224        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 =>                         of Ty.T_Bool =>
236                              Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)                              Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)
237                          | Ty.T_Int =>                          | Ty.T_Int =>
# Line 183  Line 239 
239                          | Ty.T_String => Inputs.getInput(name, fn s => SOME(SV s), optDefault)                          | Ty.T_String => Inputs.getInput(name, fn s => SOME(SV s), optDefault)
240                          | Ty.T_Tensor(Ty.Shape[]) =>                          | Ty.T_Tensor(Ty.Shape[]) =>
241                              Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault)                              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"                          | Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs"
260                          | _ => raise Fail(concat[                          | _ => raise Fail(concat[
261                                "input ", name, " has invalid type ", TypeUtil.toString ty                                "input ", name, " has invalid type ", TypeUtil.toString ty
262                              ])                              ])
263                        (* end case *))                        (* end case *))
                 in  
                   value  
                 end  
             | S.E_Field fld => FV fld  
             | S.E_LoadImage info => Img info  
           (* end case *))  
264    
265        fun evalStatics (statics, blk) = let
266      fun evalBlock (env, S.Block stms) = let      fun evalBlock (env, S.Block stms) = let
267                    exception Done of value VMap.map
268            fun evalStm (stm, env) = (case stm            fun evalStm (stm, env) = (case stm
269                   of S.S_Assign(x, e) => VMap.insert(env, x, evalExp(env, e))                         of S.S_Var _ => raise Fail "unexpected variable decl"
270                    | S.S_IfThenElse(x, b1, b2) => (case evalVar env x                          | S.S_Assign(x, S.E_Input(ty, name, desc, optDefault)) =>
271                         of BV true => evalBlock(env, b1)                              if VSet.member(statics, x)
272                          | BV false => evalBlock(env, b2)                                then let
273                          | _ => raise Fail "type error"                                  val optDefault = Option.map (evalVar env) optDefault
274                                    val input = getInput (ty, name, optDefault)
275                                    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    (Log.msg(concat["eval assignment: ", Var.uniqueNameOf x, " = ", toString v, "\n"]);
285                                    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 *))                        (* end case *))
295                    | S.S_New _ => raise Fail "unexpected new actor"                          | S.S_New _ => raise Fail "unexpected new strand"
296                    | S.S_Die => raise Fail "unexpected die"                    | S.S_Die => raise Fail "unexpected die"
297                    | S.S_Stabilize => raise Fail "unexpected stabilize"                    | S.S_Stabilize => raise Fail "unexpected stabilize"
298                            | S.S_Print _ => raise Fail "unexpected print"
299                  (* end case *))                  (* end case *))
300            in            in
301              List.foldl evalStm env stms                    (List.foldl evalStm env stms) handle Done env => env
302                    end
303              in
304                evalBlock (VMap.empty, blk)
305            end            end
   
     fun evalStatics staticInit = evalBlock (VMap.empty, staticInit)  
306    
307    end    end

Legend:
Removed from v.245  
changed lines
  Added in v.1685

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