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 1116, Thu May 5 04:49:02 2011 UTC revision 1232, Mon May 16 23:37:52 2011 UTC
# Line 1  Line 1 
1  (* ssa-fn.sml  (* ssa-fn.sml
2   *   *
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)   * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * The SSAFn functor is used to generate the High, Med, and Low ILs in the Diderot   * The SSAFn functor is used to generate the High, Med, and Low ILs in the Diderot
# Line 8  Line 8 
8   * in their types and operators.   * in their types and operators.
9   *)   *)
10    
 signature SSA =  
   sig  
   
     structure Ty : SSA_TYPES  
     structure Op : OPERATORS where type ty = Ty.ty  
   
   (***** CFG *****)  
   
     datatype cfg = CFG of {  
         entry : node,   (* the entry node of a graph; not necessarily an ENTRY node *)  
         exit : node     (* the exit node of a graph; not necessarily an EXIT node. *)  
       }  
   
     and node = ND of {  
         id : Stamp.stamp,  
         props : PropList.holder,  
         kind : node_kind  
       }  
   
     and node_kind  
       = NULL  
       | ENTRY of {  
             succ : node ref  
           }  
       | JOIN of {  
             preds : node list ref,  
             phis : phi list ref,  
             succ : node ref  
           }  
       | COND of {  
             pred : node ref,  
             cond : var,  
             trueBranch : node ref,  
             falseBranch : node ref  
           }  
       | COM of  {                       (* comment *)  
             pred : node ref,  
             text : string list,  
             succ : node ref  
           }  
       | ASSIGN of {                     (* assignment *)  
             pred : node ref,  
             stm : assign,  
             succ : node ref  
           }  
       | NEW of {                        (* create new strand instance *)  
             pred : node ref,  
             strand : Atom.atom,  
             args : var list,  
             succ : node ref  
           }  
       | EXIT of {                       (* includes die and stabilize *)  
             pred : node ref,  
             kind : ExitKind.kind,       (* kind of exit node *)  
             live : var list             (* live variables *)  
           }  
   
     and rhs  
       = VAR of var  
       | LIT of Literal.literal  
       | OP of Op.rator * var list  
       | APPLY of ILBasis.name * var list (* basis function application *)  
       | CONS of Ty.ty * var list        (* tensor/sequence-value construction *)  
   
     and var = V of {  
         name : string,                  (* name *)  
         id : Stamp.stamp,               (* unique ID *)  
         ty : Ty.ty,                     (* type *)  
         bind : var_bind ref,            (* binding *)  
         useCnt : int ref,               (* count of uses *)  
         props : PropList.holder  
       }  
   
     and var_bind  
       = VB_NONE  
       | VB_RHS of rhs                   (* defined by an assignment (includes globals and state variables) *)  
       | VB_PHI of var list              (* defined by a phi node *)  
       | VB_PARAM                        (* parameter to a strand *)  
   
     withtype assign = (var * rhs)  
          and phi = (var * var list)  
   
   
   (***** Program representation *****)  
   
     datatype program = Program of {  
         globalInit : cfg,  
         initially : initially,  
         strands : strand list  
       }  
   
     and initially = Initially of {  
         isArray : bool,                 (* true for initially array, false for collection *)  
         rangeInit : cfg,                (* code to compute bounds of iteration *)  
         iters : (var * var * var) list, (* "for" i = min .. max *)  
         create : (cfg * Atom.atom * var list)  
       }  
   
     and strand = Strand of {  
         name : Atom.atom,  
         params : var list,  
         state : (bool * var) list,      (* output variables are marked with true *)  
         stateInit : cfg,  
         methods : method list  
       }  
   
     and method = Method of {  
         name : Atom.atom,  
         stateIn : var list,     (* names of state variables on method entry *)  
         body : cfg              (* method body *)  
       }  
   
   (* operations on CFGs *)  
     structure CFG : sig  
       (* the empty CFG *)  
         val empty : cfg  
       (* is a CFG empty? *)  
         val isEmpty : cfg -> bool  
       (* create a basic block from a list of assignments *)  
         val mkBlock : assign list -> cfg  
       (* entry/exit nodes of a CFG *)  
         val entry : cfg -> node  
         val exit : cfg -> node  
       (* return the list of variables that are live at exit from a CFG *)  
         val liveAtExit : cfg -> var list  
       (* DFS sorting of the graph rooted at the entry to a statement; the resulting list will  
        * be in preorder with parents before children.  
        *)  
         val sort : cfg -> node list  
       (* apply a function to all of the nodes in the graph rooted at the entry to the statement *)  
         val apply : (node -> unit) -> cfg -> unit  
 (*  
       (* rewrite a CFG by applying a partial function to the nodes in the graph.  If NONE is returned,  
        * then no change to the node, if SOME(cfg) is returned, then the node is replaced by the  
        * subgraph, which may be empty.  This function returns true if any nodes were rewritten.  
        *)  
         val rewrite : (node -> cfg option) -> cfg -> bool  
 *)  
       (* delete a simple node from a CFG *)  
         val deleteNode : node -> unit  
       (* replace a simple node in a cfg with a different simple node *)  
         val replaceNode : (node * node) -> unit  
       (* replace a simple node in a cfg with a subgraph *)  
         val replaceNodeWithCFG : (node * cfg) -> unit  
       (* concatenate two CFGs *)  
         val concat : cfg * cfg -> cfg  
       (* append a node to a CFG *)  
         val appendNode : cfg * node -> cfg  
       end  
   
   (* operations on CFG nodes *)  
     structure Node : sig  
         val id : node -> Stamp.stamp  
         val kind : node -> node_kind  
         val same : node * node -> bool  
         val compare : node * node -> order  
         val hash : node -> word  
         val toString : node -> string  
         val isNULL : node -> bool  
       (* variable defs and uses; may include duplicates *)  
         val uses : node -> var list  
         val defs : node -> var list  
       (* dummy node *)  
         val dummy : node  
       (* CFG edges *)  
         val hasPred : node -> bool  
         val preds : node -> node list  
         val setPred : node * node -> unit  
         val hasSucc : node -> bool  
         val succs : node -> node list  
         val setSucc : node * node -> unit  
         val setTrueBranch : node * node -> unit  (* set trueBranch successor for COND node *)  
         val setFalseBranch : node * node -> unit (* set falseBranch successor for COND node *)  
         val addEdge : node * node -> unit  
       (* replace the edge src-->oldDst by the edge src-->dst *)  
         val replaceInEdge : {src : node, oldDst : node, dst : node} -> unit  
       (* replace the edge oldSrc-->dst by the edge src-->dst *)  
         val replaceOutEdge : {oldSrc : node, src : node, dst : node} -> unit  
       (* constructors *)  
         val mkENTRY : unit -> node  
         val mkJOIN : (var * var list) list -> node  
         val mkCOND : {cond : var, trueBranch : node, falseBranch : node} -> node  
         val mkCOM : string list -> node  
         val mkASSIGN : assign -> node  
         val mkNEW : {strand : Atom.atom, args : var list} -> node  
         val mkEXIT : ExitKind.kind * var list -> node  
         val mkFRAGMENT : var list -> node  
         val mkRETURN : var list -> node  
         val mkACTIVE : var list -> node  
         val mkSTABILIZE : var list -> node  
         val mkDIE : unit -> node  
       (* properties *)  
         val newProp : (node -> 'a) -> {  
                 getFn : node -> 'a,  
                 peekFn : node -> 'a option,  
                 setFn : node * 'a -> unit,  
                 clrFn : node -> unit  
               }  
         val newFlag : unit -> {  
                 getFn : node -> bool,  
                 setFn : node * bool -> unit  
               }  
       end  
   
   (* operations on variables *)  
     structure Var : sig  
         val new : string * Ty.ty -> var  
         val copy : var -> var  
         val name : var -> string  
         val ty : var -> Ty.ty  
         val binding : var -> var_bind  
         val setBinding : var * var_bind -> unit  
         val useCount : var -> int  
         val same : var * var -> bool  
         val compare : var * var -> order  
         val hash : var -> word  
         val toString : var -> string  
       (* properties *)  
         val newProp : (var -> 'a) -> {  
                 getFn : var -> 'a,  
                 peekFn : var -> 'a option,  
                 setFn : var * 'a -> unit,  
                 clrFn : var -> unit  
               }  
         val newFlag : unit -> {  
                 getFn : var -> bool,  
                 setFn : var * bool -> unit  
               }  
       (* collections *)  
         structure Map : ORD_MAP where type Key.ord_key = var  
         structure Set : ORD_SET where type Key.ord_key = var  
         structure Tbl : MONO_HASH_TABLE where type Key.hash_key = var  
       end  
   
   (* return a string representation of a rhs *)  
     val rhsToString : rhs -> string  
   
   (* return a string representation of a variable binding *)  
     val vbToString : var_bind -> string  
   
   (* return a string representation of a PHI node *)  
     val phiToString : phi -> string  
   
   (* return a string representation of an assignment *)  
     val assignToString : assign -> string  
   
   end  
   
11  functor SSAFn (  functor SSAFn (
12    
13        val ilName : string
14      structure Ty : SSA_TYPES      structure Ty : SSA_TYPES
15      structure Op : OPERATORS where type ty = Ty.ty      structure Op : OPERATORS where type ty = Ty.ty
16    
# Line 266  Line 19 
19      structure Ty = Ty      structure Ty = Ty
20      structure Op = Op      structure Op = Op
21    
22        val ilName = ilName
23    
24    (***** CFG *****)    (***** CFG *****)
25    
26      datatype cfg = CFG of {      datatype cfg = CFG of {
# Line 473  Line 228 
228                })                })
229          fun mkEXIT (kind, xs) = new (EXIT{kind = kind, live = xs, pred = ref dummy})          fun mkEXIT (kind, xs) = new (EXIT{kind = kind, live = xs, pred = ref dummy})
230          fun mkFRAGMENT xs = mkEXIT (ExitKind.FRAGMENT, xs)          fun mkFRAGMENT xs = mkEXIT (ExitKind.FRAGMENT, xs)
231            fun mkSINIT xs = mkEXIT (ExitKind.SINIT, xs)
232          fun mkRETURN xs = mkEXIT (ExitKind.RETURN, xs)          fun mkRETURN xs = mkEXIT (ExitKind.RETURN, xs)
233          fun mkACTIVE xs = mkEXIT (ExitKind.ACTIVE, xs)          fun mkACTIVE xs = mkEXIT (ExitKind.ACTIVE, xs)
234          fun mkSTABILIZE xs = mkEXIT (ExitKind.STABILIZE, xs)          fun mkSTABILIZE xs = mkEXIT (ExitKind.STABILIZE, xs)
# Line 566  Line 322 
322  raise ex)  raise ex)
323          fun replaceOutEdge {oldSrc, src, dst} = (          fun replaceOutEdge {oldSrc, src, dst} = (
324              (* first set the successor of src *)              (* first set the successor of src *)
325                setSucc (src, dst);                case kind oldSrc
326                   of COND{trueBranch, falseBranch, ...} =>
327                        if same(!trueBranch, dst)
328                          then setTrueBranch (src, dst)
329                          else setFalseBranch (src, dst)
330                    | _ => setSucc (src, dst)
331                  (* end case *);
332              (* then set the predecessor of dst *)              (* then set the predecessor of dst *)
333                case kind dst                case kind dst
334                 of JOIN{preds, ...} => let                 of JOIN{preds, ...} => let
# Line 713  Line 475 
475                    Node.setSucc (exit, nd);                    Node.setSucc (exit, nd);
476                    CFG{entry=entry, exit=nd})                    CFG{entry=entry, exit=nd})
477    
478          (* update the exit of a CFG by modifying the live variable list *)
479            fun updateExit (CFG{entry, exit as ND{kind, ...}}, f) = let
480                  val newExit = (case kind
481                         of EXIT{pred, kind, live} => let
482                              val newNd = Node.mkEXIT(kind, f live)
483                              in
484                                Node.replaceInEdge {src = !pred, oldDst = exit, dst = newNd};
485                                newNd
486                              end
487                          | _ => raise Fail "bogus exit node for updateExit"
488                        (* end case *))
489                  in
490                    CFG{entry=entry, exit=newExit}
491                  end
492          end
493    
494        structure RHS =
495          struct
496            fun vars rhs = (case rhs
497                   of VAR x => [x]
498                    | LIT _ => []
499                    | OP(rator, xs) => xs
500                    | APPLY(g, xs) => xs
501                    | CONS(ty, xs) => xs
502                  (* end case *))
503    
504            fun map f = let
505                  fun mapf rhs = (case rhs
506                         of VAR x => VAR(f x)
507                          | LIT _ => rhs
508                          | OP(rator, xs) => OP(rator, List.map f xs)
509                          | APPLY(g, xs) => APPLY(g, List.map f xs)
510                          | CONS(ty, xs) => CONS(ty, List.map f xs)
511                        (* end case *))
512                  in
513                    mapf
514                  end
515    
516            fun app f = let
517                  fun mapf rhs = (case rhs
518                         of VAR x => f x
519                          | LIT _ => ()
520                          | OP(rator, xs) => List.app f xs
521                          | APPLY(_, xs) => List.app f xs
522                          | CONS(ty, xs) => List.app f xs
523                        (* end case *))
524                  in
525                    mapf
526        end        end
527    
528    (* return a string representation of a rhs *)    (* return a string representation of a rhs *)
529      fun rhsToString rhs = (case rhs          fun toString rhs = (case rhs
530             of VAR x => Var.toString x             of VAR x => Var.toString x
531              | LIT lit => Literal.toString lit              | LIT lit => Literal.toString lit
532              | OP(rator, xs) => String.concat [              | OP(rator, xs) => String.concat [
# Line 732  Line 542 
542                    String.concatWith "," (List.map Var.toString xs), "]"                    String.concatWith "," (List.map Var.toString xs), "]"
543                  ]                  ]
544            (* end case *))            (* end case *))
545          end
546    
547    (* return a string representation of a variable binding *)    (* return a string representation of a variable binding *)
548      fun vbToString VB_NONE = "NONE"      fun vbToString VB_NONE = "NONE"
549        | vbToString (VB_RHS rhs) = concat["RHS(", rhsToString rhs, ")"]        | vbToString (VB_RHS rhs) = concat["RHS(", RHS.toString rhs, ")"]
550        | vbToString (VB_PHI xs) = concat[        | vbToString (VB_PHI xs) = concat[
551              "PHI(", String.concatWith "," (List.map Var.toString xs), ")"              "PHI(", String.concatWith "," (List.map Var.toString xs), ")"
552            ]            ]
# Line 750  Line 561 
561    
562    (* return a string representation of an assignment *)    (* return a string representation of an assignment *)
563      fun assignToString (y, rhs) =      fun assignToString (y, rhs) =
564            String.concat [Ty.toString(Var.ty y), " ", Var.toString y, " = ", rhsToString rhs]            String.concat [Ty.toString(Var.ty y), " ", Var.toString y, " = ", RHS.toString rhs]
565    
566    end (* SSAFn *)    end (* SSAFn *)

Legend:
Removed from v.1116  
changed lines
  Added in v.1232

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