Initial import of l2c

[snipe.git] / codegen / colororder.sml

(* L2 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
  type igraph = (Temp.temp * x86.oper list) list
  type ordering = Temp.temp list
  
  val colororder : igraph -> ordering
end

structure ColorOrder :> COLORORDER =
struct
  structure T = Temp
  structure X = x86
  
  type igraph = (Temp.temp * x86.oper list) list
  type ordering = Temp.temp list
  
  fun colororder graph =
    let
      val initialWeights = map (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. *)
            List.hd
              (List.map (fn (_, neighbors) => neighbors)
                (List.filter (fn (t, _) => T.compare (t, chosen) = EQUAL) graph))
          val newWeights =
            List.map
              (fn (t, wt) =>
                (t,
                  if (List.exists 
                        (fn X.TEMP t' => (T.compare (t, t') = EQUAL)
                          | _ => 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
    in
      (keepOrdering initialWeights)
    end
end