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 236, Thu Aug 5 21:57:57 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 : Simple.program -> 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 VTbl = Var.Tbl      structure VTbl = Var.Tbl
29    
30      datatype value      datatype value
31        = BV of bool        = BV of bool
32          | SV of string
33        | IV of IntInf.int        | IV of IntInf.int
34        | TV of (int list * real list)    (* tensors *)        | TV of (int list * real list)    (* tensors *)
35        | FV of FieldDef.field_def        | FV of FieldDef.field_def
36        | IV of ImageInfo.info        | Img of ImageInfo.info
37        | KV of Kernel.kernel        | KV of Kernel.kernel
38    
39      fun RV r = TV([], [r])      fun RV r = TV([], [r])
40    
41      fun toString (BV b) =      fun toString (BV b) = Bool.toString b
42        | toString (IV i) =        | toString (IV i) = IntInf.toString i
43        | toString (TV(s, v)) =        | toString (SV s) = concat["\"", String.toString s, "\""]
44        | toString (FV fld) =        | toString (TV(s, v)) = "tensor"
45        | toString (IV info) =        | toString (FV fld) = FieldDef.toString fld
46        | toString (KV h) =        | toString (Img info) = ImageInfo.toString info
47          | toString (KV h) = Kernel.toString h
48    
49      val tbl : (value list -> value) VTbl.hash_table = let      val tbl : (value list -> value) VTbl.hash_table = let
50            val tbl = VTbl.mkTable (128, Fail "Eval table")            val tbl = VTbl.mkTable (128, Fail "Eval table")
51            fun intBinOp rator [IV a, IV b] = IV(rator(a, b))            fun intBinOp rator [IV a, IV b] = IV(rator(a, b))
52            fun tensorBinOp rator [TV(s1, v1), TV(s2, v2)] =            fun tensorBinOp rator [TV(s1, v1), TV(s2, v2)] =
53                  TV(s1, ListPair.mapEq rator (v1, v2))                  TV(s1, ListPair.mapEq rator (v1, v2))
54              fun realBinOp rator [TV([], [a]), TV([], [b])] = RV(rator(a, b))
55            fun intCmp rator [IV a, IV b] = BV(rator(a, b))            fun intCmp rator [IV a, IV b] = BV(rator(a, b))
56            fun realCmp rator [TV([], [a]), TV([], [b])] = BV(rator(a, b))            fun realCmp rator [TV([], [a]), TV([], [b])] = BV(rator(a, b))
57              fun boolCmp rator [BV a, BV b] = BV(rator(a, b))
58              fun stringCmp rator [SV a, SV b] = BV(rator(a, b))
59            fun kernel h [] = KV h            fun kernel h [] = KV h
60            in            in
61              List.app (VTbl.insert tbl) [              List.app (VTbl.insert tbl) [
# Line 45  Line 64 
64                  (BV.sub_ii,             intBinOp (op -)),                  (BV.sub_ii,             intBinOp (op -)),
65                  (BV.sub_tt,             tensorBinOp (op -)),                  (BV.sub_tt,             tensorBinOp (op -)),
66                  (BV.mul_ii,             intBinOp (op *)),                  (BV.mul_ii,             intBinOp (op *)),
67                  (BV.mul_rr,             simpleOp(Op.Mul(Op.TensorTy[]))),                  (BV.mul_rr,             realBinOp (op * )),
68    (*
69                  (BV.mul_rt,             tensorOp Op.Scale),                  (BV.mul_rt,             tensorOp Op.Scale),
70                  (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])),
71    *)
72                  (BV.div_ii,             intBinOp IntInf.quot),                  (BV.div_ii,             intBinOp IntInf.quot),
73                  (BV.div_rr,             simpleOp(Op.Div(Op.TensorTy[]))),                  (BV.div_rr,             realBinOp (op /)),
74    (*
75                  (BV.div_tr,             tensorOp Op.InvScale),                  (BV.div_tr,             tensorOp Op.InvScale),
76    *)
77                  (BV.lt_ii,              intCmp (op <)),                  (BV.lt_ii,              intCmp (op <)),
78                  (BV.lt_rr,              realCmp (op <)),                  (BV.lt_rr,              realCmp (op <)),
79                  (BV.lte_ii,             intCmp (op <=)),                  (BV.lte_ii,             intCmp (op <=)),
# Line 59  Line 82 
82                  (BV.gte_rr,             realCmp (op >=)),                  (BV.gte_rr,             realCmp (op >=)),
83                  (BV.gt_ii,              intCmp (op >)),                  (BV.gt_ii,              intCmp (op >)),
84                  (BV.gt_rr,              realCmp (op >)),                  (BV.gt_rr,              realCmp (op >)),
85                  (BV.equ_bb,             simpleOp(Op.EQ Op.BoolTy)),                  (BV.equ_bb,             boolCmp (op =)),
86                  (BV.equ_ii,             intCmp (op =)),                  (BV.equ_ii,             intCmp (op =)),
87                  (BV.equ_ss,             simpleOp(Op.EQ Op.StringTy)),                  (BV.equ_ss,             stringCmp (op =)),
88                  (BV.equ_rr,             realCmp Real.==),                  (BV.equ_rr,             realCmp Real.==),
89                  (BV.neq_bb,             simpleOp(Op.NEQ Op.BoolTy)),                  (BV.neq_bb,             boolCmp (op <>)),
90                  (BV.neq_ii,             intCmp (op <>)),                  (BV.neq_ii,             intCmp (op <>)),
91                  (BV.neq_ss,             simpleOp(Op.NEQ Op.StringTy)),                  (BV.neq_ss,             stringCmp (op <>)),
92                  (BV.neq_rr,             realCmp Real.!=),                  (BV.neq_rr,             realCmp Real.!=),
93    (*
94                  (BV.neg_i,              simpleOp(Op.Neg Op.IntTy)),                  (BV.neg_i,              simpleOp(Op.Neg Op.IntTy)),
95                  (BV.neg_t,              tensorOp Op.Neg),                  (BV.neg_t,              tensorOp Op.Neg),
96                  (BV.neg_f,              fn (y, _, xs) => assign(y, Op.NegField, xs)),                  (BV.neg_f,              fn (y, _, xs) => assign(y, Op.NegField, xs)),
# Line 82  Line 106 
106                  (BV.fn_cos,             simpleOp Op.Cos),                  (BV.fn_cos,             simpleOp Op.Cos),
107                  (BV.fn_dot,             vectorOp Op.Dot),                  (BV.fn_dot,             vectorOp Op.Dot),
108                  (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*)  
109  *)  *)
110                  (BV.fn_max,             simpleOp Op.Min),                  (BV.fn_max,             realBinOp Real.min),
111                  (BV.fn_min,             simpleOp Op.Max),                  (BV.fn_min,             realBinOp Real.max),
112                  (BV.fn_modulate,        tensorBinOp (op *)),                  (BV.fn_modulate,        tensorBinOp (op *)),
113                  (BV.fn_pow,             simpleOp Op.Pow),                  (BV.fn_pow,             realBinOp Real.Math.pow),
114    (*
115                  (BV.fn_principleEvec,   vectorOp Op.PrincipleEvec),                  (BV.fn_principleEvec,   vectorOp Op.PrincipleEvec),
116                  (BV.fn_sin,             simpleOp Op.Sin),                  (BV.fn_sin,             simpleOp Op.Sin),
117    *)
118                  (BV.kn_bspln3,          kernel Kernel.bspln3),                  (BV.kn_bspln3,          kernel Kernel.bspln3),
119                  (BV.kn_bspln5,          kernel Kernel.bspln5),                  (BV.kn_bspln5,          kernel Kernel.bspln5),
120                  (BV.kn_ctmr,            kernel Kernel.ctmr),                  (BV.kn_ctmr,            kernel Kernel.ctmr),
121                  (BV.kn_tent,            kernel Kernel.tent),                  (BV.kn_tent,            kernel Kernel.tent),
122                  (BV.i2r,                fn [IV i] => RV(real i))(*,                  (BV.i2r,                fn [IV i] => RV(real(IntInf.toInt i)))(*,
123                  (BV.input,              fn (y, [TK], xs) => ??), (*FIXME*)                  (BV.input,              fn (y, [TK], xs) => ??), (*FIXME*)
124                  (BV.optInput,           fn (y, [TK], xs) => ??) (*FIXME*)                  (BV.optInput,           fn (y, [TK], xs) => ??) (*FIXME*)
125  *)  *)
# Line 103  Line 127 
127              tbl              tbl
128            end            end
129    
130        fun loadImage (mvs, [SV filename]) = let
131              val info = ImageInfo.getInfo filename
132              in
133    (* FIXME: check image info details against mvs *)
134                Img info
135              end
136    
137      fun evalVar env x = (case VMap.find (env, x)      fun evalVar env x = (case VMap.find (env, x)
138             of SOME v => v             of SOME v => v
139              | NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)              | NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)
# Line 118  Line 149 
149              | S.E_Apply(f, mvs, xs, _) => (              | S.E_Apply(f, mvs, xs, _) => (
150                  (* try *)(                  (* try *)(
151                  if Var.same(f, BV.fn_load)                  if Var.same(f, BV.fn_load)
152                    then loadImage(mvs, xs)                    then loadImage(mvs, List.map (evalVar env) xs)
153                    else (case VTbl.find tbl f                    else (case VTbl.find tbl f
154                       of SOME evalFn => evalFn (List.map (fn e => evalExp(env, e)) xs)                       of SOME evalFn => evalFn (List.map (evalVar env) xs)
155                        | NONE => raise Fail("Eval.exvalExp: unknown function " ^ Var.nameOf f)                        | NONE => raise Fail("Eval.exvalExp: unknown function " ^ Var.nameOf f)
156                      (* end case *))                      (* end case *))
157                  ) handle ex => raise Fail (concat [                  ) handle ex => raise Fail (concat [
158                      Var.uniqueNameOf f, "(", String.concatWith "," (List.map toString xs),                      Var.uniqueNameOf f, "(",
159                        String.concatWith "," (List.map Var.uniqueNameOf xs),
160                      ") fails with exception ", exnName ex                      ") fails with exception ", exnName ex
161                    ]))                    ]))
162              | S.E_Cons xs =>              | S.E_Cons xs => raise Fail "TODO: E_Cons"
163              | S.E_Input(ty, name, optDefault) => let              | S.E_Input(ty, name, optDefault) => let
164                  val optDefault = Option.map (evalVar env) optDefault                  val optDefault = Option.map (evalVar env) optDefault
165                  in                  val SOME value = (case ty
                   case ty  
166                     of Ty.T_Bool =>                     of Ty.T_Bool =>
167                          Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)                          Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)
168                      | Ty.T_Int =>                      | Ty.T_Int =>
169                          Inputs.getInput(name, (Option.map IV) o IntInf.fromString, optDefault)                          Inputs.getInput(name, (Option.map IV) o IntInf.fromString, optDefault)
170                      | Ty.T_String => Inputs.getInput(name, fn s => SV(SOME s), optDefault)                          | Ty.T_String => Inputs.getInput(name, fn s => SOME(SV s), optDefault)
171                      | Ty.T_Tensor(Ty.Shape[]) =>                      | Ty.T_Tensor(Ty.Shape[]) =>
172                          Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault)                          Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault)
173                      | Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs"                      | Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs"
174                      | _ => raise Fail(concat[                      | _ => raise Fail(concat[
175                            "input ", name, " has invalid type ", TypeUtil.toString ty                            "input ", name, " has invalid type ", TypeUtil.toString ty
176                          ])                          ])
177                    (* end case *)                        (* end case *))
178                    in
179                      value
180                  end                  end
181              | S.E_Field fld => FV fld              | S.E_Field fld => FV fld
182              | S.E_LoadImage info => IV info              | S.E_LoadImage info => Img info
183              (* end case *))
184    
185        fun evalBlock (env, S.Block stms) = let
186              fun evalStm (stm, env) = (case stm
187                     of S.S_Assign(x, e) => VMap.insert(env, x, evalExp(env, e))
188                      | S.S_IfThenElse(x, b1, b2) => (case evalVar env x
189                           of BV true => evalBlock(env, b1)
190                            | BV false => evalBlock(env, b2)
191                            | _ => raise Fail "type error"
192                          (* end case *))
193                      | S.S_New _ => raise Fail "unexpected new actor"
194                      | S.S_Die => raise Fail "unexpected die"
195                      | S.S_Stabilize => raise Fail "unexpected stabilize"
196            (* end case *))            (* end case *))
197              in
198                List.foldl evalStm env stms
199              end
200    
201        fun evalStatics (S.Program{staticInit, ...}) =
202              evalBlock (VMap.empty, staticInit)
203    
204    end    end

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

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