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 232 - (view) (download)
Original Path: trunk/src/compiler/simplify/eval.sml

1 : jhr 231 (* eval.sml
2 :     *
3 :     * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * Evaluation of "static" expressions.
7 :     *)
8 :    
9 :     datatype Eval =
10 :     struct
11 :    
12 :     structure S = Simple
13 :     structure VMap = Var.Map
14 :     structure VTbl = Var.Tbl
15 :    
16 :     datatype value
17 :     = BV of bool
18 :     | IV of IntInf.int
19 :     | TV of (int list * real list) (* tensors *)
20 :     | FV of FieldDef.field_def
21 :     | IV of ImageInfo.info
22 :     | KV of Kernel.kernel
23 :    
24 :     fun RV r = TV([], [r])
25 :    
26 :     fun toString (BV b) =
27 :     | toString (IV i) =
28 :     | toString (TV(s, v)) =
29 :     | toString (FV fld) =
30 :     | toString (IV info) =
31 :     | toString (KV h) =
32 :    
33 :     val tbl : (value list -> value) VTbl.hash_table = let
34 :     val tbl = VTbl.mkTable (128, Fail "Eval table")
35 :     fun intBinOp rator [IV a, IV b] = IV(rator(a, b))
36 :     fun tensorBinOp rator [TV(s1, v1), TV(s2, v2)] =
37 :     TV(s1, ListPair.mapEq rator (v1, v2))
38 :     fun intCmp rator [IV a, IV b] = BV(rator(a, b))
39 :     fun realCmp rator [TV([], [a]), TV([], [b])] = BV(rator(a, b))
40 :     fun kernel h [] = KV h
41 :     in
42 :     List.app (VTbl.insert tbl) [
43 :     (BV.add_ii, intBinOp (op +)),
44 :     (BV.add_tt, tensorBinOp (op +)),
45 :     (BV.sub_ii, intBinOp (op -)),
46 :     (BV.sub_tt, tensorBinOp (op -)),
47 :     (BV.mul_ii, intBinOp (op *)),
48 :     (BV.mul_rr, simpleOp(Op.Mul(Op.TensorTy[]))),
49 :     (BV.mul_rt, tensorOp Op.Scale),
50 :     (BV.mul_tr, fn (y, sv, [t, r]) => tensorOp Op.Scale (y, sv, [r, t])),
51 :     (BV.div_ii, intBinOp IntInf.quot),
52 :     (BV.div_rr, simpleOp(Op.Div(Op.TensorTy[]))),
53 :     (BV.div_tr, tensorOp Op.InvScale),
54 :     (BV.lt_ii, intCmp (op <)),
55 :     (BV.lt_rr, realCmp (op <)),
56 :     (BV.lte_ii, intCmp (op <=)),
57 :     (BV.lte_rr, realCmp (op <=)),
58 :     (BV.gte_ii, intCmp (op >=)),
59 :     (BV.gte_rr, realCmp (op >=)),
60 :     (BV.gt_ii, intCmp (op >)),
61 :     (BV.gt_rr, realCmp (op >)),
62 :     (BV.equ_bb, simpleOp(Op.EQ Op.BoolTy)),
63 :     (BV.equ_ii, intCmp (op =)),
64 :     (BV.equ_ss, simpleOp(Op.EQ Op.StringTy)),
65 :     (BV.equ_rr, realCmp Real.==),
66 :     (BV.neq_bb, simpleOp(Op.NEQ Op.BoolTy)),
67 :     (BV.neq_ii, intCmp (op <>)),
68 :     (BV.neq_ss, simpleOp(Op.NEQ Op.StringTy)),
69 :     (BV.neq_rr, realCmp Real.!=),
70 :     (BV.neg_i, simpleOp(Op.Neg Op.IntTy)),
71 :     (BV.neg_t, tensorOp Op.Neg),
72 :     (BV.neg_f, fn (y, _, xs) => assign(y, Op.NegField, xs)),
73 :     (BV.op_at, fn (y, _, xs) => assign(y, Op.Probe, xs)),
74 :     (BV.op_D, fn (y, _, xs) => assign(y, Op.DiffField, xs)),
75 :     (BV.op_norm, tensorOp Op.Norm),
76 :     (BV.op_not, simpleOp Op.Not),
77 :     (*
78 :     (BV.op_subscript, fn (y, [SK, NK], xs) => ??), (*FIXME*)
79 :     *)
80 :     (BV.fn_CL, fn (y, _, xs) => assign(y, Op.CL, xs)),
81 :     (BV.fn_convolve, fn (y, _, xs) => assign(y, Op.Convolve, xs)),
82 :     (BV.fn_cos, simpleOp Op.Cos),
83 :     (BV.fn_dot, vectorOp Op.Dot),
84 :     (BV.fn_inside, fn (y, _, xs) => assign(y, Op.Inside, xs)),
85 :     (*
86 :     (BV.fn_load, fn (y, [NK, SK], xs) => ??), (*FIXME*)
87 :     *)
88 :     (BV.fn_max, simpleOp Op.Min),
89 :     (BV.fn_min, simpleOp Op.Max),
90 :     (BV.fn_modulate, tensorBinOp (op *)),
91 :     (BV.fn_pow, simpleOp Op.Pow),
92 :     (BV.fn_principleEvec, vectorOp Op.PrincipleEvec),
93 :     (BV.fn_sin, simpleOp Op.Sin),
94 :     (BV.kn_bspln3, kernel Kernel.bspln3),
95 :     (BV.kn_bspln5, kernel Kernel.bspln5),
96 :     (BV.kn_ctmr, kernel Kernel.ctmr),
97 :     (BV.kn_tent, kernel Kernel.tent),
98 :     (BV.i2r, fn [IV i] => RV(real i))(*,
99 :     (BV.input, fn (y, [TK], xs) => ??), (*FIXME*)
100 :     (BV.optInput, fn (y, [TK], xs) => ??) (*FIXME*)
101 :     *)
102 :     ];
103 :     tbl
104 :     end
105 :    
106 :     fun evalVar env x = (case VMap.find (env, x)
107 :     of SOME v => v
108 :     | NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)
109 :     (* end case *))
110 :    
111 :     fun evalExp (env, e) = (case e
112 :     of S.E_Var x => evalVar env x
113 :     | S.E_Lit(Literal.Int i) => IV i
114 :     | S.E_Lit(Literal.Float f) => RV(FloatLit.toReal f)
115 :     | S.E_Lit(Literal.String s) => SV s
116 :     | S.E_Lit(Literal.Bool b) => BV b
117 :     | S.E_Tuple _ => raise Fail "E_Tuple"
118 :     | S.E_Apply(f, mvs, xs, _) => (
119 :     (* try *)(
120 :     if Var.same(f, BV.fn_load)
121 :     then loadImage(mvs, xs)
122 :     else (case VTbl.find tbl f
123 :     of SOME evalFn => evalFn (List.map (fn e => evalExp(env, e)) xs)
124 :     | NONE => raise Fail("Eval.exvalExp: unknown function " ^ Var.nameOf f)
125 :     (* end case *))
126 :     ) handle ex => raise Fail (concat [
127 :     Var.uniqueNameOf f, "(", String.concatWith "," (List.map toString xs),
128 :     ") fails with exception ", exnName ex
129 :     ]))
130 : jhr 232 | S.E_Cons xs => raise Fail "TODO: E_Cons"
131 : jhr 231 | S.E_Input(ty, name, optDefault) => let
132 :     val optDefault = Option.map (evalVar env) optDefault
133 :     in
134 :     case ty
135 :     of Ty.T_Bool =>
136 :     Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)
137 :     | Ty.T_Int =>
138 :     Inputs.getInput(name, (Option.map IV) o IntInf.fromString, optDefault)
139 :     | Ty.T_String => Inputs.getInput(name, fn s => SV(SOME s), optDefault)
140 :     | Ty.T_Tensor(Ty.Shape[]) =>
141 :     Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault)
142 :     | Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs"
143 :     | _ => raise Fail(concat[
144 :     "input ", name, " has invalid type ", TypeUtil.toString ty
145 :     ])
146 :     (* end case *)
147 :     end
148 :     | S.E_Field fld => FV fld
149 :     | S.E_LoadImage info => IV info
150 :     (* end case *))
151 :    
152 :     end

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