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