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

SCM Repository

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

Annotation of /branches/charisee_dev/src/compiler/mid-to-low/mid-to-low.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3395 - (view) (download)

1 : lamonts 345 (* mid-to-low.sml
2 :     *
3 : cchiw 3354 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 : lamonts 345 * All rights reserved.
5 :     *
6 :     * Translation from MidIL to LowIL representations.
7 :     *)
8 :    
9 :     structure MidToLow : sig
10 :    
11 : jhr 459 val translate : MidIL.program -> LowIL.program
12 : lamonts 345
13 : jhr 387 end = struct
14 : lamonts 345
15 :     structure SrcIL = MidIL
16 :     structure SrcOp = MidOps
17 : jhr 1640 structure SrcSV = SrcIL.StateVar
18 :     structure SrcTy = MidILTypes
19 : jhr 387 structure VTbl = SrcIL.Var.Tbl
20 : lamonts 345 structure DstIL = LowIL
21 : jhr 464 structure DstTy = LowILTypes
22 : lamonts 345 structure DstOp = LowOps
23 : jhr 3060 structure E = Ein
24 :     structure P = Printer
25 : cchiw 3357 structure EtLow = EinToLowSet
26 : jhr 3060 structure LowToS = LowToString
27 : cchiw 3033
28 : cchiw 3354 val testing = 0
29 : jhr 1640 (* instantiate the translation environment *)
30 :     local
31 :     type var_env = DstIL.var VTbl.hash_table
32 :     type state_var_env = DstIL.state_var SrcSV.Tbl.hash_table
33 : jhr 387
34 : jhr 1640 fun rename (env : var_env, x) = (case VTbl.find env x
35 :     of SOME x' => x'
36 :     | NONE => let
37 :     val x' = DstIL.Var.new (SrcIL.Var.name x, SrcIL.Var.ty x)
38 :     in
39 :     VTbl.insert env (x, x');
40 :     x'
41 :     end
42 :     (* end case *))
43 : lamonts 345
44 : jhr 1640 fun renameSV (env : state_var_env, x) = (case SrcSV.Tbl.find env x
45 :     of SOME x' => x'
46 :     | NONE => let
47 :     val x' = DstIL.StateVar.new (SrcSV.isOutput x, SrcSV.name x, SrcSV.ty x)
48 :     in
49 :     SrcSV.Tbl.insert env (x, x');
50 :     x'
51 :     end
52 :     (* end case *))
53 :     in
54 :     structure Env = TranslateEnvFn (
55 :     struct
56 :     structure SrcIL = SrcIL
57 :     structure DstIL = DstIL
58 : cchiw 2522
59 : jhr 1640 type var_env = var_env
60 :     type state_var_env = state_var_env
61 :     val rename = rename
62 :     val renameSV = renameSV
63 :     end)
64 :     end (* local *)
65 :    
66 : jhr 431 fun expandOp (env, y, rator, args) = let
67 : jhr 1640 val args' = Env.renameList (env, args)
68 : jhr 465 fun assign rator' = [(y, DstIL.OP(rator', args'))]
69 : cchiw 2525 fun dummy () = [(y, DstIL.LIT(Literal.Int 0))]
70 : jhr 431 in
71 :     case rator
72 : cchiw 2521 of SrcOp.IAdd => assign (DstOp.IAdd )
73 :     | SrcOp.ISub => assign (DstOp.ISub )
74 :     | SrcOp.IMul => assign (DstOp.IMul )
75 :     | SrcOp.IDiv => assign (DstOp.IDiv )
76 :     | SrcOp.INeg => assign (DstOp.INeg )
77 : jhr 1116 | SrcOp.Abs ty => assign (DstOp.Abs ty)
78 : jhr 459 | SrcOp.LT ty => assign (DstOp.LT ty)
79 :     | SrcOp.LTE ty => assign (DstOp.LTE ty)
80 :     | SrcOp.EQ ty => assign (DstOp.EQ ty)
81 :     | SrcOp.NEQ ty => assign (DstOp.NEQ ty)
82 :     | SrcOp.GT ty => assign (DstOp.GT ty)
83 :     | SrcOp.GTE ty => assign (DstOp.GTE ty)
84 :     | SrcOp.Not => assign (DstOp.Not)
85 :     | SrcOp.Max => assign (DstOp.Max)
86 :     | SrcOp.Min => assign (DstOp.Min)
87 : jhr 1295 | SrcOp.Clamp ty => assign (DstOp.Clamp ty)
88 : jhr 1116 | SrcOp.Lerp ty => assign (DstOp.Lerp ty)
89 : cchiw 2845 | SrcOp.Sqrt=>assign DstOp.Sqrt
90 : jhr 1116 | SrcOp.Zero ty => assign (DstOp.Zero ty)
91 : jhr 459 | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec ty)
92 : cchiw 2845 | SrcOp.EigenVals2x2 => assign (DstOp.EigenVals2x2)
93 :     | SrcOp.EigenVals3x3 => assign (DstOp.EigenVals3x3)
94 :     | SrcOp.Select(ty as SrcTy.TupleTy tys, i) => assign (DstOp.Select(ty, i))
95 :     | SrcOp.Index(ty, i) => assign (DstOp.Index(ty, i))
96 :     | SrcOp.Subscript ty => assign (DstOp.Subscript ty)
97 : jhr 1116 | SrcOp.Ceiling d => assign (DstOp.Ceiling d)
98 : jhr 459 | SrcOp.Floor d => assign (DstOp.Floor d)
99 : jhr 1116 | SrcOp.Round d => assign (DstOp.Round d)
100 :     | SrcOp.Trunc d => assign (DstOp.Trunc d)
101 : cchiw 2845 | SrcOp.sumVec d=>assign (DstOp.sumVec d)
102 : jhr 459 | SrcOp.IntToReal => assign (DstOp.IntToReal)
103 : jhr 1116 | SrcOp.RealToInt d => assign (DstOp.RealToInt d)
104 : jhr 459 | SrcOp.LoadVoxels(rty, d) => assign (DstOp.LoadVoxels(rty, d))
105 : cchiw 2859 | SrcOp.Kernel h => assign(DstOp.Kernel h)
106 : jhr 459 | SrcOp.Inside info => assign (DstOp.Inside info)
107 : jhr 3060 | SrcOp.LoadImage(ty, nrrd, info) => assign (DstOp.LoadImage(ty, nrrd, info))
108 :     | SrcOp.Input inp => assign (DstOp.Input inp)
109 : cchiw 2845 (*| SrcOp.Norm ty => assign (DstOp.Norm ty)*)
110 :     | SrcOp.Normalize d => assign (DstOp.Normalize d)
111 :     | SrcOp.Transform V=> assign (DstOp.Transform V)
112 :     | SrcOp.Translate V=> assign(DstOp.Translate V)
113 : jhr 1640 | rator => raise Fail("bogus operator " ^ SrcOp.toString rator)
114 : jhr 431 (* end case *)
115 :     end
116 : cchiw 2845
117 : cchiw 3033
118 : cchiw 2838 fun testp c=(case testing
119 :     of 0 => 1
120 :     | _ => (print(String.concat(c));1)
121 :     (*end case*))
122 :    
123 : cchiw 2628 fun expandEinOp (env, y, e, args) = let
124 : cchiw 2605 val einargs=Env.renameList(env, args)
125 : cchiw 3354 val _ = (String.concat ["\n",DstTy.toString(DstIL.Var.ty y)])
126 : cchiw 3276 val _ = testp(([DstTy.toString(DstIL.Var.ty y), "-",DstIL.Var.toString(y),"=",P.printerE(e)]
127 : cchiw 3196 @(List.map (fn e=> (DstIL.Var.toString(e)^",")) einargs)))
128 : cchiw 3354 (*val _=checkEin.checkEIN e*)
129 : cchiw 3261
130 : cchiw 3395 val _ = print(String.concat["\n********",DstIL.Var.toString(y), " prescan"])
131 :     (*val _=print (P.printerE e)*)
132 :    
133 : cchiw 3354 val code = EtLow.scan(y,e,einargs)
134 : cchiw 3174
135 : cchiw 3395 val _ = print(String.concat[" postscan"])
136 : cchiw 3354
137 : cchiw 3189 val tbl0= lowSet.LowSet.empty
138 :     fun getSet([],done,_,cnt)=(done,cnt)
139 :     | getSet( DstIL.ASSGN(lhs,rhs)::es,done,opset,cnt)=let
140 :     val (opset,var) = lowSet.filter(opset,(lhs,rhs))
141 :     in (case var
142 :     of NONE => getSet(es,done@[DstIL.ASSGN(lhs,rhs)], opset,cnt)
143 : cchiw 3395 | SOME v=> (("replacing"^DstIL.Var.toString(lhs));getSet(es,done@[DstIL.ASSGN(lhs,DstIL.VAR v)], opset,cnt+1))
144 : cchiw 3189 (*end case*))
145 :     end
146 :     | getSet (e1::es, done, opset,cnt)=getSet(es,done@[e1],opset,cnt)
147 : cchiw 3395 val _=print"creating set"
148 : cchiw 3189 val (code,cnt)=getSet(code, [],tbl0,0)
149 : cchiw 3395 val _ = print(String.concat[" post creating set"])
150 : cchiw 3383 val n=length(code)
151 : cchiw 3395 val _ = if (cnt> 5) then
152 : cchiw 3383 print(String.concat["\n Length: ",Int.toString n," Replaced: ", Int.toString cnt,
153 :     "\n",DstIL.Var.toString(y),"=",(P.printerE e),"\n"])
154 : cchiw 3395 else print "" (*(String.concat["\n Length: ",Int.toString n," Replaced: ", Int.toString cnt,
155 :     "\n",DstIL.Var.toString(y),"\n"])*)
156 : cchiw 3374 (*
157 : cchiw 3369 val _=if (cnt>100) then print(P.printerE e) else print ""
158 : cchiw 3355 val _ = "DONE"
159 : cchiw 3374 *)
160 : cchiw 3395 val _ = print(String.concat[" done"])
161 :    
162 : cchiw 2845 in
163 : cchiw 2859 code
164 : cchiw 2605 end
165 : cchiw 3048 handle ex => (print(concat["error converting \n",P.printerE(e)]); raise ex)
166 : cchiw 2398
167 : jhr 1116 (* expand a SrcIL assignment to a DstIL CFG *)
168 : jhr 387 fun expand (env, (y, rhs)) = let
169 : cchiw 3017 (*val _=testp["\nAttempting var",SrcIL.Var.toString y,"\n"]*)
170 : cchiw 2859 val y' = Env.rename (env, y)
171 :     fun assign rhs = [DstIL.ASSGN(y', rhs)]
172 :     in (case rhs
173 :     of SrcIL.STATE x => (assign (DstIL.STATE(Env.renameSV(env, x))))
174 : cchiw 2522 | SrcIL.VAR x => assign (DstIL.VAR(Env.rename(env, x)))
175 :     | SrcIL.LIT lit => (assign (DstIL.LIT lit))
176 :     | SrcIL.OP(rator, args) => (List.map DstIL.ASSGN (expandOp (env, y', rator, args)))
177 : cchiw 2845 | SrcIL.APPLY(f, args) => assign (DstIL.APPLY(f, Env.renameList(env, args)))
178 :     | SrcIL.CONS(ty, args) => assign (DstIL.CONS(ty, Env.renameList(env, args)))
179 : cchiw 3259 | SrcIL.EINAPP(rator, args) => (testp["\n *************** \nNew Ein\n srcvar:",SrcIL.Var.toString y];expandEinOp (env, Env.rename (env, y), rator, args))
180 : cchiw 2859 (* end case *))
181 :     end
182 : lamonts 345
183 : jhr 1640 (* expand a SrcIL multi-assignment to a DstIL CFG *)
184 :     fun mexpand (env, (ys, rator, xs)) = let
185 :     val ys' = Env.renameList(env, ys)
186 :     val rator' = (case rator
187 :     of SrcOp.EigenVecs2x2 => DstOp.EigenVecs2x2
188 :     | SrcOp.EigenVecs3x3 => DstOp.EigenVecs3x3
189 :     | SrcOp.Print tys => DstOp.Print tys
190 :     | _ => raise Fail("bogus operator " ^ SrcOp.toString rator)
191 :     (* end case *))
192 :     val xs' = Env.renameList(env, xs)
193 :     val nd = DstIL.Node.mkMASSIGN(ys', rator', xs')
194 :     in
195 :     DstIL.CFG{entry=nd, exit=nd}
196 :     end
197 :    
198 : jhr 387 structure Trans = TranslateFn (
199 :     struct
200 : jhr 1640 open Env
201 :     val expand = DstIL.CFG.mkBlock o expand
202 :     val mexpand = mexpand
203 : jhr 387 end)
204 :    
205 : jhr 1116 fun translate prog = let
206 :     val prog = Trans.translate prog
207 : jhr 387 in
208 : jhr 1116 LowILCensus.init prog;
209 :     prog
210 : jhr 387 end
211 :    
212 : jhr 435 end

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