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 199, Mon Aug 2 21:34:31 2010 UTC
# Line 9  Line 9 
9    
10  signature SSA =  signature SSA =
11    sig    sig
12    
13      structure Op : OPERATORS      structure Op : OPERATORS
14    
15      datatype var = V of {      datatype program = Program of {
16          name : string,                  (* name *)          globals : var list,
17          id : Stamp.stamp,               (* unique ID *)          globalInit : stmt,
18          useCnt : int ref,               (* count of uses *)          actors : actor list
19          props : PropList.holder          (* initialization *)
20        }        }
21    
22    (* a statement is a CFG fragment with a single entrypoint and      and actor = Actor of {
23     * a single continuation.          name : Atom.atom,
24     *)          params : var list,
25      datatype stmt          state : var list,
26        = BLOCK of stmt          stateInit : stmt,
27        | SEQ of stmt list          methods : method list
28          }
29    
30        and method = Method of Atom.atom * stmt
31    
32        and stmt = STM of {
33            id : Stamp.stamp,
34            props : PropList.holder,
35            preds : stmt list ref,
36            phis : (var * var list) list ref,       (* phi statements *)
37            kind : stmt_kind ref
38          }
39    
40        and stmt_kind
41          = BLOCK of {
42                succ : stmt,
43                body : assign list
44              }
45        | IF of {        | IF of {
           pre : stmt,  
46            cond : var,            cond : var,
47            trueBranch : stmt              thenBranch : stmt,
48            falseBranch : stmt              elseBranch : stmt
49          }          }
50        | WHILE of {        | LOOP of {
51            hdr : block,              hdr : stmt,
52            cond : var,            cond : var,
53            body : stmt              body : stmt,
54                exit : stmt
55          }          }
56          | NEW of {
57      and block = BLK of {              actor : Atom.atom,
58            parent : stmt ref,                    (* parent statement of this block *)              args : var list,
59            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 *)  
60          }          }
   
     and simple_stmt  
       = ASSIGN of var * rhs  
61        | DIE        | DIE
62        | STABILIZE        | STABILIZE
63        | RETURN        | EXIT
64    
65      and rhs      and rhs
66        = VAR of var        = VAR of var
# Line 57  Line 68 
68        | OP of Op.rator * var list        | OP of Op.rator * var list
69        | CONS of var list                (* tensor-value construction *)        | CONS of var list                (* tensor-value construction *)
70    
71      val newVar : string -> var      and var = V of {
72      val newBlock : unit -> block          name : string,                  (* name *)
73            id : Stamp.stamp,               (* unique ID *)
74            useCnt : int ref,               (* count of uses *)
75            props : PropList.holder
76          }
77    
78        withtype assign = (var * rhs)
79    
80      val entryBlock : stmt -> block      val same : stmt * stmt -> bool
81      val nextBlock : stmt -> block      val compare : stmt * stmt -> order
82        val hash : stmt -> word
83    
84        val succs : stmt -> stmt list
85    
86      (* set the successor of a statement *)
87        val setSucc : stmt * stmt -> unit
88    
89        val preds : stmt -> stmt list
90    
91        val addPred : stmt * stmt -> unit
92    
93        val dummy : stmt
94    
95        val mkBLOCK : {succ : stmt, body : assign list} -> stmt
96        val mkIF : {cond : var, thenBranch : stmt, elseBranch : stmt} -> stmt
97        val mkLOOP : {hdr : stmt, cond : var, body : stmt, exit : stmt} -> stmt
98        val mkNEW : {actor : Atom.atom, args : var list, succ : stmt} -> stmt
99        val mkDIE : unit -> stmt
100        val mkSTABILIZE : unit -> stmt
101        val mkEXIT : unit -> stmt
102    
103        structure Var : sig
104            val new : string -> var
105            val same : var * var -> bool
106            val compare : var * var -> order
107            val hash : var -> word
108            val toString : var -> string
109            structure Map : ORD_MAP where type Key.ord_key = var
110            structure Set : ORD_SET where type Key.ord_key = var
111            structure Tbl : MONO_HASH_TABLE where type Key.hash_key = var
112          end
113    
114    end    end
115    
116  functor SSAFn (Op : OPERATORS) : SSA =  functor SSAFn (Op : OPERATORS) : SSA =
117    struct    struct
118    
119      datatype var = V of {      structure Op = Op
120          name : string,                  (* name *)  
121          id : Stamp.stamp,               (* unique ID *)      datatype program = Program of {
122          useCnt : int ref,               (* count of uses *)          globals : var list,
123          props : PropList.holder          globalInit : stmt,
124            actors : actor list
125            (* initialization *)
126          }
127    
128        and actor = Actor of {
129            name : Atom.atom,
130            params : var list,
131            state : var list,
132            stateInit : stmt,
133            methods : method list
134        }        }
135    
136    datatype stmt      and method = Method of Atom.atom * stmt
137      = EXIT  
138      | SEQ of block * stmt      and stmt = STM of {
139            id : Stamp.stamp,
140            props : PropList.holder,
141            preds : stmt list ref,
142            phis : (var * var list) list ref,       (* phi statements *)
143            kind : stmt_kind ref
144          }
145    
146        and stmt_kind
147          = BLOCK of {
148                succ : stmt,
149                body : assign list
150              }
151      | IF of {      | IF of {
         pre : stmt,  
152          cond : var,          cond : var,
153          trueBranch : stmt,              thenBranch : stmt,
154          falseBranch : stmt,              elseBranch : stmt
         next : stmt             (* ?? *)  
155        }        }
156      | WHILE of {        | LOOP of {
157          hdr : stmt,          hdr : stmt,
158          cond : var,          cond : var,
159          body : stmt,          body : stmt,
160          exit : stmt             (* ?? *)              exit : stmt
161        }        }
162          | NEW of {
163    and block = BLK of {              actor : Atom.atom,
164          parent : stmt ref,                      (* parent statement of this block *)              args : var list,
165          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 *)  
166        }        }
   
   and simple_stmt  
     = ASSIGN of var * rhs  
167      | DIE      | DIE
168      | STABILIZE      | STABILIZE
169      | RETURN        | EXIT
170    
171      and rhs      and rhs
172        = VAR of var        = VAR of var
173          | LIT of Literal.literal
174        | OP of Op.rator * var list        | OP of Op.rator * var list
175          | CONS of var list                (* tensor-value construction *)
176    
177    (* block properties *)      and var = V of {
178      fun parentOf (BLK{parent, ...}) = !parent          name : string,                  (* name *)
179      fun predsOf (BLK{preds, ...}) = !preds          id : Stamp.stamp,               (* unique ID *)
180      fun succsOf (BLK{succs, ...}) = !succs          useCnt : int ref,               (* count of uses *)
181            props : PropList.holder
   (* IL construction code *)  
     fun newVar name = V{  
             name = name,  
             id = Stamp.new(),  
             useCnt = ref 0,  
             props = PropList.newHolder()  
182            }            }
183    
184      fun newBlock () = BLK{      withtype assign = (var * rhs)
185              parent = ref(SEQ[]),  
186        fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
187        fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
188        fun hash (STM{id, ...}) = Stamp.hash id
189    
190        fun succs (STM{kind, ...}) = (case !kind
191               of BLOCK{succ, ...} => [succ]
192                | IF{thenBranch, elseBranch, ...} => [thenBranch, elseBranch]
193                | LOOP{exit, ...} => [exit]
194                | NEW{succ, ...} => [succ]
195                | _ => []
196              (* end case *))
197    
198      (* set the successor of a statement *)
199        fun setSucc (STM{kind, ...}, stm) = (case !kind
200               of BLOCK{succ, body} => kind := BLOCK{succ=stm, body=body}
201                | IF{thenBranch, elseBranch, ...} => (
202                    setSucc(thenBranch, stm);
203                    setSucc(elseBranch, stm))
204                | LOOP{hdr, cond, body, exit} => kind := LOOP{hdr=hdr, cond=cond, body=body, exit=stm}
205                | NEW{actor, args, succ} => kind := NEW{actor=actor, args=args, succ=stm}
206                | _ => () (* no successor *)
207              (* end case *))
208    
209        fun preds (STM{preds, ...}) = !preds
210    
211        fun addPred (STM{preds, ...}, stm) =
212              if not(List.exists (fn b => same(stm, b)) (!preds))
213                then preds := stm :: !preds
214                else ();
215    
216        fun mkSTM kind = STM{
217              id = Stamp.new(),              id = Stamp.new(),
218                props = PropList.newHolder(),
219              preds = ref[],              preds = ref[],
220              phi = ref[],              phis = ref [],
221              body = ref[],              kind = ref kind
             succs = ref[]  
222            }            }
223    
224        val dummy = mkSTM EXIT
225    
226        fun mkBLOCK args = mkSTM(BLOCK args)
227        fun mkIF args = mkSTM(IF args)
228        fun mkLOOP args = mkSTM(LOOP args)
229        fun mkNEW args = mkSTM(NEW args)
230        fun mkDIE () = mkSTM DIE
231        fun mkSTABILIZE () = mkSTM STABILIZE
232        fun mkEXIT () = mkSTM EXIT
233    
234        structure Var =
235          struct
236            fun new name = V{
237                    name = name,
238                    id = Stamp.new(),
239                    useCnt = ref 0,
240                    props = PropList.newHolder()
241                  }
242            fun same (V{id=a, ...}, V{id=b, ...}) = Stamp.same(a, b)
243            fun compare (V{id=a, ...}, V{id=b, ...}) = Stamp.compare(a, b)
244            fun hash (V{id, ...}) = Stamp.hash id
245            fun toString (V{name, id, ...}) = name ^ Stamp.toString id
246      local      local
247        fun setParent (BKL{parent, ...}, s) = (parent := s)            structure V =
248      in              struct
249      fun mkBLOCK blk = let                type ord_key = var
250            val s = BLOCK blk                val compare = compare
           in  
             setParent (blk, s);  
             s  
251            end            end
   
     fun mkIF (pre, cond, t, f) = let  
           val s = IF{pre=pre, cond=cond, trueBranch=t, falseBranch=f}  
252            in            in
253              setParent (pre, s);          structure Map = RedBlackMapFn (V)
254              s          structure Set = RedBlackSetFn (V)
255            end            end
256            structure Tbl = HashTableFn (
257      fun mkWHILE (hdr, cond, body) = let            struct
258            val s = WHILE{hdr=hdr, cond=cond, body=body}              type hash_key = var
259            in              val hashVal = hash
260              setParent (hdr, s);              val sameKey = same
261              s            end)
262            end            end
263    
     end (* local *)  
   
     fun entryBlock (BLOCK blk) = blk  
       | entryBlock (SEQ(s1::_)) = entryBlock s1  
       | entryBlock (IF{pre, ...}) = entryBlock pre  
       | entryBlock (WHILE{hdr, ...}) = entryBlock hdr  
   
     fun nextBlock (SEQ(, next)) = nextBlock next  
       | nextBlock (SEQ stms) = nextBlock(List.last stms)  
       | nextBlock (IF{pre, ...}) = entryBlock pre  
       | nextBlock (WHILE{hdr, ...}) = entryBlock hdr  
   
264    end    end

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

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