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

SCM Repository

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

Diff of /trunk/src/compiler/simplify/eval.sml

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

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

Legend:
Removed from v.231  
changed lines
  Added in v.399

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