(* ssa-fn.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2015 The University of Chicago
 * All rights reserved.
 *
 * The SSAFn functor is used to generate the High, Med, and Low ILs in the Diderot
 * compiler.  These ILs have the same program and control-flow structure, but differ
 * in their types and operators.
 *)

functor SSAFn (

    val ilName : string
    structure Ty : SSA_TYPES
    structure Op : OPERATORS where type ty = Ty.ty

  ) : SSA = struct

    structure Ty = Ty
    structure Op = Op

    val ilName = ilName

  (***** strand state variables *****)

    datatype state_var = SV of {
        id : Stamp.stamp,               (* variable's unique ID *)
        name : string,                  (* variable's name *)
        ty : Ty.ty,                     (* variable's type *)
        output : bool,                  (* true for output variables *)
        props : PropList.holder
      }

  (***** 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
          }
      | MASSIGN of {                    (* multi-assignment *)
            pred : node ref,
            stm : massign,
            succ : node ref
          }
      | NEW of {                        (* create new strand instance *)
            pred : node ref,
            strand : Atom.atom,
            args : var list,
            succ : node ref
          }
      | SAVE of {                       (* save state variable *)
            pred: node ref,
            lhs : state_var,
            rhs : var,
            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
      = STATE of state_var              (* read strand state variable *)
      | VAR of var
      | LIT of Literal.literal
      | OP of Op.rator * var list
      | APPLY of MathFuns.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_MULTIOP of int * Op.rator * var list
                                        (* n'th result of operator in multi-assignment *)
      | VB_PHI of var list              (* defined by a phi node *)
      | VB_PARAM                        (* parameter to a strand *)

    withtype assign = (var * rhs)
         and massign = (var list * Op.rator * var list)
         and phi = (var * var list)

    datatype assignment = ASSGN of assign | MASSGN of massign

  (***** Program representation *****)

    datatype program = Program of {
        props : StrandUtil.program_prop list,
        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,
        create : (cfg * Atom.atom * var list)
      }

    and strand = Strand of {
        name : Atom.atom,
        params : var list,
        state : state_var list,
        stateInit : cfg,
        methods : method list
      }

    and method = Method of {
        name : StrandUtil.method_name,
        body : cfg              (* method body *)
      }

    structure StateVar =
      struct
        fun new (isOut, name, ty) = SV{
                id = Stamp.new(),
                name = name,
                ty = ty,
                output = isOut,
                props = PropList.newHolder()
              }
        fun name (SV{name, ...}) = name
        fun ty (SV{ty, ...}) = ty
        fun isOutput (SV{output, ...}) = output
        fun same (SV{id=a, ...}, SV{id=b, ...}) = Stamp.same(a, b)
        fun compare (SV{id=a, ...}, SV{id=b, ...}) = Stamp.compare(a, b)
        fun hash (SV{id, ...}) = Stamp.hash id
        fun toString (SV{name, ...}) = "self." ^ name
      (* properties *)
        fun newProp initFn = PropList.newProp (fn (SV{props, ...}) => props, initFn) 
        fun newFlag () = PropList.newFlag (fn (SV{props, ...}) => props) 
      (* collections *)
        local
          structure V =
            struct
              type ord_key = state_var
              val compare = compare
            end
        in
        structure Map = RedBlackMapFn (V)
        structure Set = RedBlackSetFn (V)
        end
        structure Tbl = HashTableFn (
          struct
            type hash_key = state_var
            val hashVal = hash
            val sameKey = same
          end)
      end

    structure Var =
      struct
        fun new (name, ty) = V{
                name = name,
                id = Stamp.new(),
                ty = ty,
                bind = ref VB_NONE,
                useCnt = ref 0,
                props = PropList.newHolder()
              }
        fun copy (V{name, ty, ...}) = new (name, ty)
        fun name (V{name, ...}) = name
        fun ty (V{ty, ...}) = ty
        fun binding (V{bind, ...}) = !bind
        fun setBinding (V{bind, ...}, vb) = bind := vb
        fun useCount (V{useCnt, ...}) = !useCnt
        fun same (V{id=a, ...}, V{id=b, ...}) = Stamp.same(a, b)
        fun compare (V{id=a, ...}, V{id=b, ...}) = Stamp.compare(a, b)
        fun hash (V{id, ...}) = Stamp.hash id
        fun toString (V{name, id, ...}) = name ^ Stamp.toString id
      (* properties *)
        fun newProp initFn = PropList.newProp (fn (V{props, ...}) => props, initFn) 
        fun newFlag () = PropList.newFlag (fn (V{props, ...}) => props) 
      (* collections *)
        local
          structure V =
            struct
              type ord_key = var
              val compare = compare
            end
        in
        structure Map = RedBlackMapFn (V)
        structure Set = RedBlackSetFn (V)
        end
        structure Tbl = HashTableFn (
          struct
            type hash_key = var
            val hashVal = hash
            val sameKey = same
          end)
      end

    structure Node =
      struct
        fun id (ND{id, ...}) = id
        fun kind (ND{kind, ...}) = kind
        fun same (ND{id=a, ...}, ND{id=b, ...}) = Stamp.same(a, b)
        fun compare (ND{id=a, ...}, ND{id=b, ...}) = Stamp.compare(a, b)
        fun hash (ND{id, ...}) = Stamp.hash id
        fun toString (ND{id, kind, ...}) = let
              val tag = (case kind
                     of NULL => "NULL"
                      | ENTRY _ => "ENTRY"
                      | JOIN _ => "JOIN"
                      | COND _ => "COND"
                      | COM _ => "COM"
                      | ASSIGN _ => "ASSIGN"
                      | MASSIGN _ => "MASSIGN"
                      | NEW _ => "NEW"
                      | SAVE _ => "SAVE"
                      | EXIT{kind, ...} => ExitKind.toString kind
                    (* end case *))
              in
                tag ^ Stamp.toString id
              end
        fun new kind = ND{id = Stamp.new(), props = PropList.newHolder(), kind = kind}
      (* variable defs and uses *)
        fun uses (ND{kind, ...}) = (case kind
               of JOIN{phis, ...} => List.foldr (fn ((_, xs), ys) => xs@ys) [] (!phis)
                | COND{cond, ...} => [cond]
                | ASSIGN{stm=(y, rhs), ...} => (case rhs
                     of STATE _ => []
                      | VAR x => [x]
                      | LIT _ => []
                      | OP(_, args) => args
                      | APPLY(_, args) => args
                      | CONS(_, args) => args
                    (* end case *))
                | MASSIGN{stm=(_, _, args), ...} => args
                | NEW{args, ...} => args
                | SAVE{rhs, ...} => [rhs]
                | EXIT{live, ...} => live
                | _ => []
              (* end case *))
        fun defs (ND{kind, ...}) = (case kind
               of JOIN{phis, ...} => List.map #1 (!phis)
                | ASSIGN{stm=(y, _), ...} => [y]
                | MASSIGN{stm=(ys, _, _), ...} => ys
                | _ => []
              (* end case *))
        val dummy = new NULL
        fun mkENTRY () = new (ENTRY{succ = ref dummy})
        fun mkJOIN phis = new (JOIN{preds = ref [], phis = ref phis, succ = ref dummy})
        fun mkCOND {cond, trueBranch, falseBranch} = new (COND{
                pred = ref dummy, cond = cond,
                trueBranch = ref trueBranch, falseBranch = ref falseBranch
              })
        fun mkCOM text = new (COM{pred = ref dummy, text = text, succ = ref dummy})
        fun mkASSIGN (lhs, rhs) = (
              Var.setBinding (lhs, VB_RHS rhs);
              new (ASSIGN{pred = ref dummy, stm = (lhs, rhs), succ = ref dummy}))
        fun mkMASSIGN (lhs, rator, args) = let
              fun setB (_, []) = ()
                | setB (i, x::xs) = (
                    Var.setBinding (x, VB_MULTIOP(i, rator, args));
                    setB (i+1, xs))
              in
                setB (0, lhs);
                new (MASSIGN{pred = ref dummy, stm = (lhs, rator, args), succ = ref dummy})
              end
        fun mkNEW {strand, args} = new (NEW{
                pred = ref dummy, strand = strand, args = args, succ = ref dummy
              })
        fun mkSAVE (lhs, rhs) = new (SAVE{
                pred = ref dummy, lhs = lhs, rhs = rhs, succ = ref dummy
              })
        fun mkEXIT (kind, xs) = new (EXIT{kind = kind, live = xs, pred = ref dummy})
        fun mkFRAGMENT xs = mkEXIT (ExitKind.FRAGMENT, xs)
        fun mkSINIT () = mkEXIT (ExitKind.SINIT, [])
        fun mkRETURN xs = mkEXIT (ExitKind.RETURN, xs)
        fun mkACTIVE () = mkEXIT (ExitKind.ACTIVE, [])
        fun mkSTABILIZE () = mkEXIT (ExitKind.STABILIZE, [])
        fun mkDIE () = mkEXIT (ExitKind.DIE, [])
        fun isNULL (ND{kind=NULL, ...}) = true
          | isNULL _ = false
      (* editing node edges *)
        fun hasPred (ND{kind, ...}) = (case kind
               of NULL => false
                | ENTRY _ => false
                | _ => true
              (* end case *))
        fun setPred (nd0 as ND{kind, ...}, nd) = (case kind
               of NULL => raise Fail("setPred on NULL node " ^ toString nd0)
                | ENTRY _ => raise Fail("setPred on ENTRY node " ^ toString nd0)
                | JOIN{preds, ...} => if List.exists (fn nd' => same(nd, nd')) (!preds)
                    then ()
                    else preds := !preds @ [nd]  (* assume preds are added in order *)
                | COND{pred, ...} => pred := nd
                | COM{pred, ...} => pred := nd
                | ASSIGN{pred, ...} => pred := nd
                | MASSIGN{pred, ...} => pred := nd
                | NEW{pred, ...} => pred := nd
                | SAVE{pred, ...} => pred := nd
                | EXIT{pred, ...} => pred := nd
              (* end case *))
        fun preds (nd as ND{kind, ...}) = (case kind
               of NULL => [] (*raise Fail("preds on NULL node "^toString nd)*)
                | ENTRY _ => []
                | JOIN{preds, ...} => !preds
                | COND{pred, ...} => [!pred]
                | COM{pred, ...} => [!pred]
                | ASSIGN{pred, ...} => [!pred]
                | MASSIGN{pred, ...} => [!pred]
                | NEW{pred, ...} => [!pred]
                | SAVE{pred, ...} => [!pred]
                | EXIT{pred, ...} => [!pred]
              (* end case *))
        fun hasSucc (ND{kind, ...}) = (case kind
               of NULL => false
                | ENTRY _ => true
                | JOIN _ => true
                | COND _ => true
                | COM _ => true
                | ASSIGN _ => true
                | MASSIGN _ => true
                | NEW _ => true
                | SAVE _ => true
                | EXIT _ => false
              (* end case *))
        fun setSucc (nd0 as ND{kind, ...}, nd) = (case kind
               of NULL => raise Fail("setSucc on NULL node "^toString nd0)
                | ENTRY{succ} => succ := nd
                | JOIN{succ, ...} => succ := nd
                | COND _ => raise Fail("setSucc on COND node "^toString nd0)
                | COM{succ, ...} => succ := nd
                | ASSIGN{succ, ...} => succ := nd
                | MASSIGN{succ, ...} => succ := nd
                | NEW{succ, ...} => succ := nd
                | SAVE{succ, ...} => succ := nd
                | EXIT _ => raise Fail("setSucc on EXIT node "^toString nd0)
              (* end case *))
        fun succs (nd as ND{kind, ...}) = (case kind
               of NULL => [] (*raise Fail("succs on NULL node "^toString nd)*)
                | ENTRY{succ} => [!succ]
                | JOIN{succ, ...} => [!succ]
                | COND{trueBranch, falseBranch, ...} => [!trueBranch, !falseBranch]
                | COM{succ, ...} => [!succ]
                | ASSIGN{succ, ...} => [!succ]
                | MASSIGN{succ, ...} => [!succ]
                | NEW{succ, ...} => [!succ]
                | SAVE{succ, ...} => [!succ]
                | EXIT _ => []
              (* end case *))
        fun setTrueBranch (ND{kind=COND{trueBranch, ...}, ...}, nd) = trueBranch := nd
          | setTrueBranch (nd, _) = raise Fail("setTrueBranch on " ^ toString nd)
        fun setFalseBranch (ND{kind=COND{falseBranch, ...}, ...}, nd) = falseBranch := nd
          | setFalseBranch (nd, _) = raise Fail("setFalseBranch on " ^ toString nd)
        fun addEdge (nd1, nd2) = (
              if hasSucc nd1
                then (
                  setSucc (nd1, nd2);
                  setPred (nd2, nd1))
                else ())
(*DEBUG*)handle ex => (
print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);
raise ex)
        fun replaceInEdge {src, oldDst, dst} = (
            (* first set the successor of src *)
              case kind src
               of COND{trueBranch, falseBranch, ...} =>
                    if same(!trueBranch, oldDst)
                      then trueBranch := dst
                      else falseBranch := dst
                | _ => setSucc (src, dst)
              (* end case *);
            (* then set the predecessor of dst *)
              setPred (dst, src))
(*DEBUG*)handle ex => (
print(concat["error in replaceInEdge(", toString src, ",", toString oldDst, ",", toString dst, ")\n"]);
raise ex)
        fun replaceOutEdge {oldSrc, src, dst} = (
            (* first set the successor of src *)
              case kind oldSrc
               of COND{trueBranch, falseBranch, ...} =>
                    if same(!trueBranch, dst)
                      then setTrueBranch (src, dst)
                      else setFalseBranch (src, dst)
                | _ => setSucc (src, dst)
              (* end case *);
            (* then set the predecessor of dst *)
              case kind dst
               of JOIN{preds, ...} => let
                    fun edit [] = raise Fail "replaceOutEdge: cannot find predecessor"
                      | edit (nd::nds) = if same(nd, oldSrc) then src::nds else nd::edit nds
                    in
                      preds := edit (!preds)
                    end
                | _ => setPred (dst, src)
              (* end case *))
(*DEBUG*)handle ex => (
print(concat["error in replaceOutEdge(", toString oldSrc, ",", toString src, ",", toString dst, ")\n"]);
raise ex)
      (* properties *)
        fun newProp initFn =
              PropList.newProp (fn (ND{props, ...}) => props, initFn) 
        fun newFlag () =
              PropList.newFlag (fn (ND{props, ...}) => props) 
      end

    structure CFG =
      struct
        val empty = CFG{entry = Node.dummy, exit = Node.dummy}

        fun isEmpty (CFG{entry, exit}) =
              Node.same(entry, exit) andalso Node.isNULL entry

      (* create a basic block from a list of assignments *)
        fun mkBlock [] = empty
          | mkBlock (stm::stms) = let
              fun mkNode (ASSGN stm) = Node.mkASSIGN stm
                | mkNode (MASSGN stm) = Node.mkMASSIGN stm
              val entry = mkNode stm
              fun f (stm, prev) = let
                    val nd = mkNode stm
                    in
                      Node.addEdge (prev, nd);
                      nd
                    end
              val exit = List.foldl f entry stms
              in
                CFG{entry = entry, exit = exit}
              end

      (* entry/exit nodes of a CFG *)
        fun entry (CFG{entry = nd, ...}) = nd
        fun exit (CFG{exit = nd, ...}) = nd

      (* return the list of variables that are live at exit from a CFG *)
        fun liveAtExit cfg = (case Node.kind(exit cfg)
               of EXIT{live, ...} => live
                | _ => raise Fail "bogus exit node"
              (* end case *))

      (* DFS sorting of the graph rooted at the entry to a statement; the resulting list will
       * be in preorder with parents before children.
       *)
        fun sort (CFG{entry, ...}) = let
              val {getFn, setFn} = PropList.newFlag (fn (ND{props, ...}) => props)
              fun dfs (nd, l) =
                    if getFn nd
                      then l
                      else (
                        setFn (nd, true);
                        nd :: List.foldl dfs l (Node.succs nd))
              val nodes = dfs (entry, [])
              in
                List.app (fn nd => setFn(nd, false)) nodes;
                nodes
              end

      (* apply a function to all of the nodes in the graph rooted at the entry to the statement *)
        fun apply (f : node -> unit) (CFG{entry, ...}) = let
              val {getFn, setFn} = Node.newFlag()
              fun dfs (nd, l) =
                    if getFn nd
                      then l
                      else (
                        f nd; (* visit *)
                        setFn (nd, true);
                        nd :: List.foldl dfs l (Node.succs nd))
              val nodes = dfs (entry, [])
              in
                List.app (fn nd => setFn(nd, false)) nodes
              end

      (* delete a simple node from a CFG *)
        fun deleteNode (nd as ND{kind, ...}) = let
              val (pred, succ) = (case kind
                     of COM{pred = ref pred, succ = ref succ, ...} => (pred, succ)
                      | ASSIGN{pred = ref pred, succ = ref succ, ...} => (pred, succ)
                      | MASSIGN{pred = ref pred, succ = ref succ, ...} => (pred, succ)
                      | NEW{pred = ref pred, succ = ref succ, ...} => (pred, succ)
                      | SAVE{pred = ref pred, succ = ref succ, ...} => (pred, succ)
                      | _ => raise Fail(concat["unsupported deleteNode(", Node.toString nd, ")\n"])
                    (* end case *))
              in
                Node.setPred (succ, pred);
                case Node.kind pred
                  of COND{trueBranch, falseBranch, ...} => (
                     (* note that we treat each branch independently, so that we handle the
                      * situation where both branches are the same node.
                      *)
                       if Node.same(!trueBranch, nd)
                         then Node.setTrueBranch(pred, succ)
                         else ();
                       if Node.same(!falseBranch, nd)
                         then Node.setFalseBranch(pred, succ)
                         else ())
                   | _ => Node.setSucc (pred, succ)
                (* end case *)
              end
(*DEBUG*)handle ex => (
print(concat["error in deleteNode(", Node.toString nd, ")\n"]);
raise ex)

      (* replace a simple node in a cfg with a subgraph *)
        fun replaceNode (oldNd as ND{kind, ...}, node) = (case kind
               of ASSIGN{pred, succ, ...} => (
                    Node.replaceInEdge {src = !pred, oldDst = oldNd, dst = node};
                    Node.replaceOutEdge {oldSrc = oldNd, src = node, dst = !succ})
                | MASSIGN{pred, succ, ...} => (
                    Node.replaceInEdge {src = !pred, oldDst = oldNd, dst = node};
                    Node.replaceOutEdge {oldSrc = oldNd, src = node, dst = !succ})
                | NEW{pred, succ, ...} => (
                    Node.replaceInEdge {src = !pred, oldDst = oldNd, dst = node};
                    Node.replaceOutEdge {oldSrc = oldNd, src = node, dst = !succ})
                | SAVE{pred, succ, ...} => (
                    Node.replaceInEdge {src = !pred, oldDst = oldNd, dst = node};
                    Node.replaceOutEdge {oldSrc = oldNd, src = node, dst = !succ})
                | EXIT{pred, ...} =>
                    Node.replaceInEdge {src = !pred, oldDst = oldNd, dst = node}
                | _ => raise Fail "unsupported replaceNode"
              (* end case *))

      (* replace a simple node in a cfg with a subgraph *)
        fun replaceNodeWithCFG (nd as ND{kind, ...}, cfg as CFG{entry, exit}) =
              if isEmpty cfg
                then deleteNode nd
                else (case kind
                   of ASSIGN{pred, succ, ...} => (
                        Node.replaceInEdge {src = !pred, oldDst = nd, dst = entry};
                        Node.replaceOutEdge {oldSrc = nd, src = exit, dst = !succ})
                    | MASSIGN{pred, succ, ...} => (
                        Node.replaceInEdge {src = !pred, oldDst = nd, dst = entry};
                        Node.replaceOutEdge {oldSrc = nd, src = exit, dst = !succ})
                    | _ => raise Fail "unsupported replaceNodeWithCFG"
                  (* end case *))

      (* concatenate two CFGs *)
        fun concat (cfg1 as CFG{entry=e1, exit=x1}, cfg2 as CFG{entry=e2, exit=x2}) =
              if isEmpty cfg1 then cfg2
              else if isEmpty cfg2 then cfg1
              else (
                Node.setSucc (x1, e2);
                Node.setPred (e2, x1);
                CFG{entry = e1, exit = x2})
(*DEBUG*)handle ex => (
print(String.concat["error in concat({", Node.toString e1, ",", Node.toString x1,
"},{", Node.toString e2, ",", Node.toString x2, "})\n"]);
raise ex)

      (* prepend a node to a CFG *)
        fun prependNode (nd, cfg as CFG{entry, exit}) =
              if isEmpty cfg
                then CFG{entry=nd, exit=nd}
                else (
                  Node.setSucc (nd, entry);
                  Node.setPred (entry, nd);
                  CFG{entry=nd, exit=exit})

      (* append a node to a CFG *)
        fun appendNode (cfg as CFG{entry, exit}, nd) =
              if isEmpty cfg
                then CFG{entry=nd, exit=nd}
                else (
                  Node.setPred (nd, exit);
                  Node.setSucc (exit, nd);
                  CFG{entry=entry, exit=nd})

      (* update the exit of a CFG by modifying the live variable list *)
        fun updateExit (CFG{entry, exit as ND{kind, ...}}, f) = let
              val newExit = (case kind
                     of EXIT{pred, kind, live} => let
                          val newNd = Node.mkEXIT(kind, f live)
                          in
                            Node.replaceInEdge {src = !pred, oldDst = exit, dst = newNd};
                            newNd
                          end
                      | _ => raise Fail "bogus exit node for updateExit"
                    (* end case *))
              in
                CFG{entry=entry, exit=newExit}
              end
      end

    structure RHS =
      struct
        fun vars rhs = (case rhs
               of STATE x => []
                | VAR x => [x]
                | LIT _ => []
                | OP(rator, xs) => xs
                | APPLY(g, xs) => xs
                | CONS(ty, xs) => xs
              (* end case *))

        fun map f = let
              fun mapf rhs = (case rhs
                     of STATE _ => rhs
                      | VAR x => VAR(f x)
                      | LIT _ => rhs
                      | OP(rator, xs) => OP(rator, List.map f xs)
                      | APPLY(g, xs) => APPLY(g, List.map f xs)
                      | CONS(ty, xs) => CONS(ty, List.map f xs)
                    (* end case *))
              in
                mapf
              end

        fun app f = let
              fun appf rhs = (case rhs
                     of STATE _ => ()
                      | VAR x => f x
                      | LIT _ => ()
                      | OP(rator, xs) => List.app f xs
                      | APPLY(_, xs) => List.app f xs
                      | CONS(ty, xs) => List.app f xs
                    (* end case *))
              in
                appf
              end

      (* return a string representation of a rhs *)
        fun toString rhs = (case rhs
               of STATE x => StateVar.toString x
                | VAR x => Var.toString x
                | LIT lit => Literal.toString lit
                | OP(rator, xs) => String.concat [
                      Op.toString rator,
                      "(", String.concatWith "," (List.map Var.toString xs), ")"
                    ]
                | APPLY(f, xs) => String.concat [
                      MathFuns.toString f,
                      "(", String.concatWith "," (List.map Var.toString xs), ")"
                    ]
                | CONS(ty, xs) => String.concat [
                      "<", Ty.toString ty, ">[",
                      String.concatWith "," (List.map Var.toString xs), "]"
                    ]
              (* end case *))
      end

  (* return a string representation of a variable binding *)
    fun vbToString VB_NONE = "NONE"
      | vbToString (VB_RHS rhs) = concat["RHS(", RHS.toString rhs, ")"]
      | vbToString (VB_MULTIOP(i, rator, xs)) = concat[
            "MULTIOP(", Op.toString rator,
            "[", String.concatWith "," (List.map Var.toString xs), "])"
          ]
      | vbToString (VB_PHI xs) = concat[
            "PHI(", String.concatWith "," (List.map Var.toString xs), ")"
          ]
      | vbToString VB_PARAM = "PARAM"

  (* return a string representation of a PHI node *)
    fun phiToString (y, xs) = String.concat [
            Ty.toString(Var.ty y), " ", Var.toString y, " = PHI(",
            String.concatWith "," (List.map Var.toString xs), ")"
          ]

  (* return a string representation of an assignment *)
    fun assignToString (y, rhs) =
          String.concat [Ty.toString(Var.ty y), " ", Var.toString y, " = ", RHS.toString rhs]
    fun massignToString (ys, rator, xs) = String.concat [
            "(", String.concatWith ","
              (List.map (fn y => concat[Ty.toString(Var.ty y), " ", Var.toString y]) ys),
            " = ", Op.toString rator,
            "(", String.concatWith "," (List.map Var.toString xs), ")"
          ]
    fun assignmentToString (ASSGN asgn) = assignToString asgn
      | assignmentToString (MASSGN masgn) = massignToString masgn

  end (* SSAFn *)

<script type="text/javascript">//<![CDATA[
		function toggle_ffErrors() {
			var errorsblock = document.getElementById("ffErrorsBlock");
			var errorsgroup = document.getElementById("ffErrors");
			if (errorsblock.style.display == "none") {
				errorsblock.style.display = "block";
				errorsgroup.style.right = "10px";
			} else {
				errorsblock.style.display = "none";
				errorsgroup.style.right = "300px";
			}
		}
//]]></script>
<div id="ffErrors">
<a href="javascript:toggle_ffErrors();">Click to toggle</a>
<div id="ffErrorsBlock">
	<div class="error">does not end with &lt;/html&gt; tag</div>
	<div class="error">does not end with &lt;/body&gt; tag</div>
	<div class="info">The output has ended thus: gnToString asgn
      | assignmentToString (MASSGN masgn) = massignToString masgn

  end (* SSAFn *)</div>
</div></div>
</body></html>