17 |
|
|
18 |
end = struct |
end = struct |
19 |
|
|
20 |
|
structure BV = BasisVars |
21 |
structure IL = HighIL |
structure IL = HighIL |
22 |
|
structure DstTy = HighILTypes |
23 |
structure Op = HighOps |
structure Op = HighOps |
24 |
structure Ty = Types |
structure Ty = Types |
25 |
structure TU = TypeUtil |
structure TU = TypeUtil |
26 |
structure MV = MetaVar |
structure MV = MetaVar |
27 |
|
structure VTbl = Var.Tbl |
28 |
|
|
29 |
fun assign (y, rator, xs) = [(y, IL.OP(rator, xs))] |
fun assign (y, rator, xs) = [(y, IL.OP(rator, xs))] |
30 |
|
|
31 |
fun simpleOP rator (y, [], xs) = assign (y, rator, xs) |
fun simpleOp rator (y, [], xs) = assign (y, rator, xs) |
32 |
|
|
33 |
fun tensorOP rator (y, [sv], xs) = (case TU.prunShape(MV.toShape sv) |
fun pruneDim d = (case TU.pruneDim d |
34 |
of Ty.Shape dd => assign (y, IP.OP(rator(Op.TensorTy dd), xs)) |
of (Ty.DimConst n) => n |
35 |
|
| d => raise Fail("unresolved dimension " ^ TU.dimToString d) |
36 |
|
(* end case *)) |
37 |
|
|
38 |
|
fun tensorOp rator (y, [sv], xs) = (case TU.pruneShape(MV.toShape sv) |
39 |
|
of Ty.Shape dd => |
40 |
|
assign (y, rator(DstTy.TensorTy(List.map pruneDim dd)), xs) |
41 |
| shp => raise Fail("unresolved shape " ^ TU.shapeToString shp) |
| shp => raise Fail("unresolved shape " ^ TU.shapeToString shp) |
42 |
(* end case *)) |
(* end case *)) |
43 |
|
|
44 |
|
fun vectorOp rator (y, [dv], xs) = |
45 |
|
assign (y, rator(DstTy.TensorTy[pruneDim(MV.toDim dv)]), xs) |
46 |
|
|
47 |
|
fun kernel h (y, [], []) = assign(y, Op.Kernel h, []) |
48 |
|
|
49 |
(* build a table that maps Basis variables to their translation functions *) |
(* build a table that maps Basis variables to their translation functions *) |
50 |
val tbl = let |
val tbl : ((IL.var * Ty.meta_var list * IL.var list) -> IL.assign list) VTbl.hash_table = let |
51 |
val tbl = Var.Tbl.mkTable (128, Fail "Translate table") |
val tbl = VTbl.mkTable (128, Fail "Translate table") |
52 |
in |
in |
53 |
List.app (Var.Tbl.insert tbl) [ |
List.app (VTbl.insert tbl) [ |
54 |
(add_ii, simpleOp(OP.Add OP.IntTy)), |
(BV.add_ii, simpleOp(Op.Add DstTy.IntTy)), |
55 |
(add_tt, tensorOp OP.Add), |
(BV.add_tt, tensorOp Op.Add), |
56 |
(sub_ii, simpleOp(OP.Sub OP.IntTy)), |
(BV.sub_ii, simpleOp(Op.Sub DstTy.IntTy)), |
57 |
(sub_tt, tensorOp OP.Sub), |
(BV.sub_tt, tensorOp Op.Sub), |
58 |
(mul_ii, simpleOp(OP.Mul OP.IntTy)), |
(BV.mul_ii, simpleOp(Op.Mul DstTy.IntTy)), |
59 |
(mul_rr, simpleOp(OP.Mul(OP.TensorTy[]))), |
(BV.mul_rr, simpleOp(Op.Mul(DstTy.TensorTy[]))), |
60 |
(mul_rt, tensorOp OP.Scale), |
(BV.mul_rt, tensorOp Op.Scale), |
61 |
(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])), |
62 |
(div_ii, simpleOp(OP.Div OP.IntTy)), |
(BV.div_ii, simpleOp(Op.Div DstTy.IntTy)), |
63 |
(div_rr, simpleOp(OP.Div(OP.TensorTy[]))), |
(BV.div_rr, simpleOp(Op.Div(DstTy.TensorTy[]))), |
64 |
(div_tr, tensorOp OP.InvScale), |
(BV.div_tr, tensorOp Op.InvScale), |
65 |
(lt_ii, simpleOp(OP.LT OP.IntTy)), |
(BV.lt_ii, simpleOp(Op.LT DstTy.IntTy)), |
66 |
(lt_rr, simpleOp(OP.LT(OP.TensorTy[]))), |
(BV.lt_rr, simpleOp(Op.LT(DstTy.TensorTy[]))), |
67 |
(lte_ii, simpleOp(OP.LTE OP.IntTy)), |
(BV.lte_ii, simpleOp(Op.LTE DstTy.IntTy)), |
68 |
(lte_rr, simpleOp(OP.LTE(OP.TensorTy[]))), |
(BV.lte_rr, simpleOp(Op.LTE(DstTy.TensorTy[]))), |
69 |
(gte_ii, simpleOp(OP.GTE OP.IntTy)), |
(BV.gte_ii, simpleOp(Op.GTE DstTy.IntTy)), |
70 |
(gte_rr, simpleOp(OP.GTE(OP.TensorTy[]))), |
(BV.gte_rr, simpleOp(Op.GTE(DstTy.TensorTy[]))), |
71 |
(gt_ii, simpleOp(OP.GT OP.IntTy)), |
(BV.gt_ii, simpleOp(Op.GT DstTy.IntTy)), |
72 |
(gt_rr, simpleOp(OP.GT(OP.TensorTy[]))), |
(BV.gt_rr, simpleOp(Op.GT(DstTy.TensorTy[]))), |
73 |
(equ_bb, simpleOp(OP.EQ OP.BoolTy)), |
(BV.equ_bb, simpleOp(Op.EQ DstTy.BoolTy)), |
74 |
(equ_ii, simpleOp(OP.EQ OP.IntTy)), |
(BV.equ_ii, simpleOp(Op.EQ DstTy.IntTy)), |
75 |
(equ_ss, simpleOp(OP.EQ OP.StringTy)), |
(BV.equ_ss, simpleOp(Op.EQ DstTy.StringTy)), |
76 |
(equ_rr, simpleOp(OP.EQ(OP.TensorTy[]))), |
(BV.equ_rr, simpleOp(Op.EQ(DstTy.TensorTy[]))), |
77 |
(neq_bb, simpleOp(OP.NEQ OP.BoolTy)), |
(BV.neq_bb, simpleOp(Op.NEQ DstTy.BoolTy)), |
78 |
(neq_ii, simpleOp(OP.NEQ OP.IntTy)), |
(BV.neq_ii, simpleOp(Op.NEQ DstTy.IntTy)), |
79 |
(neq_ss, simpleOp(OP.NEQ OP.StringTy)), |
(BV.neq_ss, simpleOp(Op.NEQ DstTy.StringTy)), |
80 |
(neq_rr, simpleOp(OP.NEQ(OP.TensorTy[]))), |
(BV.neq_rr, simpleOp(Op.NEQ(DstTy.TensorTy[]))), |
81 |
(neg_i, simpleOp(OP.Neg OP.IntTy)), |
(BV.neg_i, simpleOp(Op.Neg DstTy.IntTy)), |
82 |
(neg_t, tensorOp OP.Neg), |
(BV.neg_t, tensorOp Op.Neg), |
83 |
(neg_f, fn (y, [DK, NK, SK], xs) => ??), (*FIXME*) |
(BV.neg_f, fn (y, _, xs) => assign(y, Op.NegField, xs)), |
84 |
(op_at, fn (y, [DK, NK, SK], xs) => ??), (*FIXME*) |
(BV.op_at, fn (y, _, xs) => assign(y, Op.Probe, xs)), |
85 |
(op_D, fn (y, [DK, NK, SK], xs) => ??), (*FIXME*) |
(BV.op_convolve, fn (y, _, xs) => assign(y, Op.Convolve, xs)), |
86 |
(op_norm, tensorOp OP.Norm), |
(BV.op_D, fn (y, _, xs) => assign(y, Op.DiffField, xs)), |
87 |
(op_not, simpleOp OP.Not), |
(BV.op_norm, tensorOp Op.Norm), |
88 |
(op_subscript, fn (y, [SK, NK], xs) => ??), (*FIXME*) |
(BV.op_not, simpleOp Op.Not), |
89 |
(fn_CL, fn (y, [N3, N3], xs) => ??), (*FIXME*) |
(* |
90 |
(fn_convolve, fn (y, [DK, NK, SK], xs) => ??), (*FIXME*) |
(BV.op_subscript, fn (y, [SK, NK], xs) => ??), (*FIXME*) |
91 |
(fn_cos, simpleOp OP.Cos), |
*) |
92 |
(fn_dot, fn (y, [dv], xs) => (case TU.pruneDim(MV.toDim dv) |
(BV.fn_CL, fn (y, _, xs) => assign(y, Op.CL, xs)), |
93 |
of Ty.DimConst d => assign (y, OP.Dot(OP.TensorTy[d]), xs) |
(BV.fn_convolve, fn (y, _, [h, img]) => assign(y, Op.Convolve, [img, h])), |
94 |
| dim => raise Fail("unresolved dimension "^TU.dimToString dim) |
(BV.fn_cos, simpleOp Op.Cos), |
95 |
(* end case *))), |
(BV.fn_dot, vectorOp Op.Dot), |
96 |
(fn_inside, fn (y, [DK, NK, SK], xs) => ??), (*FIXME*) |
(BV.fn_inside, fn (y, _, xs) => assign(y, Op.Inside, xs)), |
97 |
(fn_load, fn (y, [NK, SK], xs) => ??), (*FIXME*) |
(* |
98 |
(fn_max, simpleOp Op.Min), |
(BV.fn_load, fn (y, [NK, SK], xs) => ??), (*FIXME*) |
99 |
(fn_min, simpleOp OP.Max), |
*) |
100 |
(fn_modulate, fn (y, [NK], xs) => ??), (*FIXME*) |
(BV.fn_max, simpleOp Op.Max), |
101 |
(fn_pow, simpleOp OP.Pow), |
(BV.fn_min, simpleOp Op.Min), |
102 |
(fn_principleEvec, fn (y, [NK], xs) => ??), (*FIXME*) |
(BV.fn_modulate, vectorOp Op.Mul), |
103 |
(fn_sin, simpleOp OP.Sin), |
(BV.fn_pow, simpleOp Op.Pow), |
104 |
(kn_bspln3, fn (y, [], xs) => ??, (*FIXME*) |
(BV.fn_principleEvec, vectorOp Op.PrincipleEvec), |
105 |
(kn_bspln5, fn (y, [], xs) => ??, (*FIXME*) |
(BV.fn_sin, simpleOp Op.Sin), |
106 |
(kn_ctmr, fn (y, [], xs) => ??, (*FIXME*) |
(BV.kn_bspln3, kernel Kernel.bspln3), |
107 |
(kn_tent, fn (y, [], xs) => ??, (*FIXME*) |
(BV.kn_bspln5, kernel Kernel.bspln5), |
108 |
(i2r, simpleOp OP.IntToReal), |
(BV.kn_ctmr, kernel Kernel.ctmr), |
109 |
(input, fn (y, [TK], xs) => ??) (*FIXME*) |
(BV.kn_tent, kernel Kernel.tent), |
110 |
|
(BV.i2r, simpleOp Op.IntToReal)(*, |
111 |
|
(BV.input, fn (y, [TK], xs) => ??), (*FIXME*) |
112 |
|
(BV.optInput, fn (y, [TK], xs) => ??) (*FIXME*) |
113 |
|
*) |
114 |
]; |
]; |
115 |
tbl |
tbl |
116 |
end |
end |
117 |
|
|
118 |
fun translate (y, f, mvs, xs) = (case Var.Tbl.find tbl f |
fun translate (y, f, mvs, xs) = (case VTbl.find tbl f |
119 |
of SOME transFn => transFn(mvs, xs) |
of SOME transFn => transFn(y, mvs, xs) |
120 |
| NONE => raise Fail("TranslateBasis.translate: unknown function " ^ Var.toString f) |
| NONE => raise Fail("TranslateBasis.translate: unknown function " ^ Var.uniqueNameOf f) |
121 |
(* end case *)) |
(* end case *)) |
122 |
|
|
123 |
end |
end |