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

SCM Repository

[diderot] Diff of /trunk/src/compiler/IL/ssa-fn.sml
ViewVC logotype

Diff of /trunk/src/compiler/IL/ssa-fn.sml

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

revision 176, Mon Jul 26 19:47:48 2010 UTC revision 192, Mon Aug 2 16:23:42 2010 UTC
# Line 7  Line 7 
7   * graph of blocks.   * graph of blocks.
8   *)   *)
9    
10  signature SSA =  functor SSAFn (Op : OPERATORS) (*: SSA*) =
11    sig    struct
     structure Op : OPERATORS  
12    
13      datatype var = V of {      structure Op = Op
14          name : string,                  (* name *)  
15          id : Stamp.stamp,               (* unique ID *)      datatype stmt = STM of {
16          useCnt : int ref,               (* count of uses *)          id : Stamp.stamp,
17          props : PropList.holder          props : PropList.holder,
18            preds : stmt list ref,
19            phis : (var * var list) list ref,       (* phi statements *)
20            kind : stmt_kind ref
21        }        }
22    
23    (* a statement is a CFG fragment with a single entrypoint and      and stmt_kind
24     * a single continuation.        = BLOCK of {
25     *)              succ : stmt,
26      datatype stmt              body : assign list
27        = BLOCK of stmt            }
       | SEQ of stmt list  
28        | IF of {        | IF of {
           pre : stmt,  
29            cond : var,            cond : var,
30            trueBranch : stmt              thenBranch : stmt,
31            falseBranch : stmt              elseBranch : stmt
32          }          }
33        | WHILE of {        | LOOP of {
34            hdr : block,              hdr : stmt,
35            cond : var,            cond : var,
36            body : stmt              body : stmt,
37                exit : stmt
38          }          }
39          | NEW of {
40      and block = BLK of {              actor : Atom.atom,
41            parent : stmt ref,                    (* parent statement of this block *)              args : var list,
42            id : Stamp.stamp,                     (* unique ID *)              succ : stmt
           preds : block list ref,               (* list of predecessor blocks in the CFG *)  
           phi : (var * var list) list ref,      (* phi statements *)  
           body : simple_stmt list ref,  
           succs : block list ref                (* successor blocks in the CFG *)  
43          }          }
   
     and simple_stmt  
       = ASSIGN of var * rhs  
44        | DIE        | DIE
45        | STABILIZE        | STABILIZE
46        | RETURN        | EXIT
47    
48      and rhs      and rhs
49        = VAR of var        = VAR of var
# Line 57  Line 51 
51        | OP of Op.rator * var list        | OP of Op.rator * var list
52        | CONS of var list                (* tensor-value construction *)        | CONS of var list                (* tensor-value construction *)
53    
54      val newVar : string -> var      and var = V of {
     val newBlock : unit -> block  
   
     val entryBlock : stmt -> block  
     val nextBlock : stmt -> block  
   
   end  
   
 functor SSAFn (Op : OPERATORS) : SSA =  
   struct  
   
     datatype var = V of {  
55          name : string,                  (* name *)          name : string,                  (* name *)
56          id : Stamp.stamp,               (* unique ID *)          id : Stamp.stamp,               (* unique ID *)
57          useCnt : int ref,               (* count of uses *)          useCnt : int ref,               (* count of uses *)
58          props : PropList.holder          props : PropList.holder
59        }        }
60    
61    datatype stmt      withtype assign = (var * rhs)
     = EXIT  
     | SEQ of block * stmt  
     | IF of {  
         pre : stmt,  
         cond : var,  
         trueBranch : stmt,  
         falseBranch : stmt,  
         next : stmt             (* ?? *)  
       }  
     | WHILE of {  
         hdr : stmt,  
         cond : var,  
         body : stmt,  
         exit : stmt             (* ?? *)  
       }  
   
   and block = BLK of {  
         parent : stmt ref,                      (* parent statement of this block *)  
         id : Stamp.stamp,                       (* unique ID *)  
         preds : block list ref,                 (* list of predecessor blocks in the CFG *)  
         phi : (var * var list) list ref,        (* phi statements *)  
         body : simple_stmt list ref,  
         succs : block list ref                  (* successor blocks in the CFG *)  
       }  
   
   and simple_stmt  
     = ASSIGN of var * rhs  
     | DIE  
     | STABILIZE  
     | RETURN  
   
     and rhs  
       = VAR of var  
       | OP of Op.rator * var list  
62    
63    (* block properties *)      fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
64      fun parentOf (BLK{parent, ...}) = !parent      fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
65      fun predsOf (BLK{preds, ...}) = !preds      fun hash (STM{id, ...}) = Stamp.hash id
66      fun succsOf (BLK{succs, ...}) = !succs  
67        fun succs (STM{kind, ...}) = (case !kind
68    (* IL construction code *)             of BLOCK{succ, ...} => [succ]
69      fun newVar name = V{              | IF{thenBranch, elseBranch, ...} => [thenBranch, elseBranch]
70              name = name,              | LOOP{exit, ...} => [exit]
71              id = Stamp.new(),              | NEW{succ, ...} => [succ]
72              useCnt = ref 0,              | _ => []
73              props = PropList.newHolder()            (* end case *))
74            }  
75      (* set the successor of a statement *)
76        fun setSucc (STM{kind, ...}, stm) = (case !kind
77               of BLOCK{succ, body} => kind := BLOCK{succ=stm, body=body}
78                | IF{thenBranch, elseBranch, ...} => (
79                    setSucc(thenBranch, stm);
80                    setSucc(elseBranch, stm))
81                | LOOP{hdr, cond, body, exit} => kind := LOOP{hdr=hdr, cond=cond, body=body, exit=stm}
82                | NEW{actor, args, succ} => kind := NEW{actor=actor, args=args, succ=stm}
83                | _ => () (* no successor *)
84              (* end case *))
85    
86        fun preds (STM{preds, ...}) = !preds
87    
88        fun addPred (STM{preds, ...}, stm) =
89              if not(List.exists (fn b => same(stm, b)) (!preds))
90                then preds := stm :: !preds
91                else ();
92    
93      fun newBlock () = BLK{      fun mkSTM kind = STM{
             parent = ref(SEQ[]),  
94              id = Stamp.new(),              id = Stamp.new(),
95                props = PropList.newHolder(),
96              preds = ref[],              preds = ref[],
97              phi = ref[],              phis = ref [],
98              body = ref[],              kind = ref kind
             succs = ref[]  
99            }            }
100    
101      local      val dummy = mkSTM EXIT
       fun setParent (BKL{parent, ...}, s) = (parent := s)  
     in  
     fun mkBLOCK blk = let  
           val s = BLOCK blk  
           in  
             setParent (blk, s);  
             s  
           end  
   
     fun mkIF (pre, cond, t, f) = let  
           val s = IF{pre=pre, cond=cond, trueBranch=t, falseBranch=f}  
           in  
             setParent (pre, s);  
             s  
           end  
   
     fun mkWHILE (hdr, cond, body) = let  
           val s = WHILE{hdr=hdr, cond=cond, body=body}  
           in  
             setParent (hdr, s);  
             s  
           end  
   
     end (* local *)  
102    
103      fun entryBlock (BLOCK blk) = blk      fun mkBLOCK args = mkSTM(BLOCK args)
104        | entryBlock (SEQ(s1::_)) = entryBlock s1      fun mkIF args = mkSTM(IF args)
105        | entryBlock (IF{pre, ...}) = entryBlock pre      fun mkLOOP args = mkSTM(LOOP args)
106        | entryBlock (WHILE{hdr, ...}) = entryBlock hdr      fun mkDIE () = mkSTM DIE
107        fun mkSTABILIZE () = mkSTM STABILIZE
108      fun nextBlock (SEQ(, next)) = nextBlock next      fun mkEXIT () = mkSTM EXIT
       | nextBlock (SEQ stms) = nextBlock(List.last stms)  
       | nextBlock (IF{pre, ...}) = entryBlock pre  
       | nextBlock (WHILE{hdr, ...}) = entryBlock hdr  
109    
110    end    end

Legend:
Removed from v.176  
changed lines
  Added in v.192

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