Initial import of l3c

[snipe.git] / codegen / colororder.sml

(* L3 Compiler
 * Takes a interference graph and generates an ordering for coloring
 * Author: Joshua Wise <jwise@andrew.cmu.edu>
 * Author: Chris Lu <czl@aundrew.cmu.edu>
 *)

signature COLORORDER =
sig
  structure OperSet : ORD_SET
    where type Key.ord_key = x86.oper
  structure LiveMap : ORD_MAP
    where type Key.ord_key = int
  structure TempMap : ORD_MAP
    where type Key.ord_key = Temp.temp

  type igraph = OperSet.set TempMap.map
  type ordering = Temp.temp list
  
  val colororder : Igraph.graph * Temp.temp list -> ordering
end

structure ColorOrder :> COLORORDER =
struct
  structure T = Temp
  structure X = x86
  
  structure OperSet = Igraph.OperSet
  structure LiveMap = Igraph.LiveMap
  structure TempMap = Igraph.TempMap
  
  type igraph = OperSet.set TempMap.map
  type ordering = Temp.temp list
  
  fun colororder (graph,temps) =
    let
      val initialWeights = TempMap.mapi (fn (t, _) => (t, 0)) graph
      
      fun sortWeights weights =	(* Sort the weights such that the largest is at left, ready to be grabbed. *)
        ListMergeSort.sort (fn ((_, a), (_, b)) => a < b) weights

      (* Chooses one temporary to pick, and updates the weights. *)
      fun orderOne (weights : (Temp.temp * int) list) : Temp.temp * (Temp.temp * int) list =
        let
          val sorted = sortWeights weights
          val (chosen, w) = List.hd sorted	(* Grab the temp with the highest weight. *)
          val remaining = List.tl sorted
          val neighbors =			(* Grab all the neighbors for some given temp. *)
            (OperSet.listItems
              (valOf (TempMap.find (graph, chosen))))
          val newWeights =
            List.map
              (fn (t, wt) =>
                (t,
                  if (List.exists 
                        (fn X.TEMP t' => (T.eq (t, t'))
                          | _ => false)
                        neighbors)
                    then (wt + 1)
                    else wt
                )
              ) remaining
        in
          (chosen, newWeights)
        end
      
      (* Recursively order until we run out of things to order. *)
      fun keepOrdering (nil : (Temp.temp * int) list) : Temp.temp list = nil
        | keepOrdering (weights) =
          let
            val (chosen, newWeights) = orderOne weights
          in
            chosen :: (keepOrdering newWeights)
          end

      val ordered = keepOrdering (TempMap.listItems initialWeights)
    in
      ordered @ (List.filter (fn a => not (List.exists (fn b => Temp.eq (a,b)) ordered)) temps)
    end
end