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

SCM Repository

[diderot] Diff of /branches/lamont_dev/src/compiler/translate/translate.sml
[diderot] / branches / lamont_dev / src / compiler / translate / translate.sml  
ViewVC logotype

Diff of /branches/lamont_dev/src/compiler/translate/translate.sml

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

revision 1867, Mon May 7 14:43:11 2012 UTC revision 1868, Fri May 11 03:17:42 2012 UTC
# Line 73  Line 73 
73              (env, List.rev xs)              (env, List.rev xs)
74            end            end
75    
76        datatype joinType
77         = NORMAL_JOIN
78         | FOREACH_JOIN
79    
80    
81    (* a pending-join node tracks the phi nodes needed to join the assignments    (* a pending-join node tracks the phi nodes needed to join the assignments
82     * that flow into the join node.     * that flow into the join node.
83     *)     *)
84      datatype join = JOIN of {      datatype join
85          env : env,                      (* the environment that was current at the conditional *)       = JOIN of {
86                env : env ref,                      (* the environment that was current at the conditional *)
87                                          (* associated with this node. *)                                          (* associated with this node. *)
88          arity : int ref,                (* actual number of predecessors *)          arity : int ref,                (* actual number of predecessors *)
89          nd : IL.node,                   (* the CFG node for this pending join *)          nd : IL.node,                   (* the CFG node for this pending join *)
90          phiMap : IL.phi VMap.map ref,   (* a mapping from Simple AST variables that are assigned *)          phiMap : IL.phi VMap.map ref,   (* a mapping from Simple AST variables that are assigned *)
91                                          (* to their phi nodes. *)                                          (* to their phi nodes. *)
92          predKill : bool array           (* killed predecessor edges (because of DIE or STABILIZE *)              predKill : bool array,              (* killed predecessor edges (because of DIE or STABILIZE *)
93            joinTy : joinType
94        }        }
95    
96    
97    (* a stack of pending joins.  The first component specifies the path index of the current    (* a stack of pending joins.  The first component specifies the path index of the current
98     * path to the join.     * path to the join.
99     *)     *)
100      type pending_joins = (int * join) list      type pending_joins = (int * join) list
101    
102    
103        fun writeToFile(stringList) = let
104            val outfile = TextIO.openAppend("/home/lamont/debug.out");
105           fun printS(stream,[]) = TextIO.closeOut(stream)
106             | printS(stream,x::rest) =
107                   (TextIO.output(outfile,x);
108                   printS(stream,rest))
109            in
110               printS(outfile,stringList)
111            end
112    
113    
114    (* create a new pending-join node *)    (* create a new pending-join node *)
115      fun newJoin (env, arity) = JOIN{      fun newJoin (env, arity) = JOIN{
116              env = env, arity = ref arity, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty,              env = ref env, arity = ref arity, joinTy = NORMAL_JOIN, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty,
117                predKill = Array.array(arity, false)
118            }
119    
120        fun newJoinWithNode(env,arity,nd as  IL.ND{kind=IL.FOREACH{...}, ...}) = JOIN {
121            env = ref env, arity = ref arity, joinTy = FOREACH_JOIN, nd = nd, phiMap = ref VMap.empty,
122              predKill = Array.array(arity, false)              predKill = Array.array(arity, false)
123            }            }
124    
# Line 108  Line 133 
133     * JOIN node this assignment occurs on.     * JOIN node this assignment occurs on.
134     *)     *)
135      fun recordAssign ([], _, _) = ()      fun recordAssign ([], _, _) = ()
136        | recordAssign ((predIndex, JOIN{env, phiMap, predKill, nd, ...})::_, srcVar, dstVar) = let        | recordAssign ((predIndex, JOIN{env, phiMap, predKill, nd, joinTy, ...})::_, srcVar, dstVar) = let
137            val arity = Array.length predKill (* the original arity before any killPath calls *)            val arity = Array.length predKill (* the original arity before any killPath calls *)
138            val m = !phiMap            val m = !phiMap
139            in            in
140              case VMap.find (env, srcVar)   (*(if joinTy = FOREACH_JOIN then
141               of NONE => () (* local temporary *)  print(concat["Beginning recordAssign: ", Var.uniqueNameOf srcVar, "\n"])
142    else
143       ()); *)
144    
145                case VMap.find (!env, srcVar)
146                 of NONE => (*print(concat["Not in Environment recordAssign: ", Var.uniqueNameOf srcVar, "\n"])*) () (* local temporary *)
147                | SOME dstVar' => (case VMap.find (m, srcVar)                | SOME dstVar' => (case VMap.find (m, srcVar)
148                     of NONE => let                     of NONE => let
149                          val lhs = newVar srcVar                          val lhs = newVar srcVar
150                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')
151    fun printRhs ([]) = ()
152                  | printRhs (dstvar::rest) =
153                     (print(concat["rhs: ", IL.Var.toString dstvar, "\n"]);
154                     printRhs(rest))
155                            in
156                     if joinTy = FOREACH_JOIN then
157                       let
158                           val IL.ND{kind=IL.FOREACH{shouldReplace, ...}, ...} = nd
159                          in                          in
160  (*                          (env := VMap.insert(!env,srcVar,lhs);
161  print(concat["recordAssign: ", Var.uniqueNameOf srcVar, " --> ", IL.Var.toString lhs,                          shouldReplace := true)
162  " @ ", IL.Node.toString nd, "\n"]);                      end
163  *)                   else
164                          ();
165    
166                            phiMap := VMap.insert (m, srcVar, (lhs, rhs))                            phiMap := VMap.insert (m, srcVar, (lhs, rhs))
167                          end                          end
168                      | SOME(lhs, rhs) => let                      | SOME(lhs, rhs) => let
169                    fun printRhs ([]) = ()
170                  | printRhs (dstvar::rest) =
171                     (print(concat["rhs: ", IL.Var.toString dstvar, "\n"]);
172                     printRhs(rest))
173                          fun update (i, l as x::r) = if (i = predIndex)                          fun update (i, l as x::r) = if (i = predIndex)
174                                then dstVar::r                                then dstVar::r
175                                else x::update(i+1, r)                                else x::update(i+1, r)
176                            | update _ = raise Fail "invalid predecessor index"                            | update _ = raise Fail "invalid predecessor index"
177                          in                          in
178    (* (if joinTy = FOREACH_JOIN then
179    (print(concat["sOMDE recordAssign: ", Var.uniqueNameOf srcVar, " --> ", IL.Var.toString lhs,
180    " @ ", IL.Node.toString nd, "\n"]);
181      printRhs(rhs))
182    else
183        ()); *)
184                            phiMap := VMap.insert (m, srcVar, (lhs, update(0, rhs)))                            phiMap := VMap.insert (m, srcVar, (lhs, update(0, rhs)))
185                          end                          end
186                    (* end case *))                    (* end case *))
# Line 140  Line 190 
190    (* complete a pending join operation by filling in the phi nodes from the phi map and    (* complete a pending join operation by filling in the phi nodes from the phi map and
191     * updating the environment.     * updating the environment.
192     *)     *)
193      fun commitJoin (joinStk, JOIN{env, arity, nd, phiMap, predKill}) = (case !arity      fun commitJoin (joinStk, JOIN{env, arity, nd, phiMap, predKill,joinTy,...}) = (case !arity
194             of 0 => (env, NONE)             of 0 => (!env, NONE)
195              | 1 => (* there is only one path to the join, so we do not need phi nodes *)              | 1 => (* there is only one path to the join, so we do not need phi nodes *)
196                  (env, SOME nd)                  (!env, SOME nd)
197              | n => if (n = Array.length predKill)              | n => if (n = Array.length predKill)
198                  then let                  then let
199              val phis = (case joinTy of
200                           NORMAL_JOIN => let
201                    val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd                    val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd
202                          in
203                             phis
204                          end
205                          |FOREACH_JOIN => let
206                           val IL.ND{kind=IL.FOREACH{phis, ...}, ...} = nd
207                          in
208                            phis
209                          end)
210                    fun doVar (srcVar, phi as (dstVar, _), (env, phis)) = (                    fun doVar (srcVar, phi as (dstVar, _), (env, phis)) = (
211  (*  (*print(concat["doVar (", Var.uniqueNameOf srcVar, ", ", IL.phiToString phi, ", _) @ ", IL.Node.toString nd, "\n"]);*)
212  print(concat["doVar (", Var.uniqueNameOf srcVar, ", ", IL.phiToString phi, ", _) @ ", IL.Node.toString nd, "\n"]);  
 *)  
213                          recordAssign (joinStk, srcVar, dstVar);                          recordAssign (joinStk, srcVar, dstVar);
214                          (VMap.insert (env, srcVar, dstVar), phi::phis))                          (VMap.insert (env, srcVar, dstVar), phi::phis))
215                    val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)                    val (env', phis') = VMap.foldli doVar (!env, []) (!phiMap)
216                    in                    in
217                      phis := phis';                      phis := phis';
218                      (env, SOME nd)                      (env', SOME nd)
219                    end                    end
220                  else raise Fail "FIXME: prune killed paths."                  else raise Fail "FIXME: prune killed paths."
221            (* end case *))            (* end case *))
# Line 169  Line 228 
228              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
229              | S.E_Apply(f, tyArgs, args, ty) => let              | S.E_Apply(f, tyArgs, args, ty) => let
230                  val args' = List.map (lookup env) args                  val args' = List.map (lookup env) args
231            fun printArgs([]) = ()
232              | printArgs(x::rest) =
233               (*  (print(concat["Arg:", IL.Var.toString x, "\n"]); *)
234                  printArgs(rest)
235                  in                  in
236              printArgs(args');
237                    TranslateBasis.translate (lhs, f, tyArgs, args')                    TranslateBasis.translate (lhs, f, tyArgs, args')
238                  end                  end
239              | S.E_Cons args => [IL.ASSGN(lhs, IL.CONS(IL.Var.ty lhs, List.map (lookup env) args))]              | S.E_Cons args => [IL.ASSGN(lhs, IL.CONS(IL.Var.ty lhs, List.map (lookup env) args))]
# Line 202  Line 266 
266            end            end
267  handle ex => raise ex  handle ex => raise ex
268    
269    
270    
271    
272      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let
273          fun cvtLoopBlock(forNode as IL.ND{kind=IL.FOREACH{shouldReplace, ...}, ...},state,joinStk,blk) = let
274                        val (_,JOIN{env,...})::_ = joinStk
275                        val(cfg0,e) = cvtBlock (state,!env,joinStk, blk)
276                     in
277                        (print(Bool.toString(!shouldReplace));
278                        if(!shouldReplace = true) then
279                            (print("got here\n"); shouldReplace := false;
280                            cvtLoopBlock(forNode,state,joinStk,blk))
281                        else
282                            (cfg0,e))
283                     end
284    
285            fun cvt (env : env, cfg, []) = (cfg, env)            fun cvt (env : env, cfg, []) = (cfg, env)
286              | cvt (env, cfg, stm::stms) = (case stm              | cvt (env, cfg, stm::stms) = (case stm
287                   of S.S_Var x => let                   of S.S_Var x => let
# Line 217  Line 296 
296  (*  (*
297  print "doAssign\n";  print "doAssign\n";
298  *)  *)
299                (*print(concat["About to assign ",IL.Var.toString lhs', "\n"]);*)
300                          recordAssign (joinStk, lhs, lhs');                          recordAssign (joinStk, lhs, lhs');
301                          cvt (                          cvt (
302                            VMap.insert(env, lhs, lhs'),                            VMap.insert(env, lhs, lhs'),
# Line 267  Line 347 
347                        end                        end
348            | S.S_Foreach(x,blk) => let            | S.S_Foreach(x,blk) => let
349                val x' = lookup env x                val x' = lookup env x
                 val join = newJoin (env, 1)  
                       val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, blk)  
350                        val forNode = IL.Node.mkFOREACH{                        val forNode = IL.Node.mkFOREACH{
351                     cond = x',                     cond = x',
352                       phis = [],
353                     stmBranch = IL.Node.dummy                     stmBranch = IL.Node.dummy
354                }                }
355                          val join = newJoinWithNode(env, 2,forNode)
356                 val (cfg0, _) = cvtLoopBlock(forNode,state,(1, join)::joinStk, blk)
357               in               in
358               case commitJoin (joinStk, join)               case commitJoin (joinStk, join)
359                           of (env, SOME joinNd) => (                           of (env, SOME joinND) => (
360                                if IL.CFG.isEmpty cfg0                                if IL.CFG.isEmpty cfg0
361                                  then (                                  then (
362                                        ())                                        ())
363                                  else (                                  else (
364                                    IL.Node.addEdge (forNode,joinNd);                                    IL.Node.setPred (IL.CFG.entry cfg0, joinND);
365                                    IL.Node.setPred (IL.CFG.entry cfg0, forNode);                    IL.Node.setStmBranch(joinND, IL.CFG.entry cfg0);
366                    IL.Node.setStmBranch(forNode, IL.CFG.entry cfg0);                                    IL.Node.addEdge (IL.CFG.exit cfg0, joinND));
                                   IL.Node.addEdge (IL.CFG.exit cfg0, joinNd));  
367                  cvt (                  cvt (
368                                  env,                                  env,
369                          IL.CFG.appendNode(cfg, joinNd),                     IL.CFG.appendNode (cfg, joinND),
370                                  stms))                                  stms))
371    
372    
Legend:
Removed from v.1867  
changed lines
  Added in v.1868
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge