32 |
|
|
33 |
(* expand the field Inside operator into a image-space test *) |
(* expand the field Inside operator into a image-space test *) |
34 |
fun expandInside (env, result, pos, fld) = let |
fun expandInside (env, result, pos, fld) = let |
35 |
val fld = (case fld |
val pos = rename (env, pos) |
36 |
of SrcIL.OP(SrcOp.Field fld, []) => fld |
val fld = (case SrcIL.Var.binding fld |
37 |
|
of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld |
38 |
| _ => raise Fail "bogus field binding" |
| _ => raise Fail "bogus field binding" |
39 |
(* end case *)) |
(* end case *)) |
40 |
fun expand (FieldDef.CONV(_, img, _)) = let |
fun expand (FieldDef.CONV(_, img, _)) = let |
50 |
end |
end |
51 |
|
|
52 |
fun expandProbe (env, result, fld, pos) = let |
fun expandProbe (env, result, fld, pos) = let |
53 |
val fld = (case fld |
val pos = rename (env, pos) |
54 |
of SrcIL.OP(SrcOp.Field fld, []) => fld |
val fld = (case SrcIL.Var.binding fld |
55 |
|
of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld |
56 |
| _ => raise Fail "bogus field binding" |
| _ => raise Fail "bogus field binding" |
57 |
(* end case *)) |
(* end case *)) |
58 |
in |
in |
59 |
Probe.expand (result, fld, pos) |
Probe.expand (result, fld, pos) |
60 |
end |
end |
61 |
|
|
62 |
|
fun cvtTy SrcOp.BoolTy = DstOp.BoolTy |
63 |
|
| cvtTy SrcOp.StringTy = DstOp.StringTy |
64 |
|
| cvtTy SrcOp.IntTy = DstOp.IntTy |
65 |
|
| cvtTy (SrcOp.TensorTy[]) = DstOp.realTy |
66 |
|
| cvtTy (SrcOp.TensorTy[d]) = DstOp.VecTy d |
67 |
|
| cvtTy _ = raise Fail "unexpected higher-order tensor type" |
68 |
|
|
69 |
|
fun arity (SrcOp.TensorTy[]) = 1 |
70 |
|
| arity (SrcOp.TensorTy[d]) = d |
71 |
|
| arity _ = raise Fail "arity" |
72 |
|
|
73 |
fun expandOp (env, y, rator, args) = let |
fun expandOp (env, y, rator, args) = let |
74 |
fun assign rator' = [(y, DstIL.OP(rator', args))] |
fun assign rator' = |
75 |
|
[(y, DstIL.OP(rator', List.map (fn x => rename(env, x)) args))] |
76 |
in |
in |
77 |
case rator |
case rator |
78 |
of SrcIL.Add ty => assign (DstIL.Add(cvtTy ty)) |
of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty)) |
79 |
| SrcIL.Sub ty => assign (DstIL.Sub(cvtTy ty)) |
| SrcOp.Sub ty => assign (DstOp.Sub(cvtTy ty)) |
80 |
| SrcIL.Mul ty => assign (DstIL.Mul(cvtTy ty)) |
| SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty)) |
81 |
| SrcIL.Div ty => assign (DstIL.Div(cvtTy ty)) |
| SrcOp.Div ty => assign (DstOp.Div(cvtTy ty)) |
82 |
| SrcIL.Neg ty => assign (DstIL.Neg(cvtTy ty)) |
| SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty)) |
83 |
| SrcIL.LT ty => assign (DstIL.LT(cvtTy ty)) |
| SrcOp.LT ty => assign (DstOp.LT(cvtTy ty)) |
84 |
| SrcIL.LTE ty => assign (DstIL.LTE(cvtTy ty)) |
| SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty)) |
85 |
| SrcIL.EQ ty => assign (DstIL.EQ(cvtTy ty)) |
| SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty)) |
86 |
| SrcIL.NEQ ty => assign (DstIL.NEQ(cvtTy ty)) |
| SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty)) |
87 |
| SrcIL.GT ty => assign (DstIL.GT(cvtTy ty)) |
| SrcOp.GT ty => assign (DstOp.GT(cvtTy ty)) |
88 |
| SrcIL.GTE ty => assign (DstIL.GTE(cvtTy ty)) |
| SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty)) |
89 |
| SrcIL.Dot ty => assign (DstIL.Dot(cvtTy ty)) |
| SrcOp.Dot ty => assign (DstOp.Dot(arity ty)) |
90 |
| SrcIL.Cross => assign (DstIL.Cross) |
| SrcOp.Cross => assign DstOp.Cross |
91 |
| SrcIL.Norm ty => assign (DstIL.Norm(cvtTy ty)) |
| SrcOp.Norm ty => assign (DstOp.Norm(arity ty)) |
92 |
| SrcIL.Scale ty => assign (DstIL.Scale(cvtTy ty)) |
| SrcOp.Scale ty => assign (DstOp.Scale(arity ty)) |
93 |
| SrcIL.InvScale ty => assign (DstIL.InvScale(cvtTy ty)) |
| SrcOp.InvScale ty => assign (DstOp.InvScale(arity ty)) |
94 |
| SrcIL.CL => assign (DstIL.CL) |
| SrcOp.CL => assign DstOp.CL |
95 |
| SrcIL.PrincipleEvec ty => assign (DstIL.PrincipleEvec(cvtTy ty)) |
| SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty)) |
96 |
| SrcIL.Subscript ty => assign (DstIL.Subscript(cvtTy ty)) |
| SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty)) |
97 |
| SrcIL.Max => assign (DstIL.Max) |
| SrcOp.Max => assign DstOp.Max |
98 |
| SrcIL.Min => assign (DstIL.Min) |
| SrcOp.Min => assign DstOp.Min |
99 |
| SrcIL.Sin => assign (DstIL.Sin) |
| SrcOp.Sin => assign DstOp.Sin |
100 |
| SrcIL.Cos => assign (DstIL.Cos) |
| SrcOp.Cos => assign DstOp.Cos |
101 |
| SrcIL.Pow => assign (DstIL.Pow) |
| SrcOp.Pow => assign DstOp.Pow |
102 |
| SrcIL.Not => assign (DstIL.Not) |
| SrcOp.Not => assign DstOp.Not |
103 |
| SrcIL.IntToReal => assign (DstIL.IntToReal) |
| SrcOp.IntToReal => assign DstOp.IntToReal |
104 |
| SrcIL.TruncToInt => assign (DstIL.TruncToInt) |
| SrcOp.TruncToInt => assign (DstOp.TruncToInt 1) |
105 |
| SrcIL.RoundToInt => assign (DstIL.RoundToInt) |
| SrcOp.RoundToInt => assign (DstOp.RoundToInt 1) |
106 |
| SrcIL.CeilToInt => assign (DstIL.CeilToInt) |
| SrcOp.CeilToInt => assign (DstOp.CeilToInt 1) |
107 |
| SrcIL.FloorToInt => assign (DstIL.FloorToInt) |
| SrcOp.FloorToInt => assign (DstOp.FloorToInt 1) |
108 |
| SrcIL.LoadImage info => assign (DstIL.LoadImage info) |
| SrcOp.LoadImage info => assign (DstOp.LoadImage info) |
109 |
| SrcIL.Convolve => assign (DstIL.Convolve) |
| SrcOp.Inside => (case args |
110 |
| SrcIL.Inside => expandInside(env, y, #1 args, #2 args) |
of [pos, fld] => expandInside(env, y, pos, fld) |
111 |
| SrcIL.Probe => expandProbe(env, y, #1 args, #2 args) |
(* end case *)) |
112 |
| SrcIL.Input s => assign (DstIL.Input s) |
(* QUESTION: there is no MidIL equivalant, but these might be floating |
113 |
| SrcIL.InputWithDefault => assign (DstIL.InputWithDefault s) |
* around, which could cause invalid MidIL to be generated. |
114 |
| _ => raise Fail("unexpected " ^ SrcIL.Op.toString rator) |
*) |
115 |
|
| SrcOp.Field fld => [] |
116 |
|
| SrcOp.Probe => (case args |
117 |
|
of [fld, pos] => expandProbe(env, y, fld, pos) |
118 |
(* end case *)) |
(* end case *)) |
119 |
|
| SrcOp.Input s => assign (DstOp.Input s) |
120 |
|
| SrcOp.InputWithDefault s => assign (DstOp.InputWithDefault s) |
121 |
|
| _ => raise Fail("unexpected " ^ SrcOp.toString rator) |
122 |
|
(* end case *) |
123 |
|
end |
124 |
|
|
125 |
fun expand (env, (y, rhs)) = let |
fun expand (env, (y, rhs)) = let |
126 |
val y' = rename (env, y) |
val y' = rename (env, y) |
130 |
of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x))) |
of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x))) |
131 |
| SrcIL.LIT lit => assign (DstIL.LIT lit) |
| SrcIL.LIT lit => assign (DstIL.LIT lit) |
132 |
| SrcIL.OP(rator, args) => |
| SrcIL.OP(rator, args) => |
133 |
expandOp (env, y', rator, List.map (fn x => rename(env, x)) args) |
expandOp (env, y', rator, args) |
134 |
| SrcIL.CONS args => |
| SrcIL.CONS args => |
135 |
assign (DstIL.CONS(List.map (fn x => rename(env, x)) args)) |
assign (DstIL.CONS(List.map (fn x => rename(env, x)) args)) |
136 |
(* end case *) |
(* end case *) |