6 |
* Evaluation of "static" expressions. |
* Evaluation of "static" expressions. |
7 |
*) |
*) |
8 |
|
|
9 |
datatype Eval = |
structure Eval = |
10 |
struct |
struct |
11 |
|
|
12 |
|
structure Ty = Types |
13 |
|
structure BV = BasisVars |
14 |
structure S = Simple |
structure S = Simple |
15 |
structure VMap = Var.Map |
structure VMap = Var.Map |
16 |
structure VTbl = Var.Tbl |
structure VTbl = Var.Tbl |
17 |
|
|
18 |
datatype value |
datatype value |
19 |
= BV of bool |
= BV of bool |
20 |
|
| SV of string |
21 |
| IV of IntInf.int |
| IV of IntInf.int |
22 |
| TV of (int list * real list) (* tensors *) |
| TV of (int list * real list) (* tensors *) |
23 |
| FV of FieldDef.field_def |
| FV of FieldDef.field_def |
24 |
| IV of ImageInfo.info |
| Img of ImageInfo.info |
25 |
| KV of Kernel.kernel |
| KV of Kernel.kernel |
26 |
|
|
27 |
fun RV r = TV([], [r]) |
fun RV r = TV([], [r]) |
28 |
|
|
29 |
fun toString (BV b) = |
fun toString (BV b) = Bool.toString b |
30 |
| toString (IV i) = |
| toString (IV i) = IntInf.toString i |
31 |
| toString (TV(s, v)) = |
| toString (SV s) = concat["\"", String.toString s, "\""] |
32 |
| toString (FV fld) = |
| toString (TV(s, v)) = "tensor" |
33 |
| toString (IV info) = |
| toString (FV fld) = FieldDef.toString fld |
34 |
| toString (KV h) = |
| toString (Img info) = ImageInfo.toString info |
35 |
|
| toString (KV h) = Kernel.toString h |
36 |
|
|
37 |
val tbl : (value list -> value) VTbl.hash_table = let |
val tbl : (value list -> value) VTbl.hash_table = let |
38 |
val tbl = VTbl.mkTable (128, Fail "Eval table") |
val tbl = VTbl.mkTable (128, Fail "Eval table") |
39 |
fun intBinOp rator [IV a, IV b] = IV(rator(a, b)) |
fun intBinOp rator [IV a, IV b] = IV(rator(a, b)) |
40 |
fun tensorBinOp rator [TV(s1, v1), TV(s2, v2)] = |
fun tensorBinOp rator [TV(s1, v1), TV(s2, v2)] = |
41 |
TV(s1, ListPair.mapEq rator (v1, v2)) |
TV(s1, ListPair.mapEq rator (v1, v2)) |
42 |
|
fun realBinOp rator [TV([], [a]), TV([], [b])] = RV(rator(a, b)) |
43 |
fun intCmp rator [IV a, IV b] = BV(rator(a, b)) |
fun intCmp rator [IV a, IV b] = BV(rator(a, b)) |
44 |
fun realCmp rator [TV([], [a]), TV([], [b])] = BV(rator(a, b)) |
fun realCmp rator [TV([], [a]), TV([], [b])] = BV(rator(a, b)) |
45 |
|
fun boolCmp rator [BV a, BV b] = BV(rator(a, b)) |
46 |
|
fun stringCmp rator [SV a, SV b] = BV(rator(a, b)) |
47 |
fun kernel h [] = KV h |
fun kernel h [] = KV h |
48 |
in |
in |
49 |
List.app (VTbl.insert tbl) [ |
List.app (VTbl.insert tbl) [ |
52 |
(BV.sub_ii, intBinOp (op -)), |
(BV.sub_ii, intBinOp (op -)), |
53 |
(BV.sub_tt, tensorBinOp (op -)), |
(BV.sub_tt, tensorBinOp (op -)), |
54 |
(BV.mul_ii, intBinOp (op *)), |
(BV.mul_ii, intBinOp (op *)), |
55 |
(BV.mul_rr, simpleOp(Op.Mul(Op.TensorTy[]))), |
(BV.mul_rr, realBinOp (op * )), |
56 |
|
(* |
57 |
(BV.mul_rt, tensorOp Op.Scale), |
(BV.mul_rt, tensorOp Op.Scale), |
58 |
(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])), |
59 |
|
*) |
60 |
(BV.div_ii, intBinOp IntInf.quot), |
(BV.div_ii, intBinOp IntInf.quot), |
61 |
(BV.div_rr, simpleOp(Op.Div(Op.TensorTy[]))), |
(BV.div_rr, realBinOp (op /)), |
62 |
|
(* |
63 |
(BV.div_tr, tensorOp Op.InvScale), |
(BV.div_tr, tensorOp Op.InvScale), |
64 |
|
*) |
65 |
(BV.lt_ii, intCmp (op <)), |
(BV.lt_ii, intCmp (op <)), |
66 |
(BV.lt_rr, realCmp (op <)), |
(BV.lt_rr, realCmp (op <)), |
67 |
(BV.lte_ii, intCmp (op <=)), |
(BV.lte_ii, intCmp (op <=)), |
70 |
(BV.gte_rr, realCmp (op >=)), |
(BV.gte_rr, realCmp (op >=)), |
71 |
(BV.gt_ii, intCmp (op >)), |
(BV.gt_ii, intCmp (op >)), |
72 |
(BV.gt_rr, realCmp (op >)), |
(BV.gt_rr, realCmp (op >)), |
73 |
(BV.equ_bb, simpleOp(Op.EQ Op.BoolTy)), |
(BV.equ_bb, boolCmp (op =)), |
74 |
(BV.equ_ii, intCmp (op =)), |
(BV.equ_ii, intCmp (op =)), |
75 |
(BV.equ_ss, simpleOp(Op.EQ Op.StringTy)), |
(BV.equ_ss, stringCmp (op =)), |
76 |
(BV.equ_rr, realCmp Real.==), |
(BV.equ_rr, realCmp Real.==), |
77 |
(BV.neq_bb, simpleOp(Op.NEQ Op.BoolTy)), |
(BV.neq_bb, boolCmp (op <>)), |
78 |
(BV.neq_ii, intCmp (op <>)), |
(BV.neq_ii, intCmp (op <>)), |
79 |
(BV.neq_ss, simpleOp(Op.NEQ Op.StringTy)), |
(BV.neq_ss, stringCmp (op <>)), |
80 |
(BV.neq_rr, realCmp Real.!=), |
(BV.neq_rr, realCmp Real.!=), |
81 |
|
(* |
82 |
(BV.neg_i, simpleOp(Op.Neg Op.IntTy)), |
(BV.neg_i, simpleOp(Op.Neg Op.IntTy)), |
83 |
(BV.neg_t, tensorOp Op.Neg), |
(BV.neg_t, tensorOp Op.Neg), |
84 |
(BV.neg_f, fn (y, _, xs) => assign(y, Op.NegField, xs)), |
(BV.neg_f, fn (y, _, xs) => assign(y, Op.NegField, xs)), |
94 |
(BV.fn_cos, simpleOp Op.Cos), |
(BV.fn_cos, simpleOp Op.Cos), |
95 |
(BV.fn_dot, vectorOp Op.Dot), |
(BV.fn_dot, vectorOp Op.Dot), |
96 |
(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*) |
|
97 |
*) |
*) |
98 |
(BV.fn_max, simpleOp Op.Min), |
(BV.fn_max, realBinOp Real.min), |
99 |
(BV.fn_min, simpleOp Op.Max), |
(BV.fn_min, realBinOp Real.max), |
100 |
(BV.fn_modulate, tensorBinOp (op *)), |
(BV.fn_modulate, tensorBinOp (op *)), |
101 |
(BV.fn_pow, simpleOp Op.Pow), |
(BV.fn_pow, realBinOp Real.Math.pow), |
102 |
|
(* |
103 |
(BV.fn_principleEvec, vectorOp Op.PrincipleEvec), |
(BV.fn_principleEvec, vectorOp Op.PrincipleEvec), |
104 |
(BV.fn_sin, simpleOp Op.Sin), |
(BV.fn_sin, simpleOp Op.Sin), |
105 |
|
*) |
106 |
(BV.kn_bspln3, kernel Kernel.bspln3), |
(BV.kn_bspln3, kernel Kernel.bspln3), |
107 |
(BV.kn_bspln5, kernel Kernel.bspln5), |
(BV.kn_bspln5, kernel Kernel.bspln5), |
108 |
(BV.kn_ctmr, kernel Kernel.ctmr), |
(BV.kn_ctmr, kernel Kernel.ctmr), |
109 |
(BV.kn_tent, kernel Kernel.tent), |
(BV.kn_tent, kernel Kernel.tent), |
110 |
(BV.i2r, fn [IV i] => RV(real i))(*, |
(BV.i2r, fn [IV i] => RV(real(IntInf.toInt i)))(*, |
111 |
(BV.input, fn (y, [TK], xs) => ??), (*FIXME*) |
(BV.input, fn (y, [TK], xs) => ??), (*FIXME*) |
112 |
(BV.optInput, fn (y, [TK], xs) => ??) (*FIXME*) |
(BV.optInput, fn (y, [TK], xs) => ??) (*FIXME*) |
113 |
*) |
*) |
115 |
tbl |
tbl |
116 |
end |
end |
117 |
|
|
118 |
|
fun loadImage (mvs, [SV filename]) = let |
119 |
|
val info = ImageInfo.getInfo filename |
120 |
|
in |
121 |
|
(* FIXME: check image info details against mvs *) |
122 |
|
Img info |
123 |
|
end |
124 |
|
|
125 |
fun evalVar env x = (case VMap.find (env, x) |
fun evalVar env x = (case VMap.find (env, x) |
126 |
of SOME v => v |
of SOME v => v |
127 |
| NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x) |
| NONE => raise Fail("undefined variable " ^ Var.uniqueNameOf x) |
137 |
| S.E_Apply(f, mvs, xs, _) => ( |
| S.E_Apply(f, mvs, xs, _) => ( |
138 |
(* try *)( |
(* try *)( |
139 |
if Var.same(f, BV.fn_load) |
if Var.same(f, BV.fn_load) |
140 |
then loadImage(mvs, xs) |
then loadImage(mvs, List.map (evalVar env) xs) |
141 |
else (case VTbl.find tbl f |
else (case VTbl.find tbl f |
142 |
of SOME evalFn => evalFn (List.map (fn e => evalExp(env, e)) xs) |
of SOME evalFn => evalFn (List.map (evalVar env) xs) |
143 |
| NONE => raise Fail("Eval.exvalExp: unknown function " ^ Var.nameOf f) |
| NONE => raise Fail("Eval.exvalExp: unknown function " ^ Var.nameOf f) |
144 |
(* end case *)) |
(* end case *)) |
145 |
) handle ex => raise Fail (concat [ |
) handle ex => raise Fail (concat [ |
146 |
Var.uniqueNameOf f, "(", String.concatWith "," (List.map toString xs), |
Var.uniqueNameOf f, "(", |
147 |
|
String.concatWith "," (List.map Var.uniqueNameOf xs), |
148 |
") fails with exception ", exnName ex |
") fails with exception ", exnName ex |
149 |
])) |
])) |
150 |
| S.E_Cons xs => raise Fail "TODO: E_Cons" |
| S.E_Cons xs => raise Fail "TODO: E_Cons" |
151 |
| S.E_Input(ty, name, optDefault) => let |
| S.E_Input(ty, name, optDefault) => let |
152 |
val optDefault = Option.map (evalVar env) optDefault |
val optDefault = Option.map (evalVar env) optDefault |
153 |
in |
val SOME value = (case ty |
|
case ty |
|
154 |
of Ty.T_Bool => |
of Ty.T_Bool => |
155 |
Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault) |
Inputs.getInput(name, (Option.map BV) o Bool.fromString, optDefault) |
156 |
| Ty.T_Int => |
| Ty.T_Int => |
157 |
Inputs.getInput(name, (Option.map IV) o IntInf.fromString, optDefault) |
Inputs.getInput(name, (Option.map IV) o IntInf.fromString, optDefault) |
158 |
| Ty.T_String => Inputs.getInput(name, fn s => SV(SOME s), optDefault) |
| Ty.T_String => Inputs.getInput(name, fn s => SOME(SV s), optDefault) |
159 |
| Ty.T_Tensor(Ty.Shape[]) => |
| Ty.T_Tensor(Ty.Shape[]) => |
160 |
Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault) |
Inputs.getInput(name, (Option.map RV) o Real.fromString, optDefault) |
161 |
| Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs" |
| Ty.T_Tensor shp => raise Fail "TODO: general tensor inputs" |
162 |
| _ => raise Fail(concat[ |
| _ => raise Fail(concat[ |
163 |
"input ", name, " has invalid type ", TypeUtil.toString ty |
"input ", name, " has invalid type ", TypeUtil.toString ty |
164 |
]) |
]) |
165 |
(* end case *) |
(* end case *)) |
166 |
|
in |
167 |
|
value |
168 |
end |
end |
169 |
| S.E_Field fld => FV fld |
| S.E_Field fld => FV fld |
170 |
| S.E_LoadImage info => IV info |
| S.E_LoadImage info => Img info |
171 |
(* end case *)) |
(* end case *)) |
172 |
|
|
173 |
end |
end |