(* cells-basis.sml
 *
 * COPYRIGHT (c) 2019 The Fellowship of SML/NJ (http://www.smlnj.org)
 * All rights reserved.
 *
 * Description of cell and other updatable cells.
 *
 * -- Allen.
 *)

structure CellsBasis : CELLS_BASIS =
struct

   datatype cellkindInfo = INFO of {name:string, nickname:string}

   type sz          = int (* width in bits *)
   type cell_id     = int (* unique cell identifier *)
   type register_id = int (* encoding of phsyical registers *)
   type register_num = int

   (* Cellkind denote the types of storage cells.
    * This definition is further augumented by architecture specific
    * cells descriptions.  Type cellkind is an equality type.
    *)
   datatype cellkind =
        GP       (* general purpose register *)
      | FP       (* floating point register *)
      | CC       (* condition code register *)

      | MEM      (* memory *)
      | CTRL     (* control dependence *)

      | MISC_KIND of cellkindInfo ref (* client defined *)

   (* This data structure is automatically generated by MDGen to
    * describe a cellkind.
    *)
   datatype cellkindDesc =
        DESC of
        {kind             : cellkind,
         counter          : int ref,
	 dedicated	  : int ref,
	    (* It is sometimes desirable to allocate dedicated
	     * pseudo registers that will get rewritten to something else,
	     * e.g., the virtual frame pointer.
	     * Since these registers are never assigned a register  by
	     * the register allocator, a limited number of these kinds
	     * of registers may be generated.
	     *)
         low              : int,
         high             : int,
         toString         : register_id -> string,
         toStringWithSize : register_id * sz -> string,
         defaultValues    : (register_id * int) list,
         physicalRegs     : cell Array.array ref,
         zeroReg          : register_id option
        }

   and cell =
      CELL of {id   : cell_id,
               col  : cellColor ref,
               desc : cellkindDesc,
               an   : Annotations.annotations ref
              }

   and cellColor =
         MACHINE of register_id
       | PSEUDO
       | ALIASED of cell
       | SPILLED

   val array0 = Array.tabulate(0, fn _ => raise Match) : cell Array.array

   fun error msg = MLRiscErrorMsg.error ("CellBasis", msg)

   val i2s = Int.toString

   fun cellkindToString GP = "GP"
     | cellkindToString FP = "FP"
     | cellkindToString CC = "CC"
     | cellkindToString MEM = "MEM"
     | cellkindToString CTRL = "CTRL"
     | cellkindToString (MISC_KIND(ref(INFO{name, ...}))) = name

   fun cellkindToNickname GP = "r"
     | cellkindToNickname FP = "f"
     | cellkindToNickname CC = "cc"
     | cellkindToNickname MEM = "m"
     | cellkindToNickname CTRL = "ctrl"
     | cellkindToNickname (MISC_KIND(ref(INFO{nickname, ...}))) = nickname

   fun newCellKind{name="GP", ...} = GP
     | newCellKind{name="FP", ...} = FP
     | newCellKind{name="CC", ...} = CC
     | newCellKind{name="MEM", ...} = MEM
     | newCellKind{name="CTRL", ...} = CTRL
     | newCellKind{name, nickname} =
         MISC_KIND(ref(INFO{name=name, nickname=nickname}))

   fun chase(CELL{col=ref(ALIASED c), ...}) = chase(c)
     | chase c = c

   fun registerId(CELL{col=ref(ALIASED c), ...}) = registerId(c)
     | registerId(CELL{col=ref(MACHINE r), ...}) = r
     | registerId(CELL{col=ref(SPILLED), ...}) = ~1
     | registerId(CELL{col=ref(PSEUDO), id, ...}) = id

   fun registerNum(CELL{col=ref(ALIASED c), ...}) = registerNum(c)
     | registerNum(CELL{col=ref(MACHINE r), desc=DESC{low,...}, ...}) = r-low
     | registerNum(CELL{col=ref SPILLED, id, ...}) = ~1
     | registerNum(CELL{col=ref PSEUDO, id, ...}) = id

   fun physicalRegisterNum(CELL{col=ref(ALIASED c), ...}) =
          physicalRegisterNum(c)
     | physicalRegisterNum(CELL{col=ref(MACHINE r),
                           desc=DESC{low,...}, ...}) = r-low
     | physicalRegisterNum(CELL{col=ref SPILLED, id, ...}) =
           error("physicalRegisterNum: SPILLED: "^i2s id)
     | physicalRegisterNum(CELL{col=ref PSEUDO, id, ...}) =
           error("physicalRegisterNum: PSEUDO: "^i2s id)


   fun cellId(CELL{id, ...}) = id

   fun hashCell(CELL{id, ...}) = Word.fromInt id
   fun hashColor c = Word.fromInt(registerId c)
   fun desc(CELL{desc, ...}) = desc
   fun sameCell(c1, c2) = cellId(c1) = cellId(c2)
   fun sameDesc(DESC{counter=x, ...}, DESC{counter=y, ...}) = x=y
   fun sameKind(c1, c2) = sameDesc(desc c1,desc c2)
   fun sameAliasedCell(c1, c2) = sameCell(chase c1, chase c2)
   fun sameColor(c1, c2) = registerId c1 = registerId c2
   fun compareColor(c1, c2) = Int.compare(registerId c1, registerId c2)
   fun cellkind(CELL{desc=DESC{kind, ...}, ...}) = kind
   fun annotations(CELL{an, ...}) = an

   fun setAlias{from, to} =
   let val CELL{id, col, desc=DESC{kind, ...}, ...} = chase from
       val to as CELL{col=colTo, ...} = chase to
   in  if col = colTo then ()  (* prevent self-loops *)
       else if id < 0 then error "setAlias: constant"
       else case (!col, kind)
            of (PSEUDO, _) => col := ALIASED to
             | _           => error "setAlias: non-pseudo"
   end

   fun isConst(CELL{id, ...}) = id < 0

   (* Pretty printing of cells *)
   fun toString(CELL{col=ref(ALIASED c), ...}) = toString(c)
     | toString(c as CELL{desc=DESC{toString, ...}, ...}) =
        toString(registerNum c)

   fun toStringWithSize(c as CELL{desc=DESC{toStringWithSize,...},...},sz) =
        toStringWithSize(registerNum c,sz)

   fun cnv(r, low, high) = if low <= r andalso r <= high then r - low else r
   fun show(DESC{toString, low, high, ...}) r = toString(cnv(r,low,high))
   fun showWithSize(DESC{toStringWithSize, low, high, ...}) (r, sz) =
        toStringWithSize(cnv(r,low,high),sz)

   structure SortedCells =  struct
      type sorted_cells = cell list

      val empty = []

      val size = List.length

      fun enter(cell, l) = let
        val c = registerId cell
        fun f [] = [cell]
           | f (l as (h::t)) =
            let val ch = registerId h
             in  if c < ch then cell::l else if c > ch then h::f t else l
            end
      in f l
      end

      fun member(x, l) =
          let val x = registerId x
          in  List.exists (fn y => registerId y = x) l
          end

      fun rmv(cell, l) = let
        val c = registerId cell
        fun f [] = []
           | f (l as (h::t)) =
            let val ch = registerId h
             in  if c = ch then t
                else if c < ch then l
                else h::f l
            end
      in f l
      end

      fun uniq (cells) =  List.foldl enter [] (map chase cells)

      fun difference([], _) = []
        | difference(l, []) = l
        | difference(l1 as x::xs, l2 as y::ys) =
          let val cx = registerId x and cy = registerId y
          in  if cx = cy then difference(xs,ys)
              else if cx < cy then x::difference(xs,l2)
              else difference(l1,ys)
          end

      fun union(a, []) = a
        | union([], a) = a
        | union(l1 as x::xs, l2 as y::ys) =
          let val cx = registerId x and cy = registerId y
          in  if cx = cy then x::union(xs,ys)
              else if cx < cy then x::union(xs,l2)
              else y::union(l1,ys)
          end

      fun intersect(a, []) = []
        | intersect([], a) = []
        | intersect(l1 as x::xs, l2 as y::ys) =
          let val cx = registerId x and cy = registerId y
          in  if cx = cy then x::intersect(xs,ys)
              else if cx < cy then intersect(xs,l2)
              else intersect(l1,ys)
          end

      fun notEq([], []) = false
        | notEq([], l) = true
        | notEq(_, []) = true
        | notEq(x::l1, y::l2) = registerId x <> registerId y orelse notEq(l1,l2)

      fun eq([], []) = true
        | eq(x::l1, y::l2) = registerId x = registerId y orelse eq(l1,l2)
        | eq(_, _)  = false

      fun return cs = cs

      fun isEmpty [] = true
        | isEmpty _  = false

      fun emptyIntersection(_, []) = true
        | emptyIntersection([], _) = true
        | emptyIntersection(l1 as x::xs, l2 as y::ys) =
          let val cx = registerId x and cy = registerId y
          in  if cx = cy then false
              else if cx < cy then emptyIntersection(xs,l2)
              else emptyIntersection(l1,ys)
          end

      fun nonEmptyIntersection(_, []) = false
        | nonEmptyIntersection([], _) = false
        | nonEmptyIntersection(l1 as x::xs, l2 as y::ys) =
          let val cx = registerId x and cy = registerId y
          in  if cx = cy then true
              else if cx < cy then nonEmptyIntersection(xs,l2)
              else nonEmptyIntersection(l1,ys)
          end
    end

    structure HashTable =
      HashTableFn(type hash_key = cell
                  val hashVal = hashCell
                  val sameKey = sameCell)

    structure ColorTable =
      HashTableFn(type hash_key = cell
                  val hashVal = hashColor
                  val sameKey = sameColor)

    structure CellSet =
      struct
       type cellset = (cellkindDesc * cell list) list
       val empty = []

       fun same(DESC{counter=c1,...}, DESC{counter=c2,...}) = c1=c2

       fun descOf (CELL{desc, ...}) = desc

       fun add (r, cellset:cellset) =
       let val k = descOf r
           fun loop [] = [(k,[r])]
             | loop((x as (k',s))::cellset) =
        	if same(k,k') then (k',r::s)::cellset
        	else x::loop cellset
       in  loop cellset end

       fun rmv (r, cellset:cellset) =
       let val k = descOf r
           val c = registerId r
           fun filter [] = []
             | filter(r::rs) = if registerId r = c then filter rs
                               else r::filter rs
           fun loop [] = []
             | loop((x as (k',s))::cellset) =
        	if same(k,k') then (k',filter s)::cellset else x::loop cellset
       in  loop cellset end

       fun get (k : cellkindDesc) = let
	     fun loop ([] : cellset) = []
	       | loop ((x as (k',s))::cellset) =
		   if same(k, k') then s else loop cellset
	     in
	       loop
	     end

       fun update (k : cellkindDesc) (cellset:cellset, s) = let
	     fun loop [] = [(k,s)]
	       | loop((x as (k',_))::cellset) =
        	   if same(k,k') then (k',s)::cellset else x::loop cellset
	     in
	       loop cellset
	     end

       fun map {from,to} (cellset:cellset) =
       let val CELL{desc=k,...} = from
           val cf = registerId from
           fun trans r = if registerId r = cf then to else r
           fun loop [] = []
             | loop((x as (k',s))::cellset) =
        	if same(k, k') then (k',List.map trans s)::cellset
        	else x::loop cellset
       in  loop cellset end

       val toCellList : cellset -> cell list =
           List.foldr (fn ((_,S),S') => S @ S') []

       (* Pretty print cellset *)
       fun printSet(f,set,S) =
       let fun loop([], S) = "}"::S
             | loop([x], S) = f(chase x)::"}"::S
             | loop(x::xs, S) = f(chase x)::" "::loop(xs, S)
       in  "{"::loop(set, S) end

       fun toString' cellset =
       let fun pr cellset =
           let fun loop((DESC{kind, ...},s)::rest, S)=
                   (case s of
                      [] => loop(rest, S)
                    | _  => cellkindToString kind::"="::
                            printSet(toString,s," "::loop(rest,S))
                   )
                 | loop([],S) = S
           in  String.concat(loop(cellset, []))
           end
       in  pr cellset end

       val toString = toString'
     end (* CellSet *)

    (*
     * These annotations specifies definitions and uses
     * for a pseudo instruction.
     *)
   exception DEF_USE of {cellkind:cellkind, defs:cell list, uses:cell list}
   val DEFUSE = Annotations.new'
                      {create=DEF_USE,
                       get=fn DEF_USE x => x | e => raise e,
                       toString=fn{cellkind,defs,uses} =>
                          "DEFUSE"^cellkindToString cellkind
                      }
    (*
     * Hack for generating memory aliasing cells
     *)
   val memDesc =
        DESC
        {kind             = MEM,
         counter          = ref 0,
	 dedicated	  = ref 0,
         low              = 0,
         high             = ~1,
         toString         = fn m => "m"^i2s m,
         toStringWithSize = fn (m, _) => "m"^i2s m,
         defaultValues    = [],
         physicalRegs     = ref array0,
         zeroReg          = NONE
        }

   fun mem id =  CELL{id=id, an=ref [], desc=memDesc, col=ref(MACHINE id)}

   val array0 = Array.tabulate(0, fn _ => raise Match) : cell Array.array
end