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 168, Wed Jul 21 20:58:37 2010 UTC revision 392, Thu Oct 14 15:34:28 2010 UTC
# Line 9  Line 9 
9    
10  signature SSA =  signature SSA =
11    sig    sig
     structure Op : OPERATORS  
12    
13      datatype var = V of {      structure Ty : SSA_TYPES
14          name : string,                  (* name *)      structure Op : OPERATORS where type ty = Ty.ty
15          id : Stamp.stamp,               (* unique ID *)  
16          useCnt : int ref,               (* count of uses *)    (***** CFG *****)
17          props : PropList.holder  
18        datatype node = ND of {
19            id : Stamp.stamp,
20            props : PropList.holder,
21            kind : node_kind
22        }        }
23    
24    (* a statement is a CFG fragment with a single entrypoint and      and node_kind
25     * a single continuation.        = NULL
26     *)        | ENTRY of {
27      datatype stmt              succ : node ref
28        = BLOCK of stmt            }
29        | SEQ of stmt list        | JOIN of {
30        | IF of {              preds : node list ref,
31            pre : stmt,              phis : (var * var list) list ref,   (* phi statements *)
32            cond : var,              succ : node ref
           trueBranch : stmt  
           falseBranch : stmt  
33          }          }
34        | WHILE of {        | COND of {
35            hdr : block,              pred : node ref,
36            cond : var,            cond : var,
37            body : stmt              trueBranch : node ref,
38                falseBranch : node ref
39              }
40          | BLOCK of {
41                pred : node ref,
42                body : assign list ref,
43                succ : node ref
44              }
45          | NEW of {
46                pred : node ref,
47                actor : Atom.atom,
48                args : var list,
49                succ : node ref
50              }
51          | DIE of {
52                pred : node ref
53              }
54          | STABILIZE of {
55                pred : node ref
56              }
57          | EXIT of {
58                pred : node ref
59          }          }
60    
61      and block = BLK of {    (***** Statements *****)
62            parent : stmt ref,                    (* parent statement of this block *)  
63            id : Stamp.stamp,                     (* unique ID *)      and stmt = STM of {
64            preds : block list ref,               (* list of predecessor blocks in the CFG *)          id : Stamp.stamp,
65            phi : (var * var list) list ref,      (* phi statements *)          props : PropList.holder,
66            body : simple_stmt list ref,          kind : stmt_kind,
67            succs : block list ref                (* successor blocks in the CFG *)          next : stmt option              (* next statement at this structural level *)
68          }          }
69    
70      and simple_stmt      and stmt_kind
71        = ASSIGN of var * rhs        = S_SIMPLE of node                (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
72        | DIE        | S_IF of {
73        | STABILIZE              cond : node,                (* COND node *)
74        | RETURN              thenBranch : stmt,
75                elseBranch : stmt
76              }
77          | S_LOOP of {
78                hdr : stmt,
79                cond : node,                (* COND node *)
80                body : stmt
81              }
82    
83      and rhs      and rhs
84        = VAR of var        = VAR of var
85          | LIT of Literal.literal
86        | OP of Op.rator * var list        | OP of Op.rator * var list
87          | CONS of var list                (* tensor-value construction *)
88    
89        and var = V of {
90            name : string,                  (* name *)
91            id : Stamp.stamp,               (* unique ID *)
92            bind : var_bind ref,            (* binding *)
93            useCnt : int ref,               (* count of uses *)
94            props : PropList.holder
95          }
96    
97      val newVar : string -> var      and var_bind
98      val newBlock : unit -> block        = VB_NONE
99          | VB_RHS of rhs
100          | VB_PHI of var list
101          | VB_PARAM
102          | VB_STATE_VAR
103    
104        withtype assign = (var * rhs)
105    
106        datatype program = Program of {
107            globals : var list,
108            globalInit : stmt,
109            actors : actor list
110            (* initialization *)
111          }
112    
113        and actor = Actor of {
114            name : Atom.atom,
115            params : var list,
116            state : var list,
117            stateInit : stmt,
118            methods : method list
119          }
120    
121      val entryBlock : stmt -> block      and method = Method of {
122      val nextBlock : stmt -> block          name : Atom.atom,
123            stateIn : var list,     (* names of state variables on method entry *)
124            stateOut : var list,    (* names of state variables on method exit *)
125            body : stmt             (* method body *)
126          }
127    
128        structure Node : sig
129            val same : node * node -> bool
130            val compare : node * node -> order
131            val hash : node -> word
132            val toString : node -> string
133          (* dummy node *)
134            val dummy : node
135          (* CFG edges *)
136            val preds : node -> node list
137            val setPred : node * node -> unit
138            val hasSucc : node -> bool
139            val succs : node -> node list
140            val setSucc : node * node -> unit
141            val setTrueBranch : node * node -> unit  (* set trueBranch successor for COND node *)
142            val setFalseBranch : node * node -> unit (* set falseBranch successor for COND node *)
143            val addEdge : node * node -> unit
144          (* constructors *)
145            val mkENTRY : unit -> node
146            val mkJOIN : (var * var list) list -> node
147            val mkCOND : {cond : var, trueBranch : node, falseBranch : node} -> node
148            val mkBLOCK : assign list -> node
149            val mkNEW : {actor : Atom.atom, args : var list} -> node
150            val mkDIE : unit -> node
151            val mkSTABILIZE : unit -> node
152            val mkEXIT : unit -> node
153          (* properties *)
154            val newProp : (node -> 'a) -> {
155                    getFn : node -> 'a,
156                    peekFn : node -> 'a option,
157                    setFn : node * 'a -> unit,
158                    clrFn : node -> unit
159                  }
160            val newFlag : unit -> {
161                    getFn : node -> bool,
162                    setFn : node * bool -> unit
163                  }
164    end    end
165    
166  functor SSAFn (Op : OPERATORS) : SSA =      structure Stmt : sig
167    struct          val same : stmt * stmt -> bool
168            val compare : stmt * stmt -> order
169            val hash : stmt -> word
170            val toString : stmt -> string
171          (* return the entry node of the statement *)
172            val entry : stmt -> node
173          (* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
174            val tail : stmt -> node
175          (* statement constructor functions *)
176            val new : (stmt_kind * stmt option) -> stmt
177            val mkENTRY : stmt option -> stmt
178            val mkJOIN : (var * var list) list * stmt option -> stmt
179            val mkIF : var * stmt * stmt * stmt option -> stmt
180            val mkBLOCK : assign list * stmt option -> stmt
181            val mkNEW : Atom.atom * var list * stmt option -> stmt
182            val mkDIE : unit -> stmt
183            val mkSTABILIZE : unit -> stmt
184            val mkEXIT : unit -> stmt
185          (* properties *)
186            val newProp : (stmt -> 'a) -> {
187                    getFn : stmt -> 'a,
188                    peekFn : stmt -> 'a option,
189                    setFn : stmt * 'a -> unit,
190                    clrFn : stmt -> unit
191                  }
192            val newFlag : unit -> {
193                    getFn : stmt -> bool,
194                    setFn : stmt * bool -> unit
195                  }
196          end
197    
198      datatype var = V of {      structure Var : sig
199          name : string,                  (* name *)          val new : string -> var
200          id : Stamp.stamp,               (* unique ID *)          val name : var -> string
201          useCnt : int ref,               (* count of uses *)          val binding : var -> var_bind
202          props : PropList.holder          val setBinding : var * var_bind -> unit
203            val same : var * var -> bool
204            val compare : var * var -> order
205            val hash : var -> word
206            val toString : var -> string
207          (* properties *)
208            val newProp : (var -> 'a) -> {
209                    getFn : var -> 'a,
210                    peekFn : var -> 'a option,
211                    setFn : var * 'a -> unit,
212                    clrFn : var -> unit
213        }        }
214            val newFlag : unit -> {
215                    getFn : var -> bool,
216                    setFn : var * bool -> unit
217                  }
218          (* collections *)
219            structure Map : ORD_MAP where type Key.ord_key = var
220            structure Set : ORD_SET where type Key.ord_key = var
221            structure Tbl : MONO_HASH_TABLE where type Key.hash_key = var
222          end
223    
224    datatype stmt    (* DFS sorting of the graph rooted at the entry to a statement; the resulting list will
225      = EXIT     * be in preorder with parents before children.
226      | SEQ of block * stmt     *)
227      | IF of {      val sortNodes : stmt -> node list
228          pre : stmt,  
229          cond : var,    (* apply a function to all of the nodes in the graph rooted at the entry to the statement *)
230          trueBranch : stmt,      val applyToNodes : (node -> unit) -> stmt -> unit
231          falseBranch : stmt,  
232          next : stmt             (* ?? *)    end
233    
234    functor SSAFn (
235    
236        structure Ty : SSA_TYPES
237        structure Op : OPERATORS where type ty = Ty.ty
238    
239      ) : SSA = struct
240    
241        structure Ty = Ty
242        structure Op = Op
243    
244        datatype node = ND of {
245            id : Stamp.stamp,
246            props : PropList.holder,
247            kind : node_kind
248        }        }
249      | WHILE of {  
250          hdr : stmt,      and node_kind
251          = NULL
252          | ENTRY of {
253                succ : node ref
254              }
255          | JOIN of {
256                preds : node list ref,
257                phis : (var * var list) list ref,   (* phi statements *)
258                succ : node ref
259              }
260          | COND of {
261                pred : node ref,
262          cond : var,          cond : var,
263          body : stmt,              trueBranch : node ref,
264          exit : stmt             (* ?? *)              falseBranch : node ref
265              }
266          | BLOCK of {
267                pred : node ref,
268                body : assign list ref,
269                succ : node ref
270              }
271          | NEW of {
272                pred : node ref,
273                actor : Atom.atom,
274                args : var list,
275                succ : node ref
276              }
277          | DIE of {
278                pred : node ref
279              }
280          | STABILIZE of {
281                pred : node ref
282              }
283          | EXIT of {
284                pred : node ref
285        }        }
286    
287    and block = BLK of {    (***** Statements *****)
288          parent : stmt ref,                      (* parent statement of this block *)  
289          id : Stamp.stamp,                       (* unique ID *)      and stmt = STM of {
290          preds : block list ref,                 (* list of predecessor blocks in the CFG *)          id : Stamp.stamp,
291          phi : (var * var list) list ref,        (* phi statements *)          props : PropList.holder,
292          body : simple_stmt list ref,          kind : stmt_kind,
293          succs : block list ref                  (* successor blocks in the CFG *)          next : stmt option              (* next statement at this structural level *)
294        }        }
295    
296    and simple_stmt      and stmt_kind
297      = ASSIGN of var * rhs        = S_SIMPLE of node                (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
298      | DIE        | S_IF of {
299      | STABILIZE              cond : node,                (* COND node *)
300      | RETURN              thenBranch : stmt,
301                elseBranch : stmt
302              }
303          | S_LOOP of {
304                hdr : stmt,
305                cond : node,                (* COND node *)
306                body : stmt
307              }
308    
309      and rhs      and rhs
310        = VAR of var        = VAR of var
311          | LIT of Literal.literal
312        | OP of Op.rator * var list        | OP of Op.rator * var list
313          | CONS of var list                (* tensor-value construction *)
314    
315    (* block properties *)      and var = V of {
316      fun parentOf (BLK{parent, ...}) = !parent          name : string,                  (* name *)
317      fun predsOf (BLK{preds, ...}) = !preds          bind : var_bind ref,            (* binding *)
318      fun succsOf (BLK{succs, ...}) = !succs          id : Stamp.stamp,               (* unique ID *)
319            useCnt : int ref,               (* count of uses *)
320            props : PropList.holder
321          }
322    
323    (* IL construction code *)      and var_bind
324      fun newVar name = V{        = VB_NONE
325              name = name,        | VB_RHS of rhs
326              id = Stamp.new(),        | VB_PHI of var list
327              useCnt = ref 0,        | VB_PARAM
328              props = PropList.newHolder()        | VB_STATE_VAR
329    
330        withtype assign = (var * rhs)
331    
332        datatype program = Program of {
333            globals : var list,
334            globalInit : stmt,
335            actors : actor list
336            (* initialization *)
337            }            }
338    
339      fun newBlock () = BLK{      and actor = Actor of {
340              parent = ref(SEQ[]),          name : Atom.atom,
341              id = Stamp.new(),          params : var list,
342              preds = ref[],          state : var list,
343              phi = ref[],          stateInit : stmt,
344              body = ref[],          methods : method list
             succs = ref[]  
345            }            }
346    
347      local      and method = Method of {
348        fun setParent (BKL{parent, ...}, s) = (parent := s)          name : Atom.atom,
349      in          stateIn : var list,     (* names of state variables on method entry *)
350      fun mkBLOCK blk = let          stateOut : var list,    (* names of state variables on method exit *)
351            val s = BLOCK blk          body : stmt             (* method body *)
352          }
353    
354        structure Node =
355          struct
356            fun same (ND{id=a, ...}, ND{id=b, ...}) = Stamp.same(a, b)
357            fun compare (ND{id=a, ...}, ND{id=b, ...}) = Stamp.compare(a, b)
358            fun hash (ND{id, ...}) = Stamp.hash id
359            fun toString (ND{id, kind, ...}) = let
360                  val tag = (case kind
361                         of NULL => "NULL"
362                          | ENTRY _ => "ENTRY"
363                          | JOIN _ => "JOIN"
364                          | COND _ => "COND"
365                          | BLOCK _ => "BLOCK"
366                          | NEW _ => "NEW"
367                          | DIE _ => "DIE"
368                          | STABILIZE _ => "STABILIZE"
369                          | EXIT _ => "EXIT"
370                        (* end case *))
371            in            in
372              setParent (blk, s);                  tag ^ Stamp.toString id
373              s                end
374            fun new kind = ND{id = Stamp.new(), props = PropList.newHolder(), kind = kind}
375            val dummy = new NULL
376            fun mkENTRY () = new (ENTRY{succ = ref dummy})
377            fun mkJOIN phis = new (JOIN{preds = ref [], phis = ref phis, succ = ref dummy})
378            fun mkCOND {cond, trueBranch, falseBranch} = new (COND{
379                    pred = ref dummy, cond = cond,
380                    trueBranch = ref trueBranch, falseBranch = ref falseBranch
381                  })
382            fun mkBLOCK body = new (BLOCK{pred = ref dummy, body = ref body, succ = ref dummy})
383            fun mkNEW {actor, args} = new (NEW{
384                    pred = ref dummy, actor = actor, args = args, succ = ref dummy
385                  })
386            fun mkDIE () = new (DIE{pred = ref dummy})
387            fun mkSTABILIZE () = new (STABILIZE{pred = ref dummy})
388            fun mkEXIT () = new (EXIT{pred = ref dummy})
389          (* editing node edges *)
390            fun setPred (ND{kind, ...}, nd) = (case kind
391                   of NULL => raise Fail "setPred on NULL node"
392                    | ENTRY _ => raise Fail "setPred on ENTRY node"
393                    | JOIN{preds, ...} => if List.exists (fn nd' => same(nd, nd')) (!preds)
394                        then ()
395                        else preds := nd :: !preds
396                    | COND{pred, ...} => pred := nd
397                    | BLOCK{pred, ...} => pred := nd
398                    | NEW{pred, ...} => pred := nd
399                    | DIE{pred} => pred := nd
400                    | STABILIZE{pred} => pred := nd
401                    | EXIT{pred} => pred := nd
402                  (* end case *))
403            fun preds (ND{kind, ...}) = (case kind
404                   of NULL => raise Fail "preds on NULL node"
405                    | ENTRY _ => []
406                    | JOIN{preds, ...} => !preds
407                    | COND{pred, ...} => [!pred]
408                    | BLOCK{pred, ...} => [!pred]
409                    | NEW{pred, ...} => [!pred]
410                    | DIE{pred} => [!pred]
411                    | STABILIZE{pred} => [!pred]
412                    | EXIT{pred} => [!pred]
413                  (* end case *))
414            fun hasSucc (ND{kind, ...}) = (case kind
415                   of NULL => false
416                    | ENTRY{succ} => true
417                    | JOIN{succ, ...} => true
418                    | COND{trueBranch, falseBranch, ...} => true
419                    | BLOCK{succ, ...} => true
420                    | NEW{succ, ...} => true
421                    | DIE _ => false
422                    | STABILIZE _ => false
423                    | EXIT _ => false
424                  (* end case *))
425            fun setSucc (ND{kind, ...}, nd) = (case kind
426                   of NULL => raise Fail "setSucc on NULL node"
427                    | ENTRY{succ} => succ := nd
428                    | JOIN{succ, ...} => succ := nd
429                    | COND _ => raise Fail "setSucc on COND node"
430                    | BLOCK{succ, ...} => succ := nd
431                    | NEW{succ, ...} => succ := nd
432                    | DIE _ => raise Fail "setSucc on DIE node"
433                    | STABILIZE _ => raise Fail "setSucc on STABILIZE node"
434                    | EXIT _ => raise Fail "setSucc on EXIT node"
435                  (* end case *))
436            fun succs (ND{kind, ...}) = (case kind
437                   of NULL => raise Fail "succs on NULL node"
438                    | ENTRY{succ} => [!succ]
439                    | JOIN{succ, ...} => [!succ]
440                    | COND{trueBranch, falseBranch, ...} => [!trueBranch, !falseBranch]
441                    | BLOCK{succ, ...} => [!succ]
442                    | NEW{succ, ...} => [!succ]
443                    | DIE _ => []
444                    | STABILIZE _ => []
445                    | EXIT _ => []
446                  (* end case *))
447            fun setTrueBranch (ND{kind=COND{trueBranch, ...}, ...}, nd) = trueBranch := nd
448              | setTrueBranch (nd, _) = raise Fail("setTrueBranch on " ^ toString nd)
449            fun setFalseBranch (ND{kind=COND{falseBranch, ...}, ...}, nd) = falseBranch := nd
450              | setFalseBranch (nd, _) = raise Fail("setFalseBranch on " ^ toString nd)
451            fun addEdge (nd1, nd2) = (
452                  if hasSucc nd1
453                    then (
454                      setSucc (nd1, nd2);
455                      setPred (nd2, nd1))
456                    else ())
457    (*DEBUG*)handle ex => (
458    print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);
459    raise ex)
460          (* properties *)
461            fun newProp initFn =
462                  PropList.newProp (fn (ND{props, ...}) => props, initFn)
463            fun newFlag () =
464                  PropList.newFlag (fn (ND{props, ...}) => props)
465            end            end
466    
467      fun mkIF (pre, cond, t, f) = let      structure Stmt =
468            val s = IF{pre=pre, cond=cond, trueBranch=t, falseBranch=f}        struct
469            fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
470            fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
471            fun hash (STM{id, ...}) = Stamp.hash id
472            fun toString (STM{id, kind, ...}) = let
473                  val tag = (case kind
474                         of S_SIMPLE(ND{kind, ...}) => (case kind
475                               of NULL => "NULL"
476                                | ENTRY _ => "ENTRY"
477                                | JOIN _ => "JOIN"
478                                | COND _ => raise Fail "unexpected S_SIMPLE with COND node"
479                                | BLOCK _ => "BLOCK"
480                                | NEW _ => "NEW"
481                                | DIE _ => "DIE"
482                                | STABILIZE _ => "STABILIZE"
483                                | EXIT _ => "EXIT"
484                              (* end case *))
485                          | S_IF _ => "IF"
486                          | S_LOOP _ => "LOOP"
487                        (* end case *))
488            in            in
489              setParent (pre, s);                  tag ^ Stamp.toString id
             s  
490            end            end
491          (* return the entry node of the statement *)
492      fun mkWHILE (hdr, cond, body) = let          fun entry (STM{kind, ...}) = (case kind
493            val s = WHILE{hdr=hdr, cond=cond, body=body}                 of S_SIMPLE nd => nd
494                    | S_IF{cond, ...} => cond
495                    | S_LOOP{hdr, ...} => entry hdr
496                  (* end case *))
497          (* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
498            fun tail (STM{kind, ...}) = (case kind
499                   of S_SIMPLE nd => nd
500                    | S_IF{cond, ...} => raise Fail "tail of IF"
501                    | S_LOOP{hdr, ...} => raise Fail "tail of LOOP"
502                  (* end case *))
503          (* statement constructor functions *)
504            fun new (kind, next) = STM{
505                id = Stamp.new(),
506                props = PropList.newHolder(),
507                kind = kind,
508                next = next
509              }
510            val dummy = new (S_SIMPLE(Node.dummy), NONE)
511            fun mkENTRY next = new (S_SIMPLE(Node.mkENTRY ()), next)
512            fun mkJOIN (phis, next) = new (S_SIMPLE(Node.mkJOIN phis), next)
513            fun mkIF (cond, thenBranch, elseBranch, next) = let
514                  val cond = Node.mkCOND {
515                        cond = cond,
516                        trueBranch = entry thenBranch,
517                        falseBranch = entry elseBranch
518                      }
519            in            in
520              setParent (hdr, s);                  Node.setPred (entry thenBranch, cond);
521              s                  Node.setPred (entry elseBranch, cond);
522                    new (S_IF{cond = cond, thenBranch = thenBranch, elseBranch = elseBranch}, next)
523                  end
524            fun mkBLOCK (body, next) = new (S_SIMPLE(Node.mkBLOCK body), next)
525            fun mkNEW (actor, args, next) = new (S_SIMPLE(Node.mkNEW{actor=actor, args=args}), next)
526            fun mkDIE () = new (S_SIMPLE(Node.mkDIE ()), NONE)
527            fun mkSTABILIZE () = new (S_SIMPLE(Node.mkSTABILIZE ()), NONE)
528            fun mkEXIT () = new (S_SIMPLE(Node.mkEXIT ()), NONE)
529          (* properties *)
530            fun newProp initFn =
531                  PropList.newProp (fn (STM{props, ...}) => props, initFn)
532            fun newFlag () =
533                  PropList.newFlag (fn (STM{props, ...}) => props)
534            end            end
535    
536      end (* local *)      structure Var =
537          struct
538            fun new name = V{
539                    name = name,
540                    id = Stamp.new(),
541                    bind = ref VB_NONE,
542                    useCnt = ref 0,
543                    props = PropList.newHolder()
544                  }
545            fun name (V{name, ...}) = name
546            fun binding (V{bind, ...}) = !bind
547            fun setBinding (V{bind, ...}, vb) = bind := vb
548            fun same (V{id=a, ...}, V{id=b, ...}) = Stamp.same(a, b)
549            fun compare (V{id=a, ...}, V{id=b, ...}) = Stamp.compare(a, b)
550            fun hash (V{id, ...}) = Stamp.hash id
551            fun toString (V{name, id, ...}) = name ^ Stamp.toString id
552          (* properties *)
553            fun newProp initFn =
554                  PropList.newProp (fn (V{props, ...}) => props, initFn)
555            fun newFlag () =
556                  PropList.newFlag (fn (V{props, ...}) => props)
557            local
558              structure V =
559                struct
560                  type ord_key = var
561                  val compare = compare
562                end
563            in
564            structure Map = RedBlackMapFn (V)
565            structure Set = RedBlackSetFn (V)
566            end
567            structure Tbl = HashTableFn (
568              struct
569                type hash_key = var
570                val hashVal = hash
571                val sameKey = same
572              end)
573          end
574    
575      fun entryBlock (BLOCK blk) = blk    (* DFS sorting of the graph rooted at the entry to a statement; the resulting list will
576        | entryBlock (SEQ(s1::_)) = entryBlock s1     * be in preorder with parents before children.
577        | entryBlock (IF{pre, ...}) = entryBlock pre     *)
578        | entryBlock (WHILE{hdr, ...}) = entryBlock hdr      fun sortNodes stmt = let
579              val {getFn, setFn} = PropList.newFlag (fn (ND{props, ...}) => props)
580              fun dfs (nd, l) =
581                    if getFn nd
582                      then l
583                      else (
584                        setFn (nd, true);
585                        nd :: List.foldl dfs l (Node.succs nd))
586              val nodes = dfs (Stmt.entry stmt, [])
587              in
588                List.app (fn nd => setFn(nd, false)) nodes;
589                nodes
590              end
591    
592      fun nextBlock (SEQ(, next)) = nextBlock next    (* apply a function to all of the nodes in the graph rooted at the entry to the statement *)
593        | nextBlock (SEQ stms) = nextBlock(List.last stms)      fun applyToNodes (f : node -> unit) stmt = let
594        | nextBlock (IF{pre, ...}) = entryBlock pre            val {getFn, setFn} = PropList.newFlag (fn (ND{props, ...}) => props)
595        | nextBlock (WHILE{hdr, ...}) = entryBlock hdr            fun dfs (nd, l) =
596                    if getFn nd
597                      then l
598                      else (
599                        f nd; (* visit *)
600                        setFn (nd, true);
601                        nd :: List.foldl dfs l (Node.succs nd))
602              val nodes = dfs (Stmt.entry stmt, [])
603              in
604                List.app (fn nd => setFn(nd, false)) nodes
605              end
606    
607    end    end

Legend:
Removed from v.168  
changed lines
  Added in v.392

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