SCM Repository
[diderot] Annotation of /trunk/src/compiler/high-to-mid/high-to-mid.sml
Annotation of /trunk/src/compiler/high-to-mid/high-to-mid.sml
Parent Directory
| 
Revision Log
Revision 328 -
(view)
(download)
| 1 : |
jhr |
280 |
(* high-to-mid.sml
|
| 2 : |
|
|
*
|
| 3 : |
|
|
* COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
|
| 4 : |
|
|
* All rights reserved.
|
| 5 : |
|
|
*
|
| 6 : |
|
|
* Translation from HighIL to MidIL representations.
|
| 7 : |
|
|
*)
|
| 8 : |
|
|
|
| 9 : |
|
|
structure HighToMid : sig
|
| 10 : |
|
|
|
| 11 : |
|
|
val translate : HighIL.program -> MidIL.program
|
| 12 : |
|
|
|
| 13 : |
|
|
end = struct
|
| 14 : |
|
|
|
| 15 : |
|
|
structure SrcIL = HighIL
|
| 16 : |
|
|
structure SrcOp = SrcIL.Op
|
| 17 : |
|
|
structure DstIL = MidIL
|
| 18 : |
|
|
structure DstOp = DstIL.Op
|
| 19 : |
|
|
structure VMap = SrcIL.Var.Map
|
| 20 : |
|
|
|
| 21 : |
|
|
(* expand the field Inside operator into a image-space test *)
|
| 22 : |
|
|
fun expandInside (env, result, pos, fld) = let
|
| 23 : |
|
|
val pos' = lookupVar (env, pos)
|
| 24 : |
|
|
val fld = (case valueOf fld
|
| 25 : |
|
|
of SrcIL.OP(SrcOp.Field fld, []) => fld
|
| 26 : |
|
|
| _ => raise Fail "bogus field binding"
|
| 27 : |
|
|
(* end case *))
|
| 28 : |
jhr |
328 |
fun expand (FieldDef.CONV(_, img, _)) = let
|
| 29 : |
|
|
val imgPos = newVar "x"
|
| 30 : |
jhr |
280 |
in [
|
| 31 : |
|
|
(imgPos, DstIL.OP(DstOp.Transform img, [pos'])),
|
| 32 : |
|
|
(result, DstIL.OP(DstOp.Inside img, [imgPos]))
|
| 33 : |
|
|
] end
|
| 34 : |
jhr |
328 |
| expand (FieldDef.NEG fld) = expand fld
|
| 35 : |
|
|
| expand (FieldDef.SUM(fld1, dlf2)) = raise Fail "expandInside: SUM"
|
| 36 : |
jhr |
280 |
in
|
| 37 : |
|
|
expand fld
|
| 38 : |
|
|
end
|
| 39 : |
|
|
|
| 40 : |
jhr |
328 |
fun translate prog = raise Fail "FIXME"
|
| 41 : |
jhr |
314 |
|
| 42 : |
jhr |
280 |
end
|
