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

SCM Repository

[diderot] Diff of /branches/charisee/src/compiler/tree-il/low-to-tree-fn.sml
ViewVC logotype

Diff of /branches/charisee/src/compiler/tree-il/low-to-tree-fn.sml

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

trunk/src/compiler/tree-il/low-to-tree-fn.sml revision 1301, Thu Jun 9 23:58:40 2011 UTC branches/charisee/src/compiler/tree-il/low-to-tree-fn.sml revision 2631, Fri May 23 18:13:12 2014 UTC
# Line 11  Line 11 
11    
12  functor LowToTreeFn (Target : sig  functor LowToTreeFn (Target : sig
13    
14        val supportsPrinting : unit -> bool (* does the target support the Print op? *)
15    
16    (* tests for whether various expression forms can appear inline *)    (* tests for whether various expression forms can appear inline *)
17      val inlineCons : int -> bool        (* can n'th-order tensor construction appear inline *)      val inlineCons : int -> bool        (* can n'th-order tensor construction appear inline *)
18      val inlineMatrixExp : bool          (* can matrix-valued expressions appear inline? *)      val inlineMatrixExp : bool          (* can matrix-valued expressions appear inline? *)
19        val isHwVec :  int -> bool
20        val isVecTy :  int -> bool
21     val getPieces :   int -> int list
22    
23    end) : sig    end) : sig
24    
# Line 24  Line 29 
29      structure IL = LowIL      structure IL = LowIL
30      structure Ty = LowILTypes      structure Ty = LowILTypes
31      structure V = LowIL.Var      structure V = LowIL.Var
32        structure StV = LowIL.StateVar
33      structure Op = LowOps      structure Op = LowOps
34      structure Nd = LowIL.Node      structure Nd = LowIL.Node
35      structure CFG = LowIL.CFG      structure CFG = LowIL.CFG
36      structure T = TreeIL      structure T = TreeIL
37      structure VA = VarAnalysis      structure VA = VarAnalysis
38        structure ExpOp=ExpOp
39        structure OpT = TreeOps
40        structure SrcOp = LowOps
41        structure DstOp = TreeOps
42    
43            structure gT=getTypes
44            structure TreetoCFN=TreetoCFN
45    (* create new tree IL variables *)    (* create new tree IL variables *)
46      local      local
47        fun newVar (name, kind, ty) = T.V{        val newVar = T.Var.new
               name = name,  
               id = Stamp.new(),  
               kind = kind,  
               ty = ty  
             }  
48        val cnt = ref 0        val cnt = ref 0
49        fun genName prefix = let        fun genName prefix = let
50              val n = !cnt              val n = !cnt
# Line 46  Line 53 
53                String.concat[prefix, "_", Int.toString n]                String.concat[prefix, "_", Int.toString n]
54              end              end
55      in      in
56      fun newGlobal x = newVar ("G_" ^ V.name x, T.VK_Global, V.ty x)      val testing=1
57      fun newStateVar (strand, x) =      fun pntTest str=(case testing
58            newVar (concat[Atom.toString strand, "_", V.name x], T.VK_State strand, V.ty x)          of 1=> (print(str);1)
59            | _ =>1
60        (*end case*))
61    
62    
63        fun newGlobal x=newVar (genName("G_" ^ V.name x), T.VK_Global, V.ty x)
64      fun newParam x = newVar (genName("p_" ^ V.name x), T.VK_Local, V.ty x)      fun newParam x = newVar (genName("p_" ^ V.name x), T.VK_Local, V.ty x)
65      fun newLocal x = newVar (genName("l_" ^ V.name x), T.VK_Local, V.ty x)      fun newLocal x = newVar (genName("l_" ^ V.name x), T.VK_Local, V.ty x)
66      fun newIter x = newVar (genName("i_" ^ V.name x), T.VK_Local, V.ty x)      fun newIter x = newVar (genName("i_" ^ V.name x), T.VK_Local, V.ty x)
67      end      end
68    
69      (* associate Tree IL state variables with Low IL variables using properties *)
70        local
71          fun mkStateVar x = T.SV{
72                  name = StV.name x,
73                  id = Stamp.new(),
74                  ty = StV.ty x,
75                  varying = VA.isVarying x,
76                  output = StV.isOutput x
77                }
78        in
79        val {getFn = getStateVar, ...} = StV.newProp mkStateVar
80        end
81    
82      fun mkBlock stms = T.Block{locals=[], body=stms}      fun mkBlock stms = T.Block{locals=[], body=stms}
83      fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)      fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)
84        | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)        | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)
# Line 138  Line 163 
163            else let            else let
164              val t = newLocal lhs              val t = newLocal lhs
165              in              in
166                (rename(addLocal(env, t), lhs, t), [T.S_Assign(t, rhs)])                (rename(addLocal(env, t), lhs, t), [T.S_Assign([t], rhs)])
167              end              end
168    
169      fun bind (env, lhs, rhs) = (case peekGlobal (env, lhs)      fun bind (env, lhs, rhs) = (case peekGlobal (env, lhs)
170             of SOME x => (env, [T.S_Assign(x, rhs)])             of SOME x => (env, [T.S_Assign([x], rhs)])
171              | NONE => bindLocal (env, lhs, rhs)              | NONE => bindLocal (env, lhs, rhs)
172            (* end case *))            (* end case *))
173    
174    (* set the definition of a variable, where the RHS is either a literal constant or a variable *)    (* set the definition of a variable, where the RHS is either a literal constant or a variable *)
175      fun bindSimple (env as E{tbl, ...}, lhs, rhs) = (      fun bindSimple (env as E{tbl, ...}, lhs, rhs) = (
176            case peekGlobal (env, lhs)            case peekGlobal (env, lhs)
177             of SOME x => (env, [T.S_Assign(x, rhs)])             of SOME x => (env, [T.S_Assign([x], rhs)])
178              | NONE => (VT.insert tbl (lhs, DEF rhs); (env, []))              | NONE => (VT.insert tbl (lhs, DEF rhs); (env, []))
179            (* end case *))            (* end case *))
180    
# Line 161  Line 186 
186                  val t = newLocal x                  val t = newLocal x
187                  in                  in
188                    VT.insert tbl (x, DEF(T.E_Var t));                    VT.insert tbl (x, DEF(T.E_Var t));
189                    (t::locals, T.S_Assign(t, e)::stms)                    (t::locals, T.S_Assign([t], e)::stms)
190                  end                  end
191              | doVar (_, _, acc) = acc              | doVar (_, _, acc) = acc
192            val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl            val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl
# Line 173  Line 198 
198          (* t will be the variable in the continuation of the JOIN *)          (* t will be the variable in the continuation of the JOIN *)
199            val t = newLocal lhs            val t = newLocal lhs
200            val predBlks = ListPair.map            val predBlks = ListPair.map
201                  (fn (x, stms) => T.S_Assign(t, useVar env x)::stms)                  (fn (x, stms) => T.S_Assign([t], useVar env x)::stms)
202                    (rhs, predBlks)                    (rhs, predBlks)
203            in            in
204              (rename (addLocal(env, t), lhs, t), predBlks)              (rename (addLocal(env, t), lhs, t), predBlks)
# Line 192  Line 217 
217      fun isInlineOp rator = let      fun isInlineOp rator = let
218            fun chkTensorTy (Ty.TensorTy[]) = true            fun chkTensorTy (Ty.TensorTy[]) = true
219              | chkTensorTy (Ty.TensorTy[_]) = true              | chkTensorTy (Ty.TensorTy[_]) = true
220              | chkTensorTy (Ty.TensorTy _) = Target.inlineMatrixExp              | chkTensorTy (Ty.TensorTy[_, _]) = Target.inlineMatrixExp
221              | chkTensorTy _ = true              | chkTensorTy _ = false
222            in            in
223             case rator             case rator
224               of Op.LoadVoxels(_, 1) => true               of Op.LoadVoxels(_, 1) => true
225                | Op.LoadVoxels _ => false                | Op.LoadVoxels _ => false
226                | Op.Add ty => chkTensorTy ty  
227                | Op.Sub ty => chkTensorTy ty                    (*not removed add, sub, neg, scal, mul*)
228                | Op.Neg ty => chkTensorTy ty  
229                | Op.Scale ty => chkTensorTy ty                | Op.EigenVecs2x2 => false
230                | Op.MulMatMat _ => Target.inlineMatrixExp                | Op.EigenVecs3x3 => false
231                | Op.Identity _ => Target.inlineMatrixExp                | Op.EigenVals2x2 => false
232                | Op.Zero _ => Target.inlineMatrixExp                | Op.EigenVals3x3 => false
233                | Op.TensorToWorldSpace(_, ty) => chkTensorTy ty  
234    (*              | Op.Zero _ => Target.inlineMatrixExp*)
235    
236                | _ => true                | _ => true
237              (* end case *)              (* end case *)
238            end            end
239    
240    (* translate a LowIL assignment to a list of zero or more target statements *)    (* is a CONS inline? *)
241        fun isInlineCons ty = (case ty
242               of Ty.SeqTy(Ty.IntTy, _) => true
243                | Ty.TensorTy dd => Target.inlineCons(List.length dd)
244                | Ty.SeqTy _ => false
245       (*CCCC-? DO we have this type*)
246               (* | Ty.DynSeqTy ty => false*)
247                | _ => raise Fail(concat["invalid CONS<", Ty.toString ty, ">"])
248              (* end case *))
249    
250      (* translate a LowIL assignment to a list of zero or more target statements in reverse
251       * order.
252       *)
253      fun doAssign (env, (lhs, rhs)) = let      fun doAssign (env, (lhs, rhs)) = let
254            fun doLHS () = (case peekGlobal(env, lhs)            fun doLHS () = (case peekGlobal(env, lhs)
255                   of SOME lhs' => (env, lhs')                   of SOME lhs' => (env, lhs')
# Line 225  Line 264 
264                (* operations that return matrices may not be supported inline *)                (* operations that return matrices may not be supported inline *)
265                  val (env, t) = doLHS()                  val (env, t) = doLHS()
266                  in                  in
267                    (env, [T.S_Assign(t, exp)])                    (env, [T.S_Assign([t], exp)])
268                  end                  end
269    
270    
271              val isHwVec=Target.isHwVec
272              val getPieces= Target.getPieces
273              val isVecTy= Target.isVecTy
274    
275            (*foundVec: Found low-IL vector*)
276             fun foundVec(lhs,rator,n,argsS, argsV,nextfn)= let
277    
278                (*Looks for next largest length supported*)
279                fun fillVec vn =(case (isVecTy vn)
280                    of true => (vn,[vn])
281                    | false => fillVec(vn+1))
282                val (newSize,Pieces)= (case (isVecTy n)
283                    of true=> (n,[n])
284                    | false=>(case isHwVec n
285                        of false=> (n,(getPieces n))
286                        | true=> fillVec (n+1)
287                        (*end case*))
288                    (*end case*))
289                val _=(case testing
290                    of 1=>(print(String.concat["\n ***********\n ",DstOp.toString(rator n) ,"\n \t =>"]);1)
291                    | _=>1)
292                in
293                    nextfn(lhs,rator,newSize,n,Pieces,argsS,argsV)
294                end
295    
296    
297            (* force an argument to be stored in something that will be mapped to an l-value *)
298              fun bindVar (env, x) = (case useVar env x
299                     of x' as T.E_State _ => (env, x', [])
300                      | x' as T.E_Var _ => (env, x', [])
301                      | e => let
302                          val x' = newLocal x
303                          in
304                            (addLocal(env, x'), T.E_Var x', [T.S_Assign([x'], e)])
305                          end
306                    (* end case *))
307    
308            in            in
309              case rhs              case rhs
310               of IL.VAR x => bindSimple (env, lhs, useVar env x)               of IL.STATE x => bindSimple (env, lhs, T.E_State(getStateVar x))
311                  | IL.VAR x => bindSimple (env, lhs, useVar env x)
312                | IL.LIT lit => bindSimple (env, lhs, T.E_Lit lit)                | IL.LIT lit => bindSimple (env, lhs, T.E_Lit lit)
313                | IL.OP(Op.LoadImage info, [a]) => let  
314                    (*| IL.OP(Op.Prepend ty, [item, seq]) => let
315                    val (env, t) = doLHS()                    val (env, t) = doLHS()
316                      val (env, item', stms) = bindVar (env, item)
317                      val exp = T.E_Op(Op.Prepend ty, [item', useVar env seq])
318                    in                    in
319                      (env, [T.S_LoadImage(t, ImageInfo.dim info, useVar env a)])                      (env, T.S_Assign([t], exp) :: stms)
320                    end                    end
321                | IL.OP(Op.Input(ty, name, desc), []) => let                | IL.OP(Op.Append ty, [seq, item]) => let
322                    val (env, t) = doLHS()                    val (env, t) = doLHS()
323                      val (env, item', stms) = bindVar (env, item)
324                      val exp = T.E_Op(Op.Append ty, [useVar env seq, item'])
325                    in                    in
326                      (env, [T.S_Input(t, name, desc, NONE)])                      (env, T.S_Assign([t], exp) :: stms)
327                    end                    end*)
328                | IL.OP(Op.InputWithDefault(ty, name, desc), [a]) => let             (*
329                  | IL.OP(Op.LoadImage(ty, nrrd, info), []) => let
330                    val (env, t) = doLHS()                    val (env, t) = doLHS()
331                    in                    in
332                      (env, [T.S_Input(t, name, desc, SOME(useVar env a))])                      (env, [T.S_LoadNrrd(t, ty, nrrd)])
333                    end                    end*)
334                | IL.OP(rator, args) => let                | IL.OP(rator, args) => let
335                    val exp = T.E_Op(rator, List.map (useVar env) args)                      (*Target.isHwVec*)
336                    val args'=List.map (useVar env) args
337                    val (env, t) = doLHS()
338                    in (case rator
339                         of SrcOp.addVec n   => (env, foundVec(t,DstOp.addVec,n,[],args',ExpOp.creatLd))
340                         | SrcOp.subVec n    => (env, foundVec(t,DstOp.subVec,n,[],args',ExpOp.creatLd))
341                         | SrcOp.prodScaV n  => (env, foundVec(t,DstOp.prodScaV ,n, [hd(args')], tl(args'),ExpOp.creatLd))
342                         | SrcOp.prodVec n   => (env, foundVec(t,DstOp.prodVec,n,[],args',ExpOp.creatLd))
343                         | SrcOp.sumVec n    => (env, foundVec(t,DstOp.sumVec ,n,[],args',ExpOp.creatLd))
344                         | SrcOp.C c         => (env,[T.S_Assign([t],T.E_Lit(Literal.Int 0))])
345                         | _ => let
346                            val Trator = ExpOp.expandOp rator
347                            val exp = T.E_Op(Trator,  args')
348                    in                    in
349                      if isInlineOp rator                              if isInlineOp rator then bind (env, lhs, exp)
                       then bind (env, lhs, exp)  
350                        else assignExp (env, exp)                        else assignExp (env, exp)
351                    end                    end
352                        (*end case*))
353                     end
354    
355                | IL.APPLY(f, args) =>                | IL.APPLY(f, args) =>
356                    bind (env, lhs, T.E_Apply(f, List.map (useVar env) args))                    bind (env, lhs, T.E_Apply(f, List.map (useVar env) args))
357                | IL.CONS(ty, args) => let                | IL.CONS(ty, args) => let
                   val inline = (case ty  
                          of Ty.IVecTy _ => true  
                           | Ty.TensorTy dd => Target.inlineCons(List.length dd)  
                         (* end case *))  
358                    val exp = T.E_Cons(ty, List.map (useVar env) args)                    val exp = T.E_Cons(ty, List.map (useVar env) args)
359                    in                    in
360                      if inline                      if isInlineCons ty
361                        then bind (env, lhs, exp)                        then bind (env, lhs, exp)
362                        else assignExp (env, exp)                        else assignExp (env, exp)
363                    end                    end
364                 | IL.EINAPP _=> raise Fail "EINAPP in Low-IL to Tree-IL"
365              (* end case *)              (* end case *)
366            end            end
367    
# Line 284  Line 380 
380       *)       *)
381        | ELSE_BR of T.stm list * T.exp * T.stm list * IL.node_kind        | ELSE_BR of T.stm list * T.exp * T.stm list * IL.node_kind
382    
383    
384    
385      fun trCFG (env, prefix, finish, cfg) = let      fun trCFG (env, prefix, finish, cfg) = let
386             val typesAll=ref []
387             val namesAll=ref []
388            fun join (env, [], _, IL.JOIN _) = raise Fail "JOIN with no open if"            fun join (env, [], _, IL.JOIN _) = raise Fail "JOIN with no open if"
389              | join (env, [], stms, _) = endScope (env, prefix @ List.rev stms)              | join (env, [], stms, _) = endScope (env, prefix @ List.rev stms)
390              | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let              | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let
# Line 333  Line 433 
433                        doNode (env, ifStk, T.S_Comment text :: stms, !succ)                        doNode (env, ifStk, T.S_Comment text :: stms, !succ)
434                    | IL.ASSIGN{stm, succ, ...} => let                    | IL.ASSIGN{stm, succ, ...} => let
435                        val (env, stms') = doAssign (env, stm)                        val (env, stms') = doAssign (env, stm)
436                            (*Printing out types*)
437                            val types=(case testing
438                                    of 1 =>(List.map gT.getTypesFilteredPnt stms')
439                                    | _ =>(List.map gT.getTypesFiltered stms'))
440                            val _=typesAll:=(!typesAll@(gT.flat types))
441                            val names=(case testing
442                                    of 1 =>(List.map fnNames.ExptoCStringPnt stms')
443                                    |_  => (List.map fnNames.ExptoCString stms'))
444                            val _=namesAll:=(!namesAll@(gT.flat names))
445    
446                            val _=List.map TreetoCFN.ExptoCfnPnt stms'
447                        in                        in
448                          doNode (env, ifStk, stms' @ stms, !succ)                          doNode (env, ifStk, stms' @ stms, !succ)
449                        end                        end
450                      | IL.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
451                          fun doit () = let
452                                fun doLHSVar (y, (env, ys)) = (case peekGlobal(env, y)
453                                       of SOME y' => (env, y'::ys)
454                                        | NONE => let
455                                            val t = newLocal y
456                                            in
457                                              (rename (addLocal(env, t), y, t), t::ys)
458                                            end
459                                      (* end case *))
460                                val (env, ys) = List.foldr doLHSVar (env, []) ys
461                                 val Trator =  ExpOp.expandOp rator
462                                val exp = T.E_Op(Trator, List.map (useVar env) xs)
463                                val stm = T.S_Assign(ys, exp)
464                                in
465                                  doNode (env, ifStk, stm :: stms, !succ)
466                                end
467                          in
468                            case rator
469                             of Op.Print _ => if Target.supportsPrinting()
470                                  then doit ()
471                                  else doNode (env, ifStk, stms, !succ)
472                              | _ => doit()
473                            (* end case *)
474                          end
475                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
476                      | IL.SAVE{lhs, rhs, succ, ...} => let
477                          val stm = T.S_Save([getStateVar lhs], useVar env rhs)
478                          in
479                            doNode (env, ifStk, stm::stms, !succ)
480                          end
481                    | k as IL.EXIT{kind, live, ...} => (case kind                    | k as IL.EXIT{kind, live, ...} => (case kind
482                         of ExitKind.FRAGMENT =>                         of ExitKind.FRAGMENT =>
483                              endScope (env, prefix @ List.revAppend(stms, finish env))                              endScope (env, prefix @ List.revAppend(stms, finish env))
484                          | ExitKind.SINIT => let                          | ExitKind.SINIT => let
485  (* FIXME: we should probably call flushPending here! *)  (* FIXME: we should probably call flushPending here! *)
486                              val suffix = finish env @ [T.S_Exit(List.map (useVar env) live)]                              val suffix = finish env @ [T.S_Exit[]]
487                              in                              in
488                                endScope (env, prefix @ List.revAppend(stms, suffix))                                endScope (env, prefix @ List.revAppend(stms, suffix))
489                              end                              end
# Line 354  Line 495 
495                              end                              end
496                          | ExitKind.ACTIVE => let                          | ExitKind.ACTIVE => let
497  (* FIXME: we should probably call flushPending here! *)  (* FIXME: we should probably call flushPending here! *)
498                              val suffix = finish env @ [T.S_Active(List.map (useVar env) live)]                              val suffix = finish env @ [T.S_Active]
499                              in                              in
500                                endScope (env, prefix @ List.revAppend(stms, suffix))                                endScope (env, prefix @ List.revAppend(stms, suffix))
501                              end                              end
502                          | ExitKind.STABILIZE => let                          | ExitKind.STABILIZE => let
503  (* FIXME: we should probably call flushPending here! *)  (* FIXME: we should probably call flushPending here! *)
504                              val stms = T.S_Stabilize(List.map (useVar env) live) :: stms                              val stms = T.S_Stabilize :: stms
505                              in                              in
506  (* FIXME: we should probably call flushPending here! *)  (* FIXME: we should probably call flushPending here! *)
507                                join (env, ifStk, stms, k)                                join (env, ifStk, stms, k)
# Line 368  Line 509 
509                          | ExitKind.DIE => join (env, ifStk, T.S_Die :: stms, k)                          | ExitKind.DIE => join (env, ifStk, T.S_Die :: stms, k)
510                        (* end case *))                        (* end case *))
511                  (* end case *))                  (* end case *))
512            in  
513              doNode (env, [], [], CFG.entry cfg)            val Y=doNode (env, [], [], CFG.entry cfg)
514              val _=gT.gotFiltered(!typesAll)
515              val _=fnNames.gotFiltered(!namesAll)
516              in Y
517            end            end
518    
519      fun trInitially (env, IL.Initially{isArray, rangeInit, iters, create=(createInit, strand, args)}) =      fun trInitially (env, IL.Initially{isArray, rangeInit, iters, create=(createInit, strand, args)}) =
# Line 392  Line 536 
536              args = List.map (useVar env) args              args = List.map (useVar env) args
537            } end            } end
538    
539      fun trMethod (env, stateVars) (IL.Method{name, stateIn, body}) = let      fun trMethod env (IL.Method{name, body}) = T.Method{
540            fun bindStateVar (x, T.SV{var, ...}, (env, stms)) = let              name = name,
541                  val (env, stms') = bindLocal(env, x, T.E_Var var)              body = trCFG (env, [], fn _ => [], body)
542                  in            }
                   (env, stms' @ stms)  
                 end  
           val (env, stms) = ListPair.foldrEq bindStateVar (env, []) (stateIn, stateVars)  
           in  
             T.Method{name = name, body = trCFG (env, stms, fn _ => [], body)}  
           end  
543    
544      fun trStrand env (IL.Strand{name, params, state, stateInit, methods}) = let      fun trStrand globalEnv (IL.Strand{name, params, state, stateInit, methods}) = let
545            val params' = List.map newParam params            val params' = List.map newParam params
546            val env = ListPair.foldlEq (fn (x, x', env) => rename(env, x, x')) env (params, params')            val env = ListPair.foldlEq (fn (x, x', env) => rename(env, x, x')) globalEnv (params, params')
           val stateVars = let  
                 fun cvtVar (isOut, x) = T.SV{  
                         varying = (case VA.varScope x  
                            of VA.StrandConstState => false  
                             | VA.StrandState => true  
                             | s => raise Fail(concat[  
                                   "state variable ", IL.Var.toString x,  
                                   " has bogus scope annotation ", VA.scopeToString s  
                                 ])  
                           (* end case *)),  
                         output = isOut, var = newStateVar(name, x)  
                       }  
                 in  
                   List.map cvtVar state  
                 end  
547            in            in
548              T.Strand{              T.Strand{
549                  name = name,                  name = name,
550                  params = params',                  params = params',
551                  state = stateVars,                  state = List.map getStateVar state,
552                  stateInit = trCFG (env, [], fn _ => [], stateInit),                  stateInit = trCFG (env, [], fn _ => [], stateInit),
553                  methods = List.map (trMethod(env, stateVars)) methods                  methods = List.map (trMethod env) methods
554                }                }
555            end            end
556    
     fun checkProps strands = let  
           val hasDie = ref false  
           val hasNew = ref false  
           fun chkStm e = (case e  
                  of T.S_IfThen(_, b) => chkBlk b  
                   | T.S_IfThenElse(_, b1, b2) => (chkBlk b1; chkBlk b2)  
                   | T.S_New _ => (hasNew := true)  
                   | T.S_Die => (hasDie := true)  
                   | _ => ()  
               (* end case *))  
           and chkBlk (T.Block{body, ...}) = List.app chkStm body  
           fun chkStrand (T.Strand{stateInit, methods, ...}) = let  
                 fun chkMeth (T.Method{body, ...}) = chkBlk body  
                 in  
                   chkBlk stateInit;  
                   List.app chkMeth methods  
                 end  
           fun condCons (x, v, l) = if !x then v::l else l  
           in  
             List.app chkStrand strands;  
             condCons (hasDie, T.StrandsMayDie,  
             condCons (hasNew, T.NewStrands, []))  
           end  
   
557    (* split the globalInit into the part that specifies the inputs and the rest of    (* split the globalInit into the part that specifies the inputs and the rest of
558     * the global initialization.     * the global initialization.
559     *)     *)
560      fun splitGlobalInit globalInit = let      fun splitGlobalInit globalInit = let
561    (* FIXME: can split as soon as we see a non-Input statement! *)
562            fun walk (nd, lastInput, live) = (case Nd.kind nd            fun walk (nd, lastInput, live) = (case Nd.kind nd
563                   of IL.ENTRY{succ} => walk (!succ, lastInput, live)                   of IL.ENTRY{succ} => walk (!succ, lastInput, live)
564                    | IL.COM{succ, ...} => walk (!succ, lastInput, live)                    | IL.COM{succ, ...} => walk (!succ, lastInput, live)
565                    | IL.ASSIGN{stm=(lhs, rhs), succ, ...} => (case rhs                    | IL.ASSIGN{stm=(lhs, rhs), succ, ...} => (case rhs
566                         of IL.OP(Op.Input _, _) => walk (!succ, nd, lhs::live)                         of IL.OP(Op.Input _, _) => walk (!succ, nd, lhs::live)
                         | IL.OP(Op.InputWithDefault _, _) => walk (!succ, nd, lhs::live)  
567                          | _ => walk (!succ, lastInput, live)                          | _ => walk (!succ, lastInput, live)
568                        (* end case *))                        (* end case *))
569                    | _ => if Nd.isNULL lastInput                    | _ => if Nd.isNULL lastInput
# Line 494  Line 593 
593    
594      fun translate prog = let      fun translate prog = let
595          (* first we do a variable analysis pass on the Low IL *)          (* first we do a variable analysis pass on the Low IL *)
596            val prog as IL.Program{globalInit, initially, strands} = VA.optimize prog            val prog as IL.Program{props, globalInit, initially, strands} = VA.optimize prog
597  (* FIXME: here we should do a contraction pass to eliminate unused variables that VA may have created *)  (* FIXME: here we should do a contraction pass to eliminate unused variables that VA may have created *)
598            val _ = (* DEBUG *)            val _ = (* DEBUG *)
599                  LowPP.output (Log.logFile(), "LowIL after variable analysis", prog)                  LowPP.output (Log.logFile(), "LowIL after variable analysis", prog)
# Line 504  Line 603 
603                    (IL.CFG.liveAtExit globalInit)                    (IL.CFG.liveAtExit globalInit)
604            val {inputInit, globalInit} = splitGlobalInit globalInit            val {inputInit, globalInit} = splitGlobalInit globalInit
605            val strands = List.map (trStrand env) strands            val strands = List.map (trStrand env) strands
606            in  
607              val HH=
608              T.Program{              T.Program{
609                  props = checkProps strands,                  props = props,
610                  globals = globals,                  globals = globals,
611                  inputInit = trCFG (env, [], fn _ => [], inputInit),                  inputInit = trCFG (env, [], fn _ => [], inputInit),
612                  globalInit = trCFG (env, [], fn _ => [], globalInit),                  globalInit = trCFG (env, [], fn _ => [], globalInit),
613                  strands = strands,                  strands = strands,
614                  initially = trInitially (env, initially)                  initially = trInitially (env, initially)
615                }                }
616                    in (print "\n \t ---------------- Target Code --------------\n";HH)
617            end            end
618    
619    end    end

Legend:
Removed from v.1301  
changed lines
  Added in v.2631

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