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 1793, Thu Apr 5 09:53:28 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 dim = 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            in
149            (* check that the expected dimension and actual dimension match *)                    List.map doDim dd
150              if (d <> dim)                  end
151                then raise Fail(concat["image file \"", filename, "\" has wrong dimension"])            val nrrd = NrrdInfo.getInfo filename
152                else ();            in
153            (* check that the expected shape and actual shape match *)              case ImageInfo.mkInfo (nrrd, dim, dd)
154  (* FIXME *)               of SOME info => info
155              Img info                | NONE => let
156                      fun rngToS [] = "real"
157                        | rngToS dd = concat["tensor[", String.concatWith "," (List.map Int.toString dd), "]"]
158                      fun error msg = raise Error("image file \"" :: filename :: "\" " :: msg)
159                      in
160                      (* figure out what the mismatch is *)
161                        if (NrrdInfo.dim nrrd <> dim)
162                          then error [
163                              "has dimension ", Int.toString(NrrdInfo.dim nrrd),
164                              ", expected ", Int.toString dim
165                            ]
166                          else error ["has unexpected range ", rngToS dd]
167                      end
168                (* end case *)
169            end            end
170    
171      fun evalVar env x = (case VMap.find (env, x)      fun evalVar env x = (case VMap.find (env, x)
# Line 150  Line 173 
173              | NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)              | NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)
174            (* end case *))            (* end case *))
175    
176      fun evalExp (env, e) = (case e      fun apply (env, f, mvs, xs) =
177             of S.E_Var x => evalVar env x            if List.all (fn x => VMap.inDomain(env, x)) xs
178              | 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 *)(  
179                  if Var.same(f, BV.fn_load)                  if Var.same(f, BV.fn_load)
180                    then loadImage(mvs, List.map (evalVar env) xs)                    then let
181                        val [imgName] = xs
182                        in
183                          SOME(ImgV(loadImage(mvs, evalVar env imgName), imgName))
184                        end
185                    else (case VTbl.find tbl f                    else (case VTbl.find tbl f
186                       of SOME evalFn => evalFn (List.map (evalVar env) xs)                       of SOME evalFn => SOME(evalFn (List.map (evalVar env) xs))
187                        | NONE => raise Fail("Eval.exvalExp: unknown function " ^ Var.nameOf f)                        | NONE => NONE
188                      (* end case *))                      (* end case *))
189                  ) handle ex => (                  ) handle ex as Error msg => raise ex
190                           | ex => (
191                    TextIO.output (TextIO.stdErr, concat [                    TextIO.output (TextIO.stdErr, concat [
192                        Var.uniqueNameOf f, "(",                        Var.uniqueNameOf f, "(",
193                        String.concatWith "," (List.map Var.uniqueNameOf xs),                        String.concatWith "," (List.map Var.uniqueNameOf xs),
194                        ") fails with exception ", exnName ex, "\n"                        ") fails with exception ", exnName ex, "\n"
195                      ]);                      ]);
196                    raise ex))                raise ex)
197              | S.E_Cons xs => raise Fail "TODO: E_Cons"              else NONE
198              | S.E_Input(ty, name, optDefault) => let  
199                  val optDefault = Option.map (evalVar env) optDefault      fun evalExp (env, e) = (case e
200                  val SOME value = (case ty             of S.E_Var x => VMap.find (env, x)
201                | S.E_Lit(Literal.Int i) => SOME(IV i)
202                | S.E_Lit(Literal.Float f) => SOME(RV(FloatLit.toReal f))
203                | S.E_Lit(Literal.String s) => SOME(SV s)
204                | S.E_Lit(Literal.Bool b) => SOME(BV b)
205                | S.E_Tuple _ => raise Fail "E_Tuple"
206                | S.E_Apply(f, mvs, xs, _) => apply(env, f, mvs, xs)
207                | S.E_Cons xs => (case evalArgs(env, xs)
208                     of NONE => NONE
209                      | SOME vs => SOME(TV vs)
210                    (* end case *))
211                | S.E_Slice(x, indices, _) => (case VMap.find (env, x)
212                     of SOME v => let
213                          fun slice (TV vs, SOME ix :: ixs) = (case VMap.find (env, ix)
214                                 of SOME(IV i) => slice (List.nth(vs, IntInf.toInt i), ixs)
215                                  | NONE => raise Subscript
216                                (* end case *))
217                            | slice (TV vs, NONE :: ixs) =
218                                TV(List.map (fn v => slice(v, ixs)) vs)
219                            | slice (v, []) = v
220                          in
221                            SOME(slice(v, indices)) handle Subscript => NONE
222                          end
223                      | _ => NONE
224                    (* end case *))
225                | S.E_Input(ty, name, desc, optDefault) => raise Fail "impossible"
226                | S.E_LoadImage info => SOME(ImgV info)
227              (* end case *))
228    
229        and evalArgs (env, args) = let
230              fun eval ([], vs) = SOME(List.rev vs)
231                | eval (x::xs, vs) = (case VMap.find(env, x)
232                     of SOME v => eval(xs, v::vs)
233                      | NONE => NONE
234                    (* end case *))
235              in
236                eval (args, [])
237              end
238    
239        fun getInput (ty, name, optDefault) = (case ty
240                         of Ty.T_Bool =>                         of Ty.T_Bool =>
241                              Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)                              Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)
242                          | Ty.T_Int =>                          | Ty.T_Int =>
# Line 183  Line 244 
244                          | Ty.T_String => Inputs.getInput(name, fn s => SOME(SV s), optDefault)                          | Ty.T_String => Inputs.getInput(name, fn s => SOME(SV s), optDefault)
245                          | Ty.T_Tensor(Ty.Shape[]) =>                          | Ty.T_Tensor(Ty.Shape[]) =>
246                              Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault)                              Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault)
247                | Ty.T_Tensor(Ty.Shape[Ty.DimConst d]) => let
248                    fun fromString s = let
249                        (* first split into fields by "," *)
250                          val flds = String.fields (fn #"," => true | _ => false) s
251                        (* then tokenize by white space and flatten *)
252                          val toks = List.concat(List.map (String.tokens Char.isSpace) flds)
253                        (* then convert to reals *)
254                          val vals = List.map (RV o valOf o Real.fromString) toks
255                          in
256                            if (List.length vals = d)
257                              then SOME(TV(vals))
258                              else NONE
259                          end
260                          handle _ => NONE
261                    in
262                      Inputs.getInput(name, fromString, optDefault)
263                    end
264                          | Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs"                          | Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs"
265                          | _ => raise Fail(concat[                          | _ => raise Fail(concat[
266                                "input ", name, " has invalid type ", TypeUtil.toString ty                                "input ", name, " has invalid type ", TypeUtil.toString ty
267                              ])                              ])
268                        (* end case *))                        (* end case *))
                 in  
                   value  
                 end  
             | S.E_Field fld => FV fld  
             | S.E_LoadImage info => Img info  
           (* end case *))  
269    
270        fun evalStatics (statics, blk) = let
271      fun evalBlock (env, S.Block stms) = let      fun evalBlock (env, S.Block stms) = let
272                    exception Done of value VMap.map
273            fun evalStm (stm, env) = (case stm            fun evalStm (stm, env) = (case stm
274                   of S.S_Assign(x, e) => VMap.insert(env, x, evalExp(env, e))                         of S.S_Var _ => raise Fail "unexpected variable decl"
275                    | S.S_IfThenElse(x, b1, b2) => (case evalVar env x                          | S.S_Assign(x, S.E_Input(ty, name, desc, optDefault)) =>
276                         of BV true => evalBlock(env, b1)                              if VSet.member(statics, x)
277                          | BV false => evalBlock(env, b2)                                then let
278                          | _ => raise Fail "type error"                                  val optDefault = Option.map (evalVar env) optDefault
279                                    val input = getInput (ty, name, optDefault)
280                                    in
281                                      case input
282                                       of SOME v => VMap.insert(env, x, v)
283                                        | NONE => raise Fail("error getting required input " ^ name)
284                                      (* end case *)
285                                    end
286                                  else env
287                            | S.S_Assign(x, e) => (case evalExp(env, e)
288                                 of SOME v =>
289    (Log.msg(concat["eval assignment: ", Var.uniqueNameOf x, " = ", toString v, "\n"]);
290                                    VMap.insert(env, x, v)
291    )
292                                  | NONE => env
293                                (* end case *))
294                            | S.S_IfThenElse(x, b1, b2) => (case VMap.find(env, x)
295                                 of SOME(BV true) => evalBlock(env, b1)
296                                  | SOME(BV false) => evalBlock(env, b2)
297                                  | SOME _ => raise Fail "type error"
298                                  | NONE => raise (Done env)
299                        (* end case *))                        (* end case *))
300                    | S.S_New _ => raise Fail "unexpected new actor"                          | S.S_New _ => raise Fail "unexpected new strand"
301                    | S.S_Die => raise Fail "unexpected die"                    | S.S_Die => raise Fail "unexpected die"
302                    | S.S_Stabilize => raise Fail "unexpected stabilize"                    | S.S_Stabilize => raise Fail "unexpected stabilize"
303                            | S.S_Print _ => raise Fail "unexpected print"
304                  (* end case *))                  (* end case *))
305            in            in
306              List.foldl evalStm env stms                    (List.foldl evalStm env stms) handle Done env => env
307                    end
308              in
309                evalBlock (VMap.empty, blk)
310            end            end
   
     fun evalStatics staticInit = evalBlock (VMap.empty, staticInit)  
311    
312    end    end

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

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