Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/vis12/src/compiler/high-to-mid/high-to-mid.sml
ViewVC logotype

Annotation of /branches/vis12/src/compiler/high-to-mid/high-to-mid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 364 - (view) (download)
Original Path: trunk/src/compiler/high-to-mid/high-to-mid.sml

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 : jhr 334 structure SrcOp = HighOps
17 : jhr 364 structure VTbl = SrcIL.Var.Tbl
18 : jhr 280 structure DstIL = MidIL
19 : jhr 334 structure DstOp = MidOps
20 : jhr 280
21 : jhr 364 type var_env = DstIL.var SrcIL.Var.Tbl.hash_table
22 :    
23 :     fun rename (env : var_env, x) = (case VTbl.find env x
24 : jhr 334 of SOME x' => x'
25 : jhr 364 | NONE => let
26 :     val x' = DstIL.Var.new (SrcIL.Var.name x)
27 :     in
28 :     VTbl.insert env (x, x');
29 :     x'
30 :     end
31 : jhr 334 (* end case *))
32 :    
33 : jhr 280 (* expand the field Inside operator into a image-space test *)
34 :     fun expandInside (env, result, pos, fld) = let
35 : jhr 349 val fld = (case fld
36 : jhr 280 of SrcIL.OP(SrcOp.Field fld, []) => fld
37 :     | _ => raise Fail "bogus field binding"
38 :     (* end case *))
39 : jhr 328 fun expand (FieldDef.CONV(_, img, _)) = let
40 : jhr 334 val imgPos = DstIL.Var.new "x"
41 : jhr 280 in [
42 : jhr 364 (imgPos, DstIL.OP(DstOp.Transform img, [pos])),
43 : jhr 280 (result, DstIL.OP(DstOp.Inside img, [imgPos]))
44 :     ] end
45 : jhr 328 | expand (FieldDef.NEG fld) = expand fld
46 :     | expand (FieldDef.SUM(fld1, dlf2)) = raise Fail "expandInside: SUM"
47 : jhr 280 in
48 :     expand fld
49 :     end
50 :    
51 : jhr 358 fun expandProbe (env, result, fld, pos) = let
52 :     val fld = (case fld
53 :     of SrcIL.OP(SrcOp.Field fld, []) => fld
54 :     | _ => raise Fail "bogus field binding"
55 :     (* end case *))
56 :     in
57 : jhr 364 Probe.expand (result, fld, pos)
58 : jhr 358 end
59 : jhr 334
60 : jhr 364 fun expandOp (env, y, rator, args) = let
61 :     fun assign rator' = [(y, DstIL.OP(rator', args))]
62 :     in
63 :     case rator
64 :     of SrcIL.Add ty => assign (DstIL.Add(cvtTy ty))
65 :     | SrcIL.Sub ty => assign (DstIL.Sub(cvtTy ty))
66 :     | SrcIL.Mul ty => assign (DstIL.Mul(cvtTy ty))
67 :     | SrcIL.Div ty => assign (DstIL.Div(cvtTy ty))
68 :     | SrcIL.Neg ty => assign (DstIL.Neg(cvtTy ty))
69 :     | SrcIL.LT ty => assign (DstIL.LT(cvtTy ty))
70 :     | SrcIL.LTE ty => assign (DstIL.LTE(cvtTy ty))
71 :     | SrcIL.EQ ty => assign (DstIL.EQ(cvtTy ty))
72 :     | SrcIL.NEQ ty => assign (DstIL.NEQ(cvtTy ty))
73 :     | SrcIL.GT ty => assign (DstIL.GT(cvtTy ty))
74 :     | SrcIL.GTE ty => assign (DstIL.GTE(cvtTy ty))
75 :     | SrcIL.Dot ty => assign (DstIL.Dot(cvtTy ty))
76 :     | SrcIL.Cross => assign (DstIL.Cross)
77 :     | SrcIL.Norm ty => assign (DstIL.Norm(cvtTy ty))
78 :     | SrcIL.Scale ty => assign (DstIL.Scale(cvtTy ty))
79 :     | SrcIL.InvScale ty => assign (DstIL.InvScale(cvtTy ty))
80 :     | SrcIL.CL => assign (DstIL.CL)
81 :     | SrcIL.PrincipleEvec ty => assign (DstIL.PrincipleEvec(cvtTy ty))
82 :     | SrcIL.Subscript ty => assign (DstIL.Subscript(cvtTy ty))
83 :     | SrcIL.Max => assign (DstIL.Max)
84 :     | SrcIL.Min => assign (DstIL.Min)
85 :     | SrcIL.Sin => assign (DstIL.Sin)
86 :     | SrcIL.Cos => assign (DstIL.Cos)
87 :     | SrcIL.Pow => assign (DstIL.Pow)
88 :     | SrcIL.Not => assign (DstIL.Not)
89 :     | SrcIL.IntToReal => assign (DstIL.IntToReal)
90 :     | SrcIL.TruncToInt => assign (DstIL.TruncToInt)
91 :     | SrcIL.RoundToInt => assign (DstIL.RoundToInt)
92 :     | SrcIL.CeilToInt => assign (DstIL.CeilToInt)
93 :     | SrcIL.FloorToInt => assign (DstIL.FloorToInt)
94 :     | SrcIL.LoadImage info => assign (DstIL.LoadImage info)
95 :     | SrcIL.Convolve => assign (DstIL.Convolve)
96 :     | SrcIL.Inside => expandInside(env, y, #1 args, #2 args)
97 :     | SrcIL.Probe => expandProbe(env, y, #1 args, #2 args)
98 :     | SrcIL.Input s => assign (DstIL.Input s)
99 :     | SrcIL.InputWithDefault => assign (DstIL.InputWithDefault s)
100 :     | _ => raise Fail("unexpected " ^ SrcIL.Op.toString rator)
101 :     (* end case *))
102 : jhr 314
103 : jhr 364 fun expand (env, (y, rhs)) = let
104 :     val y' = rename (env, y)
105 :     fun assign rhs = [(y', rhs)]
106 :     in
107 :     case rhs
108 :     of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
109 :     | SrcIL.LIT lit => assign (DstIL.LIT lit)
110 :     | SrcIL.OP(rator, args) =>
111 :     expandOp (env, y', rator, List.map (fn x => rename(env, x)) args)
112 :     | SrcIL.CONS args =>
113 :     assign (DstIL.CONS(List.map (fn x => rename(env, x)) args))
114 :     (* end case *)
115 :     end
116 :    
117 :     structure Trans = TranslateFn (
118 :     struct
119 :     structure SrcIL = SrcIL
120 :     structure DstIL = DstIL
121 :    
122 :     type var_env = var_env
123 :    
124 :     val rename = rename
125 :     val expand = expand
126 :     end)
127 :    
128 :     fun translate (SrcIL.Program{globals, globalInit, actors}) =
129 :     raise Fail "unimplemented"
130 :    
131 : jhr 280 end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0