Home My Page Projects Code Snippets Project Openings diderot

# SCM Repository

[diderot] View of /trunk/src/compiler/simplify/eval.sml
 [diderot] / trunk / src / compiler / simplify / eval.sml

# View of /trunk/src/compiler/simplify/eval.sml

Thu Aug 5 16:18:44 2010 UTC (10 years, 10 months ago) by jhr
File size: 5111 byte(s)
```  Working on static evaluation
```
```(* eval.sml
*
* COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
*
* Evaluation of "static" expressions.
*)

datatype Eval =
struct

structure S = Simple
structure VMap = Var.Map
structure VTbl = Var.Tbl

datatype value
= BV of bool
| IV of IntInf.int
| TV of (int list * real list)	(* tensors *)
| FV of FieldDef.field_def
| IV of ImageInfo.info
| KV of Kernel.kernel

fun RV r = TV([], [r])

fun toString (BV b) =
| toString (IV i) =
| toString (TV(s, v)) =
| toString (FV fld) =
| toString (IV info) =
| toString (KV h) =

val tbl : (value list -> value) VTbl.hash_table = let
val tbl = VTbl.mkTable (128, Fail "Eval table")
fun intBinOp rator [IV a, IV b] = IV(rator(a, b))
fun tensorBinOp rator [TV(s1, v1), TV(s2, v2)] =
TV(s1, ListPair.mapEq rator (v1, v2))
fun intCmp rator [IV a, IV b] = BV(rator(a, b))
fun realCmp rator [TV([], [a]), TV([], [b])] = BV(rator(a, b))
fun kernel h [] = KV h
in
List.app (VTbl.insert tbl) [
(BV.sub_ii,		intBinOp (op -)),
(BV.sub_tt,		tensorBinOp (op -)),
(BV.mul_ii,		intBinOp (op *)),
(BV.mul_rr,		simpleOp(Op.Mul(Op.TensorTy[]))),
(BV.mul_rt,		tensorOp Op.Scale),
(BV.mul_tr,		fn (y, sv, [t, r]) => tensorOp Op.Scale (y, sv, [r, t])),
(BV.div_ii,		intBinOp IntInf.quot),
(BV.div_rr,		simpleOp(Op.Div(Op.TensorTy[]))),
(BV.div_tr,		tensorOp Op.InvScale),
(BV.lt_ii,		intCmp (op <)),
(BV.lt_rr,		realCmp (op <)),
(BV.lte_ii,		intCmp (op <=)),
(BV.lte_rr,		realCmp (op <=)),
(BV.gte_ii,		intCmp (op >=)),
(BV.gte_rr,		realCmp (op >=)),
(BV.gt_ii,		intCmp (op >)),
(BV.gt_rr,		realCmp (op >)),
(BV.equ_bb,		simpleOp(Op.EQ Op.BoolTy)),
(BV.equ_ii,		intCmp (op =)),
(BV.equ_ss,		simpleOp(Op.EQ Op.StringTy)),
(BV.equ_rr,		realCmp Real.==),
(BV.neq_bb,		simpleOp(Op.NEQ Op.BoolTy)),
(BV.neq_ii,		intCmp (op <>)),
(BV.neq_ss,		simpleOp(Op.NEQ Op.StringTy)),
(BV.neq_rr,		realCmp Real.!=),
(BV.neg_i,		simpleOp(Op.Neg Op.IntTy)),
(BV.neg_t,		tensorOp Op.Neg),
(BV.neg_f,		fn (y, _, xs) => assign(y, Op.NegField, xs)),
(BV.op_at,		fn (y, _, xs) => assign(y, Op.Probe, xs)),
(BV.op_D,		fn (y, _, xs) => assign(y, Op.DiffField, xs)),
(BV.op_norm,		tensorOp Op.Norm),
(BV.op_not,		simpleOp Op.Not),
(*
(BV.op_subscript,	fn (y, [SK, NK], xs) => ??), (*FIXME*)
*)
(BV.fn_CL,		fn (y, _, xs) => assign(y, Op.CL, xs)),
(BV.fn_convolve,	fn (y, _, xs) => assign(y, Op.Convolve, xs)),
(BV.fn_cos,		simpleOp Op.Cos),
(BV.fn_dot,		vectorOp Op.Dot),
(BV.fn_inside,		fn (y, _, xs) => assign(y, Op.Inside, xs)),
(*
(BV.fn_load,		fn (y, [NK, SK], xs) => ??), (*FIXME*)
*)
(BV.fn_max,		simpleOp Op.Min),
(BV.fn_min,		simpleOp Op.Max),
(BV.fn_modulate,	tensorBinOp (op *)),
(BV.fn_pow,		simpleOp Op.Pow),
(BV.fn_principleEvec,	vectorOp Op.PrincipleEvec),
(BV.fn_sin,		simpleOp Op.Sin),
(BV.kn_bspln3,		kernel Kernel.bspln3),
(BV.kn_bspln5,		kernel Kernel.bspln5),
(BV.kn_ctmr,		kernel Kernel.ctmr),
(BV.kn_tent,		kernel Kernel.tent),
(BV.i2r,		fn [IV i] => RV(real i))(*,
(BV.input,		fn (y, [TK], xs) => ??), (*FIXME*)
(BV.optInput,		fn (y, [TK], xs) => ??) (*FIXME*)
*)
];
tbl
end

fun evalVar env x = (case VMap.find (env, x)
of SOME v => v
| NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x)
(* end case *))

fun evalExp (env, e) = (case e
of S.E_Var x => evalVar env x
| S.E_Lit(Literal.Int i) => IV i
| 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 *)(
else (case VTbl.find tbl f
of SOME evalFn => evalFn (List.map (fn e => evalExp(env, e)) xs)
| NONE => raise Fail("Eval.exvalExp: unknown function " ^ Var.nameOf f)
(* end case *))
) handle ex => raise Fail (concat [
Var.uniqueNameOf f, "(", String.concatWith "," (List.map toString xs),
") fails with exception ", exnName ex
]))
| S.E_Cons xs => raise Fail "TODO: E_Cons"
| S.E_Input(ty, name, optDefault) => let
val optDefault = Option.map (evalVar env) optDefault
in
case ty
of Ty.T_Bool =>
Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault)
| Ty.T_Int =>
Inputs.getInput(name, (Option.map IV) o IntInf.fromString, optDefault)
| Ty.T_String => Inputs.getInput(name, fn s => SV(SOME s), optDefault)
| Ty.T_Tensor(Ty.Shape[]) =>
Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault)
| Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs"
| _ => raise Fail(concat[
"input ", name, " has invalid type ", TypeUtil.toString ty
])
(* end case *)
end
| S.E_Field fld => FV fld
| S.E_LoadImage info => IV info
(* end case *))

end
```