Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] View of /trunk/src/compiler/IL/ssa-fn.sml
ViewVC logotype

View of /trunk/src/compiler/IL/ssa-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 198 - (download) (annotate)
Mon Aug 2 21:26:57 2010 UTC (9 years, 3 months ago) by jhr
File size: 5201 byte(s)
  Starting to add utility code for SSA representations
(* 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.
 *)

signature SSA =
  sig

    structure Op : OPERATORS

    datatype program = Program of {
	globals : var list,
	globalInit : stmt,
	actors : actor list
	(* initialization *)
      }

    and actor = Actor of {
	name : Atom.atom,
	params : var list,
	state : var list,
	stateInit : stmt,
	methods : method list
      }

    and method = Method of Atom.atom * stmt

    and 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)

    val same : stmt * stmt -> bool
    val compare : stmt * stmt -> order
    val hash : stmt -> word

    val succs : stmt -> stmt list

  (* set the successor of a statement *)
    val setSucc : stmt * stmt -> unit

    val preds : stmt -> stmt list

    val addPred : stmt * stmt -> unit

    val dummy : stmt

    val mkBLOCK : {succ : stmt, body : assign list} -> stmt
    val mkIF : {cond : var, thenBranch : stmt, elseBranch : stmt} -> stmt
    val mkLOOP : {hdr : stmt, cond : var, body : stmt, exit : stmt} -> stmt
    val mkNEW : {actor : Atom.atom, args : var list, succ : stmt} -> stmt
    val mkDIE : unit -> stmt
    val mkSTABILIZE : unit -> stmt
    val mkEXIT : unit -> stmt

    val newVar : string -> var

  end

functor SSAFn (Op : OPERATORS) : SSA =
  struct

    structure Op = Op

    datatype program = Program of {
	globals : var list,
	globalInit : stmt,
	actors : actor list
	(* initialization *)
      }

    and actor = Actor of {
	name : Atom.atom,
	params : var list,
	state : var list,
	stateInit : stmt,
	methods : method list
      }

    and method = Method of Atom.atom * stmt

    and 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 mkNEW args = mkSTM(NEW args)
    fun mkDIE () = mkSTM DIE
    fun mkSTABILIZE () = mkSTM STABILIZE
    fun mkEXIT () = mkSTM EXIT

    fun newVar name = V{
	    name = name,
	    id = Stamp.new(),
	    useCnt = ref 0,
	    props = PropList.newHolder()
	  }

  end

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