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 365 - (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 365 val pos = rename (env, pos)
36 :     val fld = (case SrcIL.Var.binding fld
37 :     of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
38 : jhr 280 | _ => raise Fail "bogus field binding"
39 :     (* end case *))
40 : jhr 328 fun expand (FieldDef.CONV(_, img, _)) = let
41 : jhr 334 val imgPos = DstIL.Var.new "x"
42 : jhr 280 in [
43 : jhr 364 (imgPos, DstIL.OP(DstOp.Transform img, [pos])),
44 : jhr 280 (result, DstIL.OP(DstOp.Inside img, [imgPos]))
45 :     ] end
46 : jhr 328 | expand (FieldDef.NEG fld) = expand fld
47 :     | expand (FieldDef.SUM(fld1, dlf2)) = raise Fail "expandInside: SUM"
48 : jhr 280 in
49 :     expand fld
50 :     end
51 :    
52 : jhr 358 fun expandProbe (env, result, fld, pos) = let
53 : jhr 365 val pos = rename (env, pos)
54 :     val fld = (case SrcIL.Var.binding fld
55 :     of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
56 : jhr 358 | _ => raise Fail "bogus field binding"
57 :     (* end case *))
58 :     in
59 : jhr 364 Probe.expand (result, fld, pos)
60 : jhr 358 end
61 : jhr 334
62 : jhr 365 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 : jhr 364 fun expandOp (env, y, rator, args) = let
74 : jhr 365 fun assign rator' =
75 :     [(y, DstIL.OP(rator', List.map (fn x => rename(env, x)) args))]
76 : jhr 364 in
77 :     case rator
78 : jhr 365 of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))
79 :     | SrcOp.Sub ty => assign (DstOp.Sub(cvtTy ty))
80 :     | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))
81 :     | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))
82 :     | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))
83 :     | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
84 :     | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
85 :     | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
86 :     | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
87 :     | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
88 :     | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
89 :     | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
90 :     | SrcOp.Cross => assign DstOp.Cross
91 :     | SrcOp.Norm ty => assign (DstOp.Norm(arity ty))
92 :     | SrcOp.Scale ty => assign (DstOp.Scale(arity ty))
93 :     | SrcOp.InvScale ty => assign (DstOp.InvScale(arity ty))
94 :     | SrcOp.CL => assign DstOp.CL
95 :     | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
96 :     | SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty))
97 :     | SrcOp.Max => assign DstOp.Max
98 :     | SrcOp.Min => assign DstOp.Min
99 :     | SrcOp.Sin => assign DstOp.Sin
100 :     | SrcOp.Cos => assign DstOp.Cos
101 :     | SrcOp.Pow => assign DstOp.Pow
102 :     | SrcOp.Not => assign DstOp.Not
103 :     | SrcOp.IntToReal => assign DstOp.IntToReal
104 :     | SrcOp.TruncToInt => assign (DstOp.TruncToInt 1)
105 :     | SrcOp.RoundToInt => assign (DstOp.RoundToInt 1)
106 :     | SrcOp.CeilToInt => assign (DstOp.CeilToInt 1)
107 :     | SrcOp.FloorToInt => assign (DstOp.FloorToInt 1)
108 :     | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
109 :     | SrcOp.Inside => (case args
110 :     of [pos, fld] => expandInside(env, y, pos, fld)
111 :     (* end case *))
112 :     (* QUESTION: there is no MidIL equivalant, but these might be floating
113 :     * around, which could cause invalid MidIL to be generated.
114 :     *)
115 :     | SrcOp.Field fld => []
116 :     | SrcOp.Probe => (case args
117 :     of [fld, pos] => expandProbe(env, y, fld, pos)
118 :     (* 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 : jhr 314
125 : jhr 364 fun expand (env, (y, rhs)) = let
126 :     val y' = rename (env, y)
127 :     fun assign rhs = [(y', rhs)]
128 :     in
129 :     case rhs
130 :     of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
131 :     | SrcIL.LIT lit => assign (DstIL.LIT lit)
132 :     | SrcIL.OP(rator, args) =>
133 : jhr 365 expandOp (env, y', rator, args)
134 : jhr 364 | SrcIL.CONS args =>
135 :     assign (DstIL.CONS(List.map (fn x => rename(env, x)) args))
136 :     (* end case *)
137 :     end
138 :    
139 :     structure Trans = TranslateFn (
140 :     struct
141 :     structure SrcIL = SrcIL
142 :     structure DstIL = DstIL
143 :    
144 :     type var_env = var_env
145 :    
146 :     val rename = rename
147 :     val expand = expand
148 :     end)
149 :    
150 :     fun translate (SrcIL.Program{globals, globalInit, actors}) =
151 :     raise Fail "unimplemented"
152 :    
153 : jhr 280 end

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