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

SCM Repository

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

Diff of /branches/lamont_dev/src/compiler/IL/ssa-fn.sml

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

revision 255, Sun Aug 8 14:55:53 2010 UTC revision 256, Mon Aug 9 17:28:57 2010 UTC
# Line 12  Line 12 
12    
13      structure Op : OPERATORS      structure Op : OPERATORS
14    
15      datatype program = Program of {    (***** CFG *****)
16          globals : var list,  
17          globalInit : stmt,      datatype node = ND of {
18          actors : actor list          id : Stamp.stamp,
19          (* initialization *)          props : PropList.holder,
20            kind : node_kind
21        }        }
22    
23      and actor = Actor of {      and node_kind
24          name : Atom.atom,        = NULL
25          params : var list,        | ENTRY of {
26          state : var list,              succ : node ref
27          stateInit : stmt,            }
28          methods : method list        | JOIN of {
29                preds : node list ref,
30                phis : (var * var list) list ref,   (* phi statements *)
31                succ : node ref
32              }
33          | COND of {
34                pred : node ref,
35                cond : var,
36                trueBranch : node ref,
37                falseBranch : node ref
38              }
39          | BLOCK of {
40                pred : node ref,
41                body : assign list ref,
42                succ : node ref
43              }
44          | NEW of {
45                pred : node ref,
46                actor : Atom.atom,
47                args : var list,
48                succ : node ref
49              }
50          | DIE of {
51                pred : node ref
52              }
53          | STABILIZE of {
54                pred : node ref
55              }
56          | EXIT of {
57                pred : node ref
58        }        }
59    
60      and method = Method of Atom.atom * stmt    (***** Statements *****)
61    
62      and stmt = STM of {      and stmt = STM of {
63          id : Stamp.stamp,          id : Stamp.stamp,
64          props : PropList.holder,          props : PropList.holder,
65          preds : stmt list ref,          kind : stmt_kind,
66          phis : (var * var list) list ref,       (* phi statements *)          next : stmt option              (* next statement at this structural level *)
         kind : stmt_kind ref  
67        }        }
68    
69      and stmt_kind      and stmt_kind
70        = BLOCK of {        = S_SIMPLE of node                (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
71              succ : stmt,        | S_IF of {
72              body : assign list              cond : node,                (* COND node *)
           }  
       | IF of {  
             cond : var,  
73              thenBranch : stmt,              thenBranch : stmt,
74              elseBranch : stmt              elseBranch : stmt
75            }            }
76        | LOOP of {        | S_LOOP of {
77              hdr : stmt,              hdr : stmt,
78              cond : var,              cond : node,                (* COND node *)
79              body : stmt,              body : stmt
             exit : stmt  
           }  
       | NEW of {  
             actor : Atom.atom,  
             args : var list,  
             succ : stmt  
80            }            }
       | DIE  
       | STABILIZE  
       | EXIT  
81    
82      and rhs      and rhs
83        = VAR of var        = VAR of var
# Line 77  Line 94 
94    
95      withtype assign = (var * rhs)      withtype assign = (var * rhs)
96    
97      val same : stmt * stmt -> bool      datatype program = Program of {
98      val compare : stmt * stmt -> order          globals : var list,
99      val hash : stmt -> word          globalInit : stmt,
100            actors : actor list
101      val succs : stmt -> stmt list          (* initialization *)
102          }
   (* set the successor of a statement *)  
     val setSucc : stmt * stmt -> unit  
   
     val preds : stmt -> stmt list  
103    
104      val addPred : stmt * stmt -> unit      and actor = Actor of {
105            name : Atom.atom,
106            params : var list,
107            state : var list,
108            stateInit : stmt,
109            methods : method list
110          }
111    
112      val dummy : stmt      and method = Method of {
113            name : Atom.atom,
114            stateIn : var list,     (* names of state variables on method entry *)
115            stateOut : var list,    (* names of state variables on method exit *)
116            body : stmt             (* method body *)
117          }
118    
119        structure Node : sig
120            val same : node * node -> bool
121            val compare : node * node -> order
122            val hash : node -> word
123            val toString : node -> string
124            val preds : node -> node list
125            val setPred : node * node -> unit
126            val hasSucc : node -> bool
127            val succs : node -> node list
128            val setSucc : node * node -> unit
129            val setTrueBranch : node * node -> unit  (* set trueBranch successor for COND node *)
130            val setFalseBranch : node * node -> unit (* set falseBranch successor for COND node *)
131            val addEdge : node * node -> unit
132          end
133    
134      val mkBLOCK : {succ : stmt, body : assign list} -> stmt      structure Stmt : sig
135      val mkIF : {cond : var, thenBranch : stmt, elseBranch : stmt} -> stmt          val same : stmt * stmt -> bool
136      val mkLOOP : {hdr : stmt, cond : var, body : stmt, exit : stmt} -> stmt          val compare : stmt * stmt -> order
137      val mkNEW : {actor : Atom.atom, args : var list, succ : stmt} -> stmt          val hash : stmt -> word
138            val toString : stmt -> string
139          (* return the entry node of the statement *)
140            val entry : stmt -> node
141          (* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
142            val tail : stmt -> node
143          (* statement constructor functions *)
144            val mkENTRY : stmt option -> stmt
145            val mkJOIN : (var * var list) list * stmt option -> stmt
146            val mkIF : var * stmt * stmt * stmt option -> stmt
147            val mkBLOCK : assign list * stmt option -> stmt
148            val mkNEW : Atom.atom * var list * stmt option -> stmt
149      val mkDIE : unit -> stmt      val mkDIE : unit -> stmt
150      val mkSTABILIZE : unit -> stmt      val mkSTABILIZE : unit -> stmt
151      val mkEXIT : unit -> stmt      val mkEXIT : unit -> stmt
152          end
153    
154      structure Var : sig      structure Var : sig
155          val new : string -> var          val new : string -> var
# Line 118  Line 169 
169    
170      structure Op = Op      structure Op = Op
171    
172      datatype program = Program of {      datatype node = ND of {
173          globals : var list,          id : Stamp.stamp,
174          globalInit : stmt,          props : PropList.holder,
175          actors : actor list          kind : node_kind
         (* initialization *)  
176        }        }
177    
178      and actor = Actor of {      and node_kind
179          name : Atom.atom,        = NULL
180          params : var list,        | ENTRY of {
181          state : var list,              succ : node ref
182          stateInit : stmt,            }
183          methods : method list        | JOIN of {
184                preds : node list ref,
185                phis : (var * var list) list ref,   (* phi statements *)
186                succ : node ref
187              }
188          | COND of {
189                pred : node ref,
190                cond : var,
191                trueBranch : node ref,
192                falseBranch : node ref
193              }
194          | BLOCK of {
195                pred : node ref,
196                body : assign list ref,
197                succ : node ref
198              }
199          | NEW of {
200                pred : node ref,
201                actor : Atom.atom,
202                args : var list,
203                succ : node ref
204              }
205          | DIE of {
206                pred : node ref
207              }
208          | STABILIZE of {
209                pred : node ref
210              }
211          | EXIT of {
212                pred : node ref
213        }        }
214    
215      and method = Method of Atom.atom * stmt    (***** Statements *****)
216    
217      and stmt = STM of {      and stmt = STM of {
218          id : Stamp.stamp,          id : Stamp.stamp,
219          props : PropList.holder,          props : PropList.holder,
220          preds : stmt list ref,          kind : stmt_kind,
221          phis : (var * var list) list ref,       (* phi statements *)          next : stmt option              (* next statement at this structural level *)
         kind : stmt_kind ref  
222        }        }
223    
224      and stmt_kind      and stmt_kind
225        = BLOCK of {        = S_SIMPLE of node                (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
226              succ : stmt,        | S_IF of {
227              body : assign list              cond : node,                (* COND node *)
           }  
       | IF of {  
             cond : var,  
228              thenBranch : stmt,              thenBranch : stmt,
229              elseBranch : stmt              elseBranch : stmt
230            }            }
231        | LOOP of {        | S_LOOP of {
232              hdr : stmt,              hdr : stmt,
233              cond : var,              cond : node,                (* COND node *)
234              body : stmt,              body : stmt
             exit : stmt  
           }  
       | NEW of {  
             actor : Atom.atom,  
             args : var list,  
             succ : stmt  
235            }            }
       | DIE  
       | STABILIZE  
       | EXIT  
236    
237      and rhs      and rhs
238        = VAR of var        = VAR of var
# Line 183  Line 249 
249    
250      withtype assign = (var * rhs)      withtype assign = (var * rhs)
251    
252        datatype program = Program of {
253            globals : var list,
254            globalInit : stmt,
255            actors : actor list
256            (* initialization *)
257          }
258    
259        and actor = Actor of {
260            name : Atom.atom,
261            params : var list,
262            state : var list,
263            stateInit : stmt,
264            methods : method list
265          }
266    
267        and method = Method of {
268            name : Atom.atom,
269            stateIn : var list,     (* names of state variables on method entry *)
270            stateOut : var list,    (* names of state variables on method exit *)
271            body : stmt             (* method body *)
272          }
273    
274        structure Node =
275          struct
276            fun same (ND{id=a, ...}, ND{id=b, ...}) = Stamp.same(a, b)
277            fun compare (ND{id=a, ...}, ND{id=b, ...}) = Stamp.compare(a, b)
278            fun hash (ND{id, ...}) = Stamp.hash id
279            fun toString (ND{id, kind, ...}) = let
280                  val tag = (case kind
281                         of NULL => "NULL"
282                          | ENTRY _ => "ENTRY"
283                          | JOIN _ => "JOIN"
284                          | COND _ => "COND"
285                          | BLOCK _ => "BLOCK"
286                          | NEW _ => "NEW"
287                          | DIE _ => "DIE"
288                          | STABILIZE _ => "STABILIZE"
289                          | EXIT _ => "EXIT"
290                        (* end case *))
291                  in
292                    tag ^ Stamp.toString id
293                  end
294            fun new kind = ND{id = Stamp.new(), props = PropList.newHolder(), kind = kind}
295            val dummy = new NULL
296            fun mkENTRY () = new (ENTRY{succ = ref dummy})
297            fun mkJOIN phis = new (JOIN{preds = ref [], phis = ref phis, succ = ref dummy})
298            fun mkCOND {cond, trueBranch, falseBranch} = new (COND{
299                    pred = ref dummy, cond = cond,
300                    trueBranch = ref trueBranch, falseBranch = ref falseBranch
301                  })
302            fun mkBLOCK body = new (BLOCK{pred = ref dummy, body = ref body, succ = ref dummy})
303            fun mkNEW {actor, args} = new (NEW{
304                    pred = ref dummy, actor = actor, args = args, succ = ref dummy
305                  })
306            fun mkDIE () = new (DIE{pred = ref dummy})
307            fun mkSTABILIZE () = new (STABILIZE{pred = ref dummy})
308            fun mkEXIT () = new (EXIT{pred = ref dummy})
309          (* editing node edges *)
310            fun setPred (ND{kind, ...}, nd) = (case kind
311                   of NULL => raise Fail "setPred on NULL node"
312                    | ENTRY _ => raise Fail "setPred on ENTRY node"
313                    | JOIN{preds, ...} => if List.exists (fn nd' => same(nd, nd')) (!preds)
314                        then ()
315                        else preds := nd :: !preds
316                    | COND{pred, ...} => pred := nd
317                    | BLOCK{pred, ...} => pred := nd
318                    | NEW{pred, ...} => pred := nd
319                    | DIE{pred} => pred := nd
320                    | STABILIZE{pred} => pred := nd
321                    | EXIT{pred} => pred := nd
322                  (* end case *))
323            fun preds (ND{kind, ...}) = (case kind
324                   of NULL => raise Fail "preds on NULL node"
325                    | ENTRY _ => []
326                    | JOIN{preds, ...} => !preds
327                    | COND{pred, ...} => [!pred]
328                    | BLOCK{pred, ...} => [!pred]
329                    | NEW{pred, ...} => [!pred]
330                    | DIE{pred} => [!pred]
331                    | STABILIZE{pred} => [!pred]
332                    | EXIT{pred} => [!pred]
333                  (* end case *))
334            fun hasSucc (ND{kind, ...}) = (case kind
335                   of NULL => false
336                    | ENTRY{succ} => true
337                    | JOIN{succ, ...} => true
338                    | COND{trueBranch, falseBranch, ...} => true
339                    | BLOCK{succ, ...} => true
340                    | NEW{succ, ...} => true
341                    | DIE _ => false
342                    | STABILIZE _ => false
343                    | EXIT _ => false
344                  (* end case *))
345            fun setSucc (ND{kind, ...}, nd) = (case kind
346                   of NULL => raise Fail "setSucc on NULL node"
347                    | ENTRY{succ} => succ := nd
348                    | JOIN{succ, ...} => succ := nd
349                    | COND _ => raise Fail "setSucc on COND node"
350                    | BLOCK{succ, ...} => succ := nd
351                    | NEW{succ, ...} => succ := nd
352                    | DIE _ => raise Fail "setSucc on DIE node"
353                    | STABILIZE _ => raise Fail "setSucc on STABILIZE node"
354                    | EXIT _ => raise Fail "setSucc on EXIT node"
355                  (* end case *))
356            fun succs (ND{kind, ...}) = (case kind
357                   of NULL => raise Fail "succs on NULL node"
358                    | ENTRY{succ} => [!succ]
359                    | JOIN{succ, ...} => [!succ]
360                    | COND{trueBranch, falseBranch, ...} => [!trueBranch, !falseBranch]
361                    | BLOCK{succ, ...} => [!succ]
362                    | NEW{succ, ...} => [!succ]
363                    | DIE _ => []
364                    | STABILIZE _ => []
365                    | EXIT _ => []
366                  (* end case *))
367            fun setTrueBranch (ND{kind=COND{trueBranch, ...}, ...}, nd) = trueBranch := nd
368              | setTrueBranch (nd, _) = raise Fail("setTrueBranch on " ^ toString nd)
369            fun setFalseBranch (ND{kind=COND{falseBranch, ...}, ...}, nd) = falseBranch := nd
370              | setFalseBranch (nd, _) = raise Fail("setFalseBranch on " ^ toString nd)
371            fun addEdge (nd1, nd2) = (
372                  if hasSucc nd1
373                    then (
374                      setSucc (nd1, nd2);
375                      setPred (nd2, nd1))
376                    else ())
377    (*DEBUG*)handle ex => (
378    print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);
379    raise ex)
380          end
381    
382        structure Stmt =
383          struct
384      fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)      fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
385      fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)      fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
386      fun hash (STM{id, ...}) = Stamp.hash id      fun hash (STM{id, ...}) = Stamp.hash id
387            fun toString (STM{id, kind, ...}) = let
388      fun succs (STM{kind, ...}) = (case !kind                val tag = (case kind
389             of BLOCK{succ, ...} => [succ]                       of S_SIMPLE(ND{kind, ...}) => (case kind
390              | IF{thenBranch, elseBranch, ...} => [thenBranch, elseBranch]                             of NULL => "NULL"
391              | LOOP{exit, ...} => [exit]                              | ENTRY _ => "ENTRY"
392              | NEW{succ, ...} => [succ]                              | JOIN _ => "JOIN"
393              | _ => []                              | COND _ => raise Fail "unexpected S_SIMPLE with COND node"
394            (* end case *))                              | BLOCK _ => "BLOCK"
395                                | NEW _ => "NEW"
396    (* set the successor of a statement *)                              | DIE _ => "DIE"
397      fun setSucc (STM{kind, ...}, stm) = (case !kind                              | STABILIZE _ => "STABILIZE"
398             of BLOCK{succ, body} => kind := BLOCK{succ=stm, body=body}                              | EXIT _ => "EXIT"
399              | IF{thenBranch, elseBranch, ...} => (                            (* end case *))
400                  setSucc(thenBranch, stm);                        | S_IF _ => "IF"
401                  setSucc(elseBranch, stm))                        | S_LOOP _ => "LOOP"
402              | LOOP{hdr, cond, body, exit} => kind := LOOP{hdr=hdr, cond=cond, body=body, exit=stm}                      (* end case *))
403              | NEW{actor, args, succ} => kind := NEW{actor=actor, args=args, succ=stm}                in
404              | _ => () (* no successor *)                  tag ^ Stamp.toString id
405            (* end case *))                end
406          (* return the entry node of the statement *)
407      fun preds (STM{preds, ...}) = !preds          fun entry (STM{kind, ...}) = (case kind
408                   of S_SIMPLE nd => nd
409      fun addPred (STM{preds, ...}, stm) =                  | S_IF{cond, ...} => cond
410            if not(List.exists (fn b => same(stm, b)) (!preds))                  | S_LOOP{hdr, ...} => entry hdr
411              then preds := stm :: !preds                (* end case *))
412              else ();        (* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
413            fun tail (STM{kind, ...}) = (case kind
414      fun mkSTM kind = STM{                 of S_SIMPLE nd => nd
415                    | S_IF{cond, ...} => raise Fail "tail of IF"
416                    | S_LOOP{hdr, ...} => raise Fail "tail of LOOP"
417                  (* end case *))
418          (* statement constructor functions *)
419            fun new (kind, next) = STM{
420              id = Stamp.new(),              id = Stamp.new(),
421              props = PropList.newHolder(),              props = PropList.newHolder(),
422              preds = ref [],              kind = kind,
423              phis = ref [],              next = next
             kind = ref kind  
424            }            }
425            val dummy = new (S_SIMPLE(Node.dummy), NONE)
426      val dummy = mkSTM EXIT          fun mkENTRY next = new (S_SIMPLE(Node.mkENTRY ()), next)
427            fun mkJOIN (phis, next) = new (S_SIMPLE(Node.mkJOIN phis), next)
428      fun mkBLOCK args = mkSTM(BLOCK args)          fun mkIF (cond, thenBranch, elseBranch, next) = let
429      fun mkIF args = mkSTM(IF args)                val cond = Node.mkCOND {
430      fun mkLOOP args = mkSTM(LOOP args)                      cond = cond,
431      fun mkNEW args = mkSTM(NEW args)                      trueBranch = entry thenBranch,
432      fun mkDIE () = mkSTM DIE                      falseBranch = entry elseBranch
433      fun mkSTABILIZE () = mkSTM STABILIZE                    }
434      fun mkEXIT () = mkSTM EXIT                in
435                    Node.setPred (entry thenBranch, cond);
436                    Node.setPred (entry elseBranch, cond);
437                    new (S_IF{cond = cond, thenBranch = thenBranch, elseBranch = elseBranch}, next)
438                  end
439            fun mkBLOCK (body, next) = new (S_SIMPLE(Node.mkBLOCK body), next)
440            fun mkNEW (actor, args, next) = new (S_SIMPLE(Node.mkNEW{actor=actor, args=args}), next)
441            fun mkDIE () = new (S_SIMPLE(Node.mkDIE ()), NONE)
442            fun mkSTABILIZE () = new (S_SIMPLE(Node.mkSTABILIZE ()), NONE)
443            fun mkEXIT () = new (S_SIMPLE(Node.mkEXIT ()), NONE)
444          end
445    
446      structure Var =      structure Var =
447        struct        struct

Legend:
Removed from v.255  
changed lines
  Added in v.256

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