--- Register colors for drawing conflict graphs
--- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
-
-
--- reg colors for x86
-#if i386_TARGET_ARCH
-regDotColor :: Reg -> SDoc
-regDotColor reg
- = let Just str = lookupUFM regColors reg
- in text str
-
-regColors
- = listToUFM
- $ [ (eax, "#00ff00")
- , (ebx, "#0000ff")
- , (ecx, "#00ffff")
- , (edx, "#0080ff")
-
- , (fake0, "#ff00ff")
- , (fake1, "#ff00aa")
- , (fake2, "#aa00ff")
- , (fake3, "#aa00aa")
- , (fake4, "#ff0055")
- , (fake5, "#5500ff") ]
-#endif
-
-
--- reg colors for x86_64
-#if x86_64_TARGET_ARCH
-regDotColor :: Reg -> SDoc
-regDotColor reg
- = let Just str = lookupUFM regColors reg
- in text str
-
-regColors
- = listToUFM
- $ [ (rax, "#00ff00"), (eax, "#00ff00")
- , (rbx, "#0000ff"), (ebx, "#0000ff")
- , (rcx, "#00ffff"), (ecx, "#00ffff")
- , (rdx, "#0080ff"), (edx, "#00ffff")
- , (r8, "#00ff80")
- , (r9, "#008080")
- , (r10, "#0040ff")
- , (r11, "#00ff40")
- , (r12, "#008040")
- , (r13, "#004080")
- , (r14, "#004040")
- , (r15, "#002080") ]
-
- ++ zip (map RealReg [16..31]) (repeat "red")
-#endif
-
-
--- reg colors for ppc
-#if powerpc_TARGET_ARCH
-regDotColor :: Reg -> SDoc
-regDotColor reg
- = case regClass reg of
- RcInteger -> text "blue"
- RcFloat -> text "red"
-#endif
-
-
-{-
-toX11Color (r, g, b)
- = let rs = padL 2 '0' (showHex r "")
- gs = padL 2 '0' (showHex r "")
- bs = padL 2 '0' (showHex r "")
-
- padL n c s
- = replicate (n - length s) c ++ s
- in "#" ++ rs ++ gs ++ bs
--}
-
-plusUFMs_C :: (elt -> elt -> elt) -> [UniqFM elt] -> UniqFM elt
-plusUFMs_C f maps
- = foldl (plusUFM_C f) emptyUFM maps
-
+-- for when laziness just isn't what you wanted...
+--
+seqGraph :: Color.Graph Reg RegClass Reg -> ()
+seqGraph graph = seqNodes (eltsUFM (Color.graphMap graph))
+
+seqNodes :: [Color.Node Reg RegClass Reg] -> ()
+seqNodes ns
+ = case ns of
+ [] -> ()
+ (n : ns) -> seqNode n `seq` seqNodes ns
+
+seqNode :: Color.Node Reg RegClass Reg -> ()
+seqNode node
+ = seqReg (Color.nodeId node)
+ `seq` seqRegClass (Color.nodeClass node)
+ `seq` seqMaybeReg (Color.nodeColor node)
+ `seq` (seqRegList (uniqSetToList (Color.nodeConflicts node)))
+ `seq` (seqRegList (uniqSetToList (Color.nodeExclusions node)))
+ `seq` (seqRegList (Color.nodePreference node))
+ `seq` (seqRegList (uniqSetToList (Color.nodeCoalesce node)))
+
+seqReg :: Reg -> ()
+seqReg reg
+ = case reg of
+ RealReg _ -> ()
+ VirtualRegI _ -> ()
+ VirtualRegHi _ -> ()
+ VirtualRegF _ -> ()
+ VirtualRegD _ -> ()
+
+seqRegClass :: RegClass -> ()
+seqRegClass c
+ = case c of
+ RcInteger -> ()
+ RcFloat -> ()
+ RcDouble -> ()
+
+seqMaybeReg :: Maybe Reg -> ()
+seqMaybeReg mr
+ = case mr of
+ Nothing -> ()
+ Just r -> seqReg r
+
+seqRegList :: [Reg] -> ()
+seqRegList rs
+ = case rs of
+ [] -> ()
+ (r : rs) -> seqReg r `seq` seqRegList rs
+
+seqList :: [a] -> ()
+seqList ls
+ = case ls of
+ [] -> ()
+ (r : rs) -> r `seq` seqList rs
+
+