(**********************************************************************)
(* (c) Greg Morrisett, Steve Zdancewic                                *)
(*     June 1998, all rights reserved.                                *)
(**********************************************************************)

(* cfg.mli
 *
 * The datatype for TAL-level control flow graphs.
 *)

open Utilities
open Identifier
open Tal
open Set

exception CfgError of string

(*******************************************************************************)
(* Control flow edges *)

type cf_edge_type = 
    CallEdge        (* A procedure call edge - live registers saved *)
  | TailCall        (* Call to a different procedure's entry block *)
  | SelfTailCall    (* Self recursive (loop) call--bypass any header block *)
  | Return          (* Return from a procedure call *)
  | UnknownCall of con  (* Cross module or unknown function call *)
 	                (* con is code type with no virtual registers *)         
  | Jump            (* Unconditional jump, no live registers will be saved *)
  | Branch          (* Conditional jump, no live registers will be saved *)
  | Sequence        (* Link between blocks that must be sequentially layed out*)
                    (* e.g. branches and Fallthru's, headers and entries *)
  | CallSequence of reg set  (* Links the call block to the return block, with *)
                             (* the return registers in the set *)

type cf_edge = identifier * cf_edge_type * identifier

val compare_edges : cf_edge -> cf_edge -> int

(*******************************************************************************)
(* Control flow (basic) blocks *)

type cf_block = {
    mutable lab: identifier;   (* The unique TAL identifier for the block *)
    mutable con: con option;    (* The type constructor for the entry point *)
    mutable fun_lab: identifier; (* The function to which the block belongs *)
    mutable code: instruction vector;   (* The actual TAL code *)
    mutable call_sites: (int, cf_block) Dict.dict; (* map of callstart sites to *)
                                                (* the block following the call *)

    mutable pred: cf_edge set;  (* The set of incoming edges *)
    mutable succ: cf_edge set;  (* The set of outgoing edges *)

    (* The next 4 fields are used by liveness.ml *)
    mutable use: reg set;   (* Registers used before being defined *)
    mutable def: reg set;   (* Registers defined in the block *)
    mutable live_in: reg set;  (* Registers live on entry to the block *)
    mutable live_out: reg set; (* Registers live on exit from the block *)

    mutable header: bool;     (* Is this a block that allocates spills *)
    mutable visited: bool     (* Has this block been visited on a traversal *)
  } 
    
(* Those blocks which end in unknown jumps, i.e. for exception handlers, *)
(* should have empty successor sets *)

val compare_blocks : cf_block -> cf_block -> int

(* Creates a new block from it's TAL Label, optional constructor information, *)
(* the label of the function the new block is part of, and its code. *)
val make_block : identifier -> con option -> identifier -> instruction vector 
                 -> cf_block

(* The following functions desructively update a block *)
val set_con : cf_block -> con option -> unit
val set_code : cf_block -> instruction vector -> unit

val add_call_site : cf_block -> int -> cf_block -> unit
val get_call_site : cf_block -> int -> cf_block 

(*******************************************************************************)
(* Individual instructions *)

type cf_instr = identifier * int
val compare_instrs : cf_instr -> cf_instr -> int

(*******************************************************************************)
(* Control flow graphs *)

type rewrite_info = {
    mutable sp_slots: int;  (* The number of spill slots used in this function *)
    mutable sp_args: int; (* The number of spilled arguments *)
    mutable sp_rets: int  (* The number of spilled returns *)
  } 

type cf_graph = {
    mutable context: Talctxt.ctxt;   (* The context of the cfg - contains *)
                                     (* imported types *)
    mutable blocks: (identifier, cf_block) Dict.dict;  (* Blocks in the graph *)
    mutable roots: identifier set;   (* The entry blocks of the module *)
    mutable procs: identifier set;   (* The set of procedure labels *)
                                     (* defined in the control flow graph *)
    (* A map from function labels to their argument registers *)
    mutable args: (identifier, reg set) Dict.dict;
    (* A map from function labels to their return registers *)
    mutable rets: (identifier, reg set) Dict.dict;
    (* A map from function labels to the set of regs mentioned in their code *)
    mutable regs: (identifier, reg set) Dict.dict;
    (* A map from function labels to rewrite information about that function *)
    mutable rewrite: (identifier, rewrite_info) Dict.dict;

    mutable df_order: identifier list option; (* Depth-first order from root *)
    mutable rev_order: identifier list option (* Reverse depth-first ordering *)
  } 

val empty_cfg : cf_graph

(* Set or get the context associated with the control flow graph.  The context *)
(* should contain the imported types and function labels that close the module. *)
(* The context is needed for rewriting the code--when registers are spilled, *)
(* their types must be known, which means that the register allocator has to *)
(* track the types of the registers and the stack during the rewrite phase. *)
val set_context : cf_graph -> Talctxt.ctxt -> unit
val get_context : cf_graph -> Talctxt.ctxt

(* Adds a block to the control flow graph.  If a block with the same label *)
(* is already in the graph, then the exception Dict.Present is raised. *)
(* Sets traversal orders to None *)
val add_block : cf_graph -> cf_block -> unit

(* Deletes a block from the graph.  Raises CfgError if there is no such block *)
(* in the graph.  Deletes any edges associated with the given block. *)
(* Also deletes the block id from the set of roots. *)
val del_block : cf_graph -> identifier -> unit

(* Adds an edge to the call graph.  Raises CfgError if there are no blocks *)
(* in the graph with appropriate labels.  Sets the order traversal lists *)
(* to None *)
val add_edge : cf_graph -> cf_edge -> unit
val add_edge_bb : cf_graph -> cf_block -> cf_edge_type -> cf_block -> unit

(* Deletes an edge from the call graph.  Raises CfgError if there is no such *)
(* edge in the graph.  Sets the order traversal lists to NONE *)
val del_edge : cf_graph -> cf_edge -> unit

(* Inserts a label as a root in the control flow graph.  Sets the order *)
(* traversal lists to NONE *)
val add_root : cf_graph -> identifier -> unit
val del_root : cf_graph -> identifier -> unit

(* Inserts/deletes a procedure label into/from the control flow graph. *)
val add_proc : cf_graph -> identifier -> unit
val del_proc : cf_graph -> identifier -> unit

(* Access routines for the argument and return register sets *)
val add_arg : cf_graph -> identifier -> reg -> unit
val del_arg : cf_graph -> identifier -> reg -> unit
val add_ret : cf_graph -> identifier -> reg -> unit
val del_ret : cf_graph -> identifier -> reg -> unit
val get_args : cf_graph -> identifier -> reg set
val get_rets : cf_graph -> identifier -> reg set
val add_regs : cf_graph -> identifier -> reg set -> unit
val get_regs : cf_graph -> identifier -> reg set

val set_rewrite_info : cf_graph -> identifier -> rewrite_info -> unit
val get_rewrite_info : cf_graph -> identifier -> rewrite_info option

(* The following may raise exceptions if the block or instruction isn't in *)
(* the graph *)
val get_block : cf_graph -> identifier -> cf_block
val get_instr : cf_graph -> cf_instr -> instruction

(* Set the traversal orders *)
val set_df_order : cf_graph -> identifier list -> unit
val set_rev_order : cf_graph -> identifier list -> unit
val clear_visited_flags : cf_graph -> unit

(* Fold operation for the control flow graph.   If the optional df_order *)
(* field contains a list of labels, the blocks will be traversed in that order.*)
(* If there is no list there, fold does depth first starting at each root, *)
(* only visiting each block exactly once.  In addition it stores the order *)
(* in which it traversed the graph in df_order for speedier future folds *)
val fold : (cf_block -> 'a -> 'a) -> cf_graph -> 'a -> 'a

(* Folds over a control graph from a single root block.  Does not traverse *)
(* CallEdge, TailCall, Return, or UnknownCall edges.  Useful for folding over *)
(* a single function in the graph. Does not change df_order or rev_order *)
val fold_intra : (cf_block -> 'a -> 'a) -> cf_graph -> identifier -> 'a -> 'a

(* Like fold but uses/stores the order in the rev_order field.  If no order *)
(* is there, it first does a depth-first traversal to determine an order and *)
(* then visits blocks in the reverse direction.*)
val rev_fold : (cf_block -> 'a -> 'a) -> cf_graph -> 'a -> 'a

(* Like fold and rev_fold described above, but only application. *)
val app : (cf_block -> unit) -> cf_graph -> unit
val rev_app : (cf_block -> unit) -> cf_graph -> unit

(* Convert a cfg into a vector of TAL code blocks for use in a module *)
(* implementation *)
val cfg_to_code_blocks : cf_graph -> code_block vector

(* EOF: cfg.mli *)
