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 191, Mon Aug 2 14:05:11 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
         name : string,                  (* name *)  
         id : Stamp.stamp,               (* unique ID *)  
         useCnt : int ref,               (* count of uses *)  
         props : PropList.holder  
       }  
14    
15      datatype block = BLK of {      datatype stmt = STM of {
16          id : Stamp.stamp,          id : Stamp.stamp,
17          props : PropList.holder,          props : PropList.holder,
18          preds : block list ref,          preds : stmt list ref,
19          succs : block list ref,          phis : (var * var list) list ref,       (* phi statements *)
20          phi : (var * var list) list ref,        (* phi statements *)          kind : stmt_kind ref
         body : assign list ref,  
         exit : transfer ref  
21        }        }
22    
23      and rhs      and stmt_kind
24        = VAR of var        = BLOCK of {
25        | LIT of Literal.literal              succ : stmt,
26        | OP of Op.rator * var list              body : assign list
27        | CONS of var list                (* tensor-value construction *)            }
   
     and transfer  
       = EXIT  
       | GOTO of block  
       | COND of var * block * block  
       | DIE  
       | STABILIZE  
   
     withtype assign = (var * rhs)  
   
   (* we layer a block-structured statement tree over the CFG to preserve  
    * the high-level control-flow structure for when we need to produce  
    * code.  
    *)  
     datatype stmt  
       = BLOCK of block  
       | SEQ of stmt list  
28        | IF of {        | IF of {
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
   
     val newVar : string -> var  
     val newBlock : unit -> block  
   
 (*  
     val entryBlock : stmt -> block  
     val nextBlock : stmt -> block  
 *)  
   
   end  
   
 functor SSAFn (Op : OPERATORS) : SSA =  
   struct  
   
     structure Op = Op  
   
     datatype var = V of {  
         name : string,                  (* name *)  
         id : Stamp.stamp,               (* unique ID *)  
         useCnt : int ref,               (* count of uses *)  
         props : PropList.holder  
38        }        }
39          | NEW of {
40      datatype block = BLK of {              actor : Atom.atom,
41          id : Stamp.stamp,              args : var list,
42          props : PropList.holder,              succ : stmt
         preds : block list ref,  
         succs : block list ref,  
         phi : (var * var list) list ref,        (* phi statements *)  
         body : assign list ref,  
         exit : transfer ref  
43        }        }
44          | DIE
45          | STABILIZE
46          | EXIT
47    
48      and rhs      and rhs
49        = VAR of var        = VAR of var
# Line 99  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      and transfer      and var = V of {
55        = EXIT          name : string,                  (* name *)
56        | GOTO of block          id : Stamp.stamp,               (* unique ID *)
57        | COND of var * block * block          useCnt : int ref,               (* count of uses *)
58        | DIE          props : PropList.holder
59        | STABILIZE        }
60    
61      withtype assign = (var * rhs)      withtype assign = (var * rhs)
62    
63    (* we layer a block-structured statement tree over the CFG to preserve      fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
64     * the high-level control-flow structure for when we need to produce      fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
65     * code.      fun hash (STM{id, ...}) = Stamp.hash id
66     *)  
67      datatype stmt      fun succs (STM{kind, ...}) = (case !kind
68        = BLOCK of block             of BLOCK{succ, ...} => [succ]
69        | SEQ of stmt list              | IF{thenBranch, elseBranch, ...} => [thenBranch, elseBranch]
70        | IF of {              | LOOP{exit, ...} => [exit]
71            cond : var,              | NEW{succ, ...} => [succ]
72            trueBranch : stmt,              | _ => []
73            falseBranch : stmt            (* end case *))
74          }  
75        | WHILE of {    (* set the successor of a statement *)
76            hdr : block,      fun setSucc (STM{kind, ...}, stm) = (case !kind
77            cond : var,             of BLOCK{succ, body} => kind := BLOCK{succ=stm, body=body}
78            body : stmt              | 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    (* IL construction code *)      fun mkSTM kind = STM{
     fun newVar name = V{  
             name = name,  
             id = Stamp.new(),  
             useCnt = ref 0,  
             props = PropList.newHolder()  
           }  
   
     fun newBlock () = BLK{  
94              id = Stamp.new(),              id = Stamp.new(),
95              props = PropList.newHolder(),              props = PropList.newHolder(),
96              preds = ref[],              preds = ref[],
97              succs = ref[],              phis = ref [],
98              phi = ref[],              kind = ref kind
99              body = ref[],            }
             exit = ref EXIT  
           }  
 (*  
     local  
       fun setParent (BLK{parent, ...}, s) = (parent := s)  
     in  
   
     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  
100    
101      end (* local *)      val dummy = mkSTM EXIT
 *)  
102    
103  (*      fun mkBLOCK args = mkSTM(BLOCK args)
104      fun entryBlock (BLOCK blk) = blk      fun mkIF args = mkSTM(IF args)
105        | entryBlock (SEQ(s1::_)) = entryBlock s1      fun mkLOOP args = mkSTM(LOOP args)
106        | entryBlock (IF{pre, ...}) = entryBlock pre      fun mkDIE () = mkSTM DIE
107        | entryBlock (WHILE{hdr, ...}) = entryBlock hdr      fun mkSTABILIZE () = mkSTM STABILIZE
108        fun mkEXIT () = mkSTM EXIT
     fun nextBlock (BLOCK(_, next)) = nextBlock next  
       | 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.191  
changed lines
  Added in v.192

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