(* ssa-fn.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
 * All rights reserved.
 *
 * The IL is a combination of a block-structured tree and an SSA control-flow
 * graph of blocks.
 *)

functor SSAFn (Op : OPERATORS) (*: SSA*) =
  struct

    structure Op = Op

    datatype stmt = STM of {
	id : Stamp.stamp,
	props : PropList.holder,
	preds : stmt list ref,
	phis : (var * var list) list ref,	(* phi statements *)
	kind : stmt_kind ref
      }

    and stmt_kind
      = BLOCK of {
	    succ : stmt,
	    body : assign list
	  }
      | IF of {
	    cond : var,
	    thenBranch : stmt,
	    elseBranch : stmt
	  }
      | LOOP of {
	    hdr : stmt,
	    cond : var,
	    body : stmt,
	    exit : stmt
	  }
      | NEW of {
	    actor : Atom.atom,
	    args : var list,
	    succ : stmt
	  }
      | DIE
      | STABILIZE
      | EXIT

    and rhs
      = VAR of var
      | LIT of Literal.literal
      | OP of Op.rator * var list
      | CONS of var list		(* tensor-value construction *)

    and var = V of {
	name : string,			(* name *)
	id : Stamp.stamp,		(* unique ID *)
	useCnt : int ref,		(* count of uses *)
	props : PropList.holder
      }

    withtype assign = (var * rhs)

    fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
    fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
    fun hash (STM{id, ...}) = Stamp.hash id

    fun succs (STM{kind, ...}) = (case !kind
	   of BLOCK{succ, ...} => [succ]
	    | IF{thenBranch, elseBranch, ...} => [thenBranch, elseBranch]
	    | LOOP{exit, ...} => [exit]
	    | NEW{succ, ...} => [succ]
	    | _ => []
	  (* end case *))

  (* set the successor of a statement *)
    fun setSucc (STM{kind, ...}, stm) = (case !kind
	   of BLOCK{succ, body} => kind := BLOCK{succ=stm, body=body}
	    | IF{thenBranch, elseBranch, ...} => (
		setSucc(thenBranch, stm);
		setSucc(elseBranch, stm))
	    | LOOP{hdr, cond, body, exit} => kind := LOOP{hdr=hdr, cond=cond, body=body, exit=stm}
	    | NEW{actor, args, succ} => kind := NEW{actor=actor, args=args, succ=stm}
	    | _ => () (* no successor *)
	  (* end case *))

    fun preds (STM{preds, ...}) = !preds

    fun addPred (STM{preds, ...}, stm) = 
	  if not(List.exists (fn b => same(stm, b)) (!preds))
	    then preds := stm :: !preds
	    else ();

    fun mkSTM kind = STM{
	    id = Stamp.new(),
	    props = PropList.newHolder(),
	    preds = ref [],
	    phis = ref [],
	    kind = ref kind
	  }

    val dummy = mkSTM EXIT

    fun mkBLOCK args = mkSTM(BLOCK args)
    fun mkIF args = mkSTM(IF args)
    fun mkLOOP args = mkSTM(LOOP args)
    fun mkDIE () = mkSTM DIE
    fun mkSTABILIZE () = mkSTM STABILIZE
    fun mkEXIT () = mkSTM EXIT

  end