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

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/codegen/low-to-tree.sml
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/codegen/low-to-tree.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 530, Mon Feb 14 16:34:57 2011 UTC revision 531, Mon Feb 14 17:45:57 2011 UTC
# Line 25  Line 25 
25    
26    (* create new tree IL variables *)    (* create new tree IL variables *)
27      local      local
28        val newVar (name, kind, ty) = V{        fun newVar (name, kind, ty) = T.V{
29                name = name,                name = name,
30                stamp = Stamp.new(),                id = Stamp.new(),
31                kind = kind,                kind = kind,
32                ty = ty                ty = ty
33              }              }
# Line 43  Line 43 
43      fun newLocal x = newVar (genName(V.name x), T.VK_Local, V.ty x)      fun newLocal x = newVar (genName(V.name x), T.VK_Local, V.ty x)
44      end      end
45    
46        fun mkBlock stms = T.Block{locals=[], body=stms}
47        fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)
48          | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)
49    
50    (* an environment that tracks bindings of variables to target expressions and the list    (* an environment that tracks bindings of variables to target expressions and the list
51     * of locals that have been defined.     * of locals that have been defined.
52     *)     *)
# Line 62  Line 66 
66            locals : T.var list            locals : T.var list
67          }          }
68        fun peekGlobal (E{tbl, ...}, x) = (case VT.find tbl x        fun peekGlobal (E{tbl, ...}, x) = (case VT.find tbl x
69               of GLOB x' => SOME x'               of SOME(GLOB x') => SOME x'
70                | _ => NONE                | _ => NONE
71              (* end case *))              (* end case *))
72      in      in
73        fun newEnv () = E{tbl = VT.mkTable (512, Fail "tbl"), locals=[]}
74    
75        fun newScope (E{tbl, ...}) = E{tbl=tbl, locals=[]}
76    
77    (* use a variable.  If it is a pending expression, we decrement its use count *)    (* use a variable.  If it is a pending expression, we decrement its use count *)
78      fun useVar (E{tbl, ...}) x = (case VT.find tbl x      fun useVar (E{tbl, ...}) x = (case VT.find tbl x
79             of SOME(GLOB x') => T.E_Var x'             of SOME(GLOB x') => T.E_Var x'
80              | SOME(TREE e) => (              | SOME(TREE e) => (
81                  if (decCount x) then VT.remove tbl x else ();                  if (decCount x) then ignore(VT.remove tbl x) else ();
82                  e)                  e)
83              | SOME(DEF e) => e              | SOME(DEF e) => e
84            (* end case *))            (* end case *))
# Line 78  Line 86 
86    (* record a local variable *)    (* record a local variable *)
87      fun addLocal (E{tbl, locals}, x) = E{tbl=tbl, locals=x::locals}      fun addLocal (E{tbl, locals}, x) = E{tbl=tbl, locals=x::locals}
88    
89        fun global (E{tbl, ...}, x, x') = VT.insert tbl (x, GLOB x')
90    
91      fun insert (env as E{tbl, ...}, x, exp) = (      fun insert (env as E{tbl, ...}, x, exp) = (
92            VT.insert tbl (x, TREE exp);            VT.insert tbl (x, TREE exp);
93            env)            env)
94    
95      fun rename (env as E{tbl, ...}, x, x') = (      fun rename (env as E{tbl, ...}, x, x') = (
96            VT.insert tbl (x, DEF(T.E_Var x));            VT.insert tbl (x, DEF(T.E_Var x'));
97            env)            env)
98    
99      fun bind (env, lhs, rhs) = (case peekGlobal (env, lhs)      fun bind (env, lhs, rhs) = (case peekGlobal (env, lhs)
# Line 110  Line 120 
120                   val t = newLocal x                   val t = newLocal x
121                    in                    in
122                      VT.insert tbl (x, DEF(T.E_Var t));                      VT.insert tbl (x, DEF(T.E_Var t));
123                      (t::locals, T.S_Assign(t, rhs)::stms)                      (t::locals, T.S_Assign(t, e)::stms)
124                    end                    end
125            val (locals, stms) = VT.foldi doVar blkStms tbl            val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl
126            in            in
127              (E{tbl=tbl, locals=locals}, stms)              (E{tbl=tbl, locals=locals}, stms)
128            end            end
# Line 120  Line 130 
130      fun doPhi ((lhs, rhs), (env, predBlks : T.stm list list)) = let      fun doPhi ((lhs, rhs), (env, predBlks : T.stm list list)) = let
131            val t = newLocal lhs            val t = newLocal lhs
132            val predBlks = ListPair.map            val predBlks = ListPair.map
133                  (fn (x, stms) => T.Assign(t, useVar env x)::stms)                  (fn (x, stms) => T.S_Assign(t, useVar env x)::stms)
134                    (rhs, predBlks)                    (rhs, predBlks)
135            in            in
136              (rename (env, lhs, t), preBlks)              (rename (env, lhs, t), predBlks)
137            end            end
138    
139        fun endScope (E{locals, ...}, stms) = T.Block{
140                locals = List.rev locals,
141                body = stms
142              }
143    
144      end      end
145    
146    (* translate a LowIL assignment to a list of zero or more target statements *)    (* translate a LowIL assignment to a list of zero or more target statements *)
147      fun doAssign (env, lhs, rhs) = (case rhs      fun doAssign (env, (lhs, rhs)) = (case rhs
148             of IL.VAR x => setDef (useVar env x)             of IL.VAR x => setDef (env, lhs, useVar env x)
149              | IL.LIT lit => setDef (T.E_Lit lit)              | IL.LIT lit => setDef (env, lhs, T.E_Lit lit)
150              | IL.OP(rator, args) =>              | IL.OP(rator, args) =>
151                  bind (env, lhs, T.E_Op(rator, List.map (useVar env) args))                  bind (env, lhs, T.E_Op(rator, List.map (useVar env) args))
152              | IL.CONS args => let              | IL.CONS args => let
# Line 144  Line 159 
159            (* end case *))            (* end case *))
160    
161      fun gen (env, cfg) = let      fun gen (env, cfg) = let
162            fun doNode (env, ifCont, stms, nd) = (case Nd.kind nd            fun doNode (env, ifCont : T.stm list * IL.node_kind -> T.block, stms, nd) = (
163                    case Nd.kind nd
164                   of IL.NULL => raise Fail "unexpected NULL"                   of IL.NULL => raise Fail "unexpected NULL"
165                    | IL.ENTRY{succ} => doNode (env, ifCont, stms, !succ)                    | IL.ENTRY{succ} => doNode (env, ifCont, stms, !succ)
166                    | IL.JOIN{phis, succ, ...} => ifCont (stms, Nd.kind nd)                    | IL.JOIN{phis, succ, ...} => ifCont (stms, Nd.kind nd)
# Line 155  Line 171 
171                                    val (env, elseBlk) = endBlock (env, stms')                                    val (env, elseBlk) = endBlock (env, stms')
172                                    val (env, [thenBlk, elseBlk]) =                                    val (env, [thenBlk, elseBlk]) =
173                                          List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)                                          List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)
174                                    val stm = T.Stmt.ifthenelse (                                    val stm = mkIf(useVar env cond, List.rev thenBlk, List.rev elseBlk)
                                         useVar env cond,  
                                         T.mkBlock (List.rev thenBlk),  
                                         T.mkBlock (List.rev elseBlk))  
175                                    in                                    in
176                                      doNode (env, ifCont, stm::stms, !succ)                                      doNode (env, ifCont, stm::stms, !succ)
177                                    end                                    end
# Line 169  Line 182 
182                          doNode (env, kThen, [], !trueBranch)                          doNode (env, kThen, [], !trueBranch)
183                        end                        end
184                    | IL.COM {text, succ, ...} =>                    | IL.COM {text, succ, ...} =>
185                        doNode (env, ifCont, T.Stmt.comment text :: stms, !succ)                        doNode (env, ifCont, T.S_Comment text :: stms, !succ)
186                    | IL.ASSIGN{stm, succ, ...} =>                    | IL.ASSIGN{stm, succ, ...} => let
187                        doNode (env, ifCont, doAssign stm @ stms, !succ)                        val (env, stms') = doAssign (env, stm)
188                          in
189                            doNode (env, ifCont, stms' @ stms, !succ)
190                          end
191                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
192                    | IL.DIE _ =>                    | IL.DIE _ =>
193                        T.Stmt.block (List.rev (T.Stmt.die() :: stms))                        mkBlock (List.rev (T.S_Die :: stms))
194                    | IL.STABILIZE _ =>                    | IL.STABILIZE _ =>
195                        T.Stmt.block (List.rev stms)                        mkBlock (List.rev stms)
196                    | IL.EXIT _ => T.Stmt.block (List.rev (T.Stmt.stabilize() :: stms))                    | IL.EXIT _ => endScope (env, List.rev (T.S_Stabilize :: stms))
197                  (* end case *))                  (* end case *))
198            in            in
199              doNode (vtbl, fn _ => raise Fail "bogus ifCont at JOIN node", [], CFG.entry cfg)              doNode (env, fn _ => raise Fail "bogus ifCont at JOIN node", [], CFG.entry cfg)
200              end
201    
202        fun translate (IL.Program{globals, globalInit, strands}) = let
203              val env = newEnv()
204              val globals = List.map
205                    (fn x => let val x' = newGlobal x in global(env, x, x'); x' end)
206                      globals
207              in
208                T.Program{
209                    globals = globals,
210                    globalInit = gen (env, globalInit),
211                    strands = [] (* FIXME *)
212                  }
213            end            end
214    
215    end    end

Legend:
Removed from v.530  
changed lines
  Added in v.531

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