26 |
structure MV = MetaVar |
structure MV = MetaVar |
27 |
structure VTbl = Var.Tbl |
structure VTbl = Var.Tbl |
28 |
|
|
|
fun assign (y, rator, xs) = [(y, IL.OP(rator, xs))] |
|
|
|
|
|
fun simpleOp rator (y, [], xs) = assign (y, rator, xs) |
|
|
|
|
29 |
fun pruneDim d = (case TU.pruneDim d |
fun pruneDim d = (case TU.pruneDim d |
30 |
of (Ty.DimConst n) => n |
of (Ty.DimConst n) => n |
31 |
| d => raise Fail("unresolved dimension " ^ TU.dimToString d) |
| d => raise Fail("unresolved dimension " ^ TU.dimToString d) |
32 |
(* end case *)) |
(* end case *)) |
33 |
|
|
34 |
fun tensorOp rator (y, [sv], xs) = (case TU.pruneShape(MV.toShape sv) |
fun pruneShape sv = (case TU.pruneShape(MV.toShape sv) |
35 |
of Ty.Shape dd => |
of Ty.Shape dd => DstTy.TensorTy(List.map pruneDim dd) |
|
assign (y, rator(DstTy.TensorTy(List.map pruneDim dd)), xs) |
|
36 |
| shp => raise Fail("unresolved shape " ^ TU.shapeToString shp) |
| shp => raise Fail("unresolved shape " ^ TU.shapeToString shp) |
37 |
(* end case *)) |
(* end case *)) |
38 |
|
|
39 |
fun vectorOp rator (y, [dv], xs) = |
fun dimVarToTensor dv = DstTy.TensorTy[pruneDim(MV.toDim dv)] |
40 |
assign (y, rator(DstTy.TensorTy[pruneDim(MV.toDim dv)]), xs) |
fun shapeVarToTensor sv = pruneShape sv |
41 |
|
|
42 |
|
fun assign (y, rator, xs) = [(y, IL.OP(rator, xs))] |
43 |
|
|
44 |
|
fun simpleOp rator (y, [], xs) = assign (y, rator, xs) |
45 |
|
|
46 |
|
fun tensorOp rator (y, [sv], xs) = assign (y, rator(shapeVarToTensor sv), xs) |
47 |
|
|
48 |
|
fun vectorOp rator (y, [dv], xs) = assign (y, rator(dimVarToTensor dv), xs) |
49 |
|
|
50 |
fun kernel h (y, [], []) = assign(y, Op.Kernel h, []) |
fun kernel h (y, [], []) = assign(y, Op.Kernel h, []) |
51 |
|
|
84 |
(BV.neg_i, simpleOp(Op.Neg DstTy.IntTy)), |
(BV.neg_i, simpleOp(Op.Neg DstTy.IntTy)), |
85 |
(BV.neg_t, tensorOp Op.Neg), |
(BV.neg_t, tensorOp Op.Neg), |
86 |
(BV.neg_f, fn (y, _, xs) => assign(y, Op.NegField, xs)), |
(BV.neg_f, fn (y, _, xs) => assign(y, Op.NegField, xs)), |
87 |
(BV.op_at, fn (y, _, xs) => assign(y, Op.Probe, xs)), |
(BV.op_at, fn (y, [_, dv, sv], xs) => |
88 |
|
assign(y, Op.Probe(shapeVarToTensor sv, dimVarToTensor dv), xs)), |
89 |
(BV.op_convolve, fn (y, _, xs) => assign(y, Op.Convolve, xs)), |
(BV.op_convolve, fn (y, _, xs) => assign(y, Op.Convolve, xs)), |
90 |
(BV.op_D, fn (y, _, xs) => assign(y, Op.DiffField, xs)), |
(BV.op_D, fn (y, _, xs) => assign(y, Op.DiffField, xs)), |
91 |
(BV.op_norm, tensorOp Op.Norm), |
(BV.op_norm, tensorOp Op.Norm), |
94 |
(BV.fn_convolve, fn (y, _, [h, img]) => assign(y, Op.Convolve, [img, h])), |
(BV.fn_convolve, fn (y, _, [h, img]) => assign(y, Op.Convolve, [img, h])), |
95 |
(BV.fn_cos, simpleOp Op.Cos), |
(BV.fn_cos, simpleOp Op.Cos), |
96 |
(BV.fn_dot, vectorOp Op.Dot), |
(BV.fn_dot, vectorOp Op.Dot), |
97 |
(BV.fn_inside, fn (y, _, xs) => assign(y, Op.Inside, xs)), |
(BV.fn_inside, fn (y, [_, dv, _], xs) => |
98 |
(* |
assign(y, Op.Inside(dimVarToTensor dv), xs)), |
|
(BV.fn_load, fn (y, [NK, SK], xs) => ??), (*FIXME*) |
|
|
*) |
|
99 |
(BV.fn_max, simpleOp Op.Max), |
(BV.fn_max, simpleOp Op.Max), |
100 |
(BV.fn_min, simpleOp Op.Min), |
(BV.fn_min, simpleOp Op.Min), |
101 |
(BV.fn_modulate, vectorOp Op.Mul), |
(BV.fn_modulate, vectorOp Op.Mul), |
113 |
|
|
114 |
fun translate (y, f, mvs, xs) = (case VTbl.find tbl f |
fun translate (y, f, mvs, xs) = (case VTbl.find tbl f |
115 |
of SOME transFn => transFn(y, mvs, xs) |
of SOME transFn => transFn(y, mvs, xs) |
116 |
| NONE => raise Fail("TranslateBasis.translate: unknown function " ^ Var.uniqueNameOf f) |
| NONE => raise Fail("TranslateBasis.translate: unknown basis function " ^ Var.uniqueNameOf f) |
117 |
(* end case *)) |
(* end case *)) |
118 |
|
|
119 |
end |
end |