Merge remote-tracking branch 'origin/master' into type-nats

Conflicts:
	compiler/coreSyn/CoreLint.lhs
	compiler/deSugar/DsBinds.lhs
	compiler/hsSyn/HsTypes.lhs
	compiler/iface/IfaceType.lhs
	compiler/rename/RnHsSyn.lhs
	compiler/rename/RnTypes.lhs
	compiler/stgSyn/StgLint.lhs
	compiler/typecheck/TcHsType.lhs
	compiler/utils/ListSetOps.lhs

7 files changed, 838 insertions, 803 deletions

diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs
index b9ed3e2643..7ba8efbd03 100644
--- a/compiler/utils/GraphColor.hs
+++ b/compiler/utils/GraphColor.hs
@@ -1,22 +1,13 @@
-{-# OPTIONS -fno-warn-missing-signatures #-}
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 -- | Graph Coloring.
---	This is a generic graph coloring library, abstracted over the type of
---	the node keys, nodes and colors.
+--      This is a generic graph coloring library, abstracted over the type of
+--      the node keys, nodes and colors.
 --
 
-module GraphColor ( 
-	module GraphBase,
-	module GraphOps,
-	module GraphPpr,
-	colorGraph
+module GraphColor (
+        module GraphBase,
+        module GraphOps,
+        module GraphPpr,
+        colorGraph
 )
 
 where
@@ -28,325 +19,351 @@ import GraphPpr
 import Unique
 import UniqFM
 import UniqSet
-import Outputable	
+import Outputable
 
 import Data.Maybe
 import Data.List
-	
+
 
 -- | Try to color a graph with this set of colors.
---	Uses Chaitin's algorithm to color the graph.
---	The graph is scanned for nodes which are deamed 'trivially colorable'. These nodes
---	are pushed onto a stack and removed from the graph.
---	Once this process is complete the graph can be colored by removing nodes from
---	the stack (ie in reverse order) and assigning them colors different to their neighbors.
+--      Uses Chaitin's algorithm to color the graph.
+--      The graph is scanned for nodes which are deamed 'trivially colorable'. These nodes
+--      are pushed onto a stack and removed from the graph.
+--      Once this process is complete the graph can be colored by removing nodes from
+--      the stack (ie in reverse order) and assigning them colors different to their neighbors.
 --
 colorGraph
-	:: ( Uniquable  k, Uniquable cls,  Uniquable  color
-	   , Eq color, Eq cls, Ord k
-	   , Outputable k, Outputable cls, Outputable color)
-	=> Bool				-- ^ whether to do iterative coalescing
-	-> Int				-- ^ how many times we've tried to color this graph so far.
-	-> UniqFM (UniqSet color)	-- ^ map of (node class -> set of colors available for this class).
-	-> Triv   k cls color 		-- ^ fn to decide whether a node is trivially colorable.
-	-> (Graph k cls color -> k)	-- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.
-	-> Graph  k cls color 		-- ^ the graph to color.
-
-	-> ( Graph k cls color 		-- the colored graph.
-	   , UniqSet k			-- the set of nodes that we couldn't find a color for.
-	   , UniqFM  k )		-- map of regs (r1 -> r2) that were coaleced
-	   				--	 r1 should be replaced by r2 in the source
+        :: ( Uniquable  k, Uniquable cls,  Uniquable  color
+           , Eq color, Eq cls, Ord k
+           , Outputable k, Outputable cls, Outputable color)
+        => Bool                         -- ^ whether to do iterative coalescing
+        -> Int                          -- ^ how many times we've tried to color this graph so far.
+        -> UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).
+        -> Triv   k cls color           -- ^ fn to decide whether a node is trivially colorable.
+        -> (Graph k cls color -> k)     -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.
+        -> Graph  k cls color           -- ^ the graph to color.
+
+        -> ( Graph k cls color          -- the colored graph.
+           , UniqSet k                  -- the set of nodes that we couldn't find a color for.
+           , UniqFM  k )                -- map of regs (r1 -> r2) that were coaleced
+                                        --       r1 should be replaced by r2 in the source
 
 colorGraph iterative spinCount colors triv spill graph0
  = let
-	-- If we're not doing iterative coalescing then do an aggressive coalescing first time
-	--	around and then conservative coalescing for subsequent passes.
-	--
-	--	Aggressive coalescing is a quick way to get rid of many reg-reg moves. However, if
-	--	there is a lot of register pressure and we do it on every round then it can make the
-	--	graph less colorable and prevent the algorithm from converging in a sensible number
-	--	of cycles.
-	--
-	(graph_coalesced, kksCoalesce1)
-	 = if iterative
-		then (graph0, [])
-		else if spinCount == 0
-			then coalesceGraph True  triv graph0
-			else coalesceGraph False triv graph0
-
- 	-- run the scanner to slurp out all the trivially colorable nodes
-	--	(and do coalescing if iterative coalescing is enabled)
-  	(ksTriv, ksProblems, kksCoalesce2)
-		= colorScan iterative triv spill graph_coalesced
-
- 	-- If iterative coalescing is enabled, the scanner will coalesce the graph as does its business.
-	--	We need to apply all the coalescences found by the scanner to the original
-	--	graph before doing assignColors.
-	--
-	--	Because we've got the whole, non-pruned graph here we turn on aggressive coalecing
-	--	to force all the (conservative) coalescences found during scanning.
-	--
-	(graph_scan_coalesced, _)
-		= mapAccumL (coalesceNodes True triv) graph_coalesced kksCoalesce2
- 
-	-- color the trivially colorable nodes
-	--	during scanning, keys of triv nodes were added to the front of the list as they were found
-	--	this colors them in the reverse order, as required by the algorithm.
-	(graph_triv, ksNoTriv)
-		= assignColors colors graph_scan_coalesced ksTriv
-
- 	-- try and color the problem nodes
-	-- 	problem nodes are the ones that were left uncolored because they weren't triv.
-	--	theres a change we can color them here anyway.
-	(graph_prob, ksNoColor)
-		= assignColors colors graph_triv ksProblems
-
-	-- if the trivially colorable nodes didn't color then something is probably wrong
-	--	with the provided triv function.
+        -- If we're not doing iterative coalescing then do an aggressive coalescing first time
+        --      around and then conservative coalescing for subsequent passes.
+        --
+        --      Aggressive coalescing is a quick way to get rid of many reg-reg moves. However, if
+        --      there is a lot of register pressure and we do it on every round then it can make the
+        --      graph less colorable and prevent the algorithm from converging in a sensible number
+        --      of cycles.
         --
-   in	if not $ null ksNoTriv
-   	 then	pprPanic "colorGraph: trivially colorable nodes didn't color!" -- empty
-	 		(  empty
-			$$ text "ksTriv    = " <> ppr ksTriv
-			$$ text "ksNoTriv  = " <> ppr ksNoTriv
-			$$ text "colors    = " <> ppr colors
-			$$ empty
-			$$ dotGraph (\_ -> text "white") triv graph_triv) 
-
-	 else	( graph_prob
-		, mkUniqSet ksNoColor	-- the nodes that didn't color (spills)
-		, if iterative
-			then (listToUFM kksCoalesce2)
-			else (listToUFM kksCoalesce1))
-	
+        (graph_coalesced, kksCoalesce1)
+         = if iterative
+                then (graph0, [])
+                else if spinCount == 0
+                        then coalesceGraph True  triv graph0
+                        else coalesceGraph False triv graph0
+
+        -- run the scanner to slurp out all the trivially colorable nodes
+        --      (and do coalescing if iterative coalescing is enabled)
+        (ksTriv, ksProblems, kksCoalesce2)
+                = colorScan iterative triv spill graph_coalesced
+
+        -- If iterative coalescing is enabled, the scanner will coalesce the graph as does its business.
+        --      We need to apply all the coalescences found by the scanner to the original
+        --      graph before doing assignColors.
+        --
+        --      Because we've got the whole, non-pruned graph here we turn on aggressive coalecing
+        --      to force all the (conservative) coalescences found during scanning.
+        --
+        (graph_scan_coalesced, _)
+                = mapAccumL (coalesceNodes True triv) graph_coalesced kksCoalesce2
+
+        -- color the trivially colorable nodes
+        --      during scanning, keys of triv nodes were added to the front of the list as they were found
+        --      this colors them in the reverse order, as required by the algorithm.
+        (graph_triv, ksNoTriv)
+                = assignColors colors graph_scan_coalesced ksTriv
+
+        -- try and color the problem nodes
+        --      problem nodes are the ones that were left uncolored because they weren't triv.
+        --      theres a change we can color them here anyway.
+        (graph_prob, ksNoColor)
+                = assignColors colors graph_triv ksProblems
+
+        -- if the trivially colorable nodes didn't color then something is probably wrong
+        --      with the provided triv function.
+        --
+   in   if not $ null ksNoTriv
+         then   pprPanic "colorGraph: trivially colorable nodes didn't color!" -- empty
+                        (  empty
+                        $$ text "ksTriv    = " <> ppr ksTriv
+                        $$ text "ksNoTriv  = " <> ppr ksNoTriv
+                        $$ text "colors    = " <> ppr colors
+                        $$ empty
+                        $$ dotGraph (\_ -> text "white") triv graph_triv)
+
+         else   ( graph_prob
+                , mkUniqSet ksNoColor   -- the nodes that didn't color (spills)
+                , if iterative
+                        then (listToUFM kksCoalesce2)
+                        else (listToUFM kksCoalesce1))
+
 
 -- | Scan through the conflict graph separating out trivially colorable and
---	potentially uncolorable (problem) nodes.
+--      potentially uncolorable (problem) nodes.
 --
---	Checking whether a node is trivially colorable or not is a resonably expensive operation,
---	so after a triv node is found and removed from the graph it's no good to return to the 'start'
---	of the graph and recheck a bunch of nodes that will probably still be non-trivially colorable.
+--      Checking whether a node is trivially colorable or not is a resonably expensive operation,
+--      so after a triv node is found and removed from the graph it's no good to return to the 'start'
+--      of the graph and recheck a bunch of nodes that will probably still be non-trivially colorable.
 --
---	To ward against this, during each pass through the graph we collect up a list of triv nodes
---	that were found, and only remove them once we've finished the pass. The more nodes we can delete
---	at once the more likely it is that nodes we've already checked will become trivially colorable
---	for the next pass.
+--      To ward against this, during each pass through the graph we collect up a list of triv nodes
+--      that were found, and only remove them once we've finished the pass. The more nodes we can delete
+--      at once the more likely it is that nodes we've already checked will become trivially colorable
+--      for the next pass.
 --
---	TODO: 	add work lists to finding triv nodes is easier.
---		If we've just scanned the graph, and removed triv nodes, then the only
---		nodes that we need to rescan are the ones we've removed edges from.
+--      TODO:   add work lists to finding triv nodes is easier.
+--              If we've just scanned the graph, and removed triv nodes, then the only
+--              nodes that we need to rescan are the ones we've removed edges from.
 
 colorScan
-	:: ( Uniquable k, Uniquable cls, Uniquable color
-	   , Ord k, 	  Eq cls
-	   , Outputable k, Outputable cls)
-	=> Bool				-- ^ whether to do iterative coalescing
-	-> Triv k cls color		-- ^ fn to decide whether a node is trivially colorable
-	-> (Graph k cls color -> k)	-- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.
-	-> Graph k cls color		-- ^ the graph to scan
+        :: ( Uniquable k, Uniquable cls, Uniquable color
+           , Ord k,       Eq cls
+           , Outputable k, Outputable cls)
+        => Bool                         -- ^ whether to do iterative coalescing
+        -> Triv k cls color             -- ^ fn to decide whether a node is trivially colorable
+        -> (Graph k cls color -> k)     -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.
+        -> Graph k cls color            -- ^ the graph to scan
 
-	-> ([k], [k], [(k, k)])		--  triv colorable nodes, problem nodes, pairs of nodes to coalesce
+        -> ([k], [k], [(k, k)])         --  triv colorable nodes, problem nodes, pairs of nodes to coalesce
 
 colorScan iterative triv spill graph
-	= colorScan_spin iterative triv spill graph [] [] []
+        = colorScan_spin iterative triv spill graph [] [] []
+
+colorScan_spin
+        :: ( Uniquable k, Uniquable cls, Uniquable color
+           , Ord k,       Eq cls
+           , Outputable k, Outputable cls)
+        => Bool
+        -> Triv k cls color
+        -> (Graph k cls color -> k)
+        -> Graph k cls color
+        -> [k]
+        -> [k]
+        -> [(k, k)]
+        -> ([k], [k], [(k, k)])
 
 colorScan_spin iterative triv spill graph
-	ksTriv ksSpill kksCoalesce
-
-	-- if the graph is empty then we're done
-	| isNullUFM $ graphMap graph
-	= (ksTriv, ksSpill, reverse kksCoalesce)
-
-	-- Simplify:
-	--	Look for trivially colorable nodes.
-	--	If we can find some then remove them from the graph and go back for more.
-	--
-	| nsTrivFound@(_:_)
-		<-  scanGraph	(\node -> triv 	(nodeClass node) (nodeConflicts node) (nodeExclusions node)
-
-				  -- for iterative coalescing we only want non-move related
-				  --	nodes here
-				  && (not iterative || isEmptyUniqSet (nodeCoalesce node)))
-			$ graph
-
-	, ksTrivFound	<- map nodeId nsTrivFound
-	, graph2	<- foldr (\k g -> let Just g' = delNode k g
-	   				  in  g')
-				graph ksTrivFound
-
-	= colorScan_spin iterative triv spill graph2
-		(ksTrivFound ++ ksTriv)
-		ksSpill
-		kksCoalesce
-
-	-- Coalesce:
-	-- 	If we're doing iterative coalescing and no triv nodes are avaliable
-	--	then it's time for a coalescing pass.
-	| iterative
-	= case coalesceGraph False triv graph of
-
-		-- we were able to coalesce something
-		--	go back to Simplify and see if this frees up more nodes to be trivially colorable.
-		(graph2, kksCoalesceFound @(_:_))
-		 -> colorScan_spin iterative triv spill graph2
-			ksTriv ksSpill (reverse kksCoalesceFound ++ kksCoalesce)
-
-		-- Freeze:
-		-- nothing could be coalesced (or was triv),
-		--	time to choose a node to freeze and give up on ever coalescing it.
-		(graph2, [])
-		 -> case freezeOneInGraph graph2 of
-
-			-- we were able to freeze something
-			--	hopefully this will free up something for Simplify
-			(graph3, True)
-			 -> colorScan_spin iterative triv spill graph3
-			 	ksTriv ksSpill kksCoalesce
-
-		 	-- we couldn't find something to freeze either
-			--	time for a spill
-		 	(graph3, False)
-			 -> colorScan_spill iterative triv spill graph3
-			 	ksTriv ksSpill kksCoalesce
-
-	-- spill time
-	| otherwise
-	= colorScan_spill iterative triv spill graph
-		ksTriv ksSpill kksCoalesce
+        ksTriv ksSpill kksCoalesce
+
+        -- if the graph is empty then we're done
+        | isNullUFM $ graphMap graph
+        = (ksTriv, ksSpill, reverse kksCoalesce)
+
+        -- Simplify:
+        --      Look for trivially colorable nodes.
+        --      If we can find some then remove them from the graph and go back for more.
+        --
+        | nsTrivFound@(_:_)
+                <-  scanGraph   (\node -> triv  (nodeClass node) (nodeConflicts node) (nodeExclusions node)
+
+                                  -- for iterative coalescing we only want non-move related
+                                  --    nodes here
+                                  && (not iterative || isEmptyUniqSet (nodeCoalesce node)))
+                        $ graph
+
+        , ksTrivFound   <- map nodeId nsTrivFound
+        , graph2        <- foldr (\k g -> let Just g' = delNode k g
+                                          in  g')
+                                graph ksTrivFound
+
+        = colorScan_spin iterative triv spill graph2
+                (ksTrivFound ++ ksTriv)
+                ksSpill
+                kksCoalesce
+
+        -- Coalesce:
+        --      If we're doing iterative coalescing and no triv nodes are avaliable
+        --      then it's time for a coalescing pass.
+        | iterative
+        = case coalesceGraph False triv graph of
+
+                -- we were able to coalesce something
+                --      go back to Simplify and see if this frees up more nodes to be trivially colorable.
+                (graph2, kksCoalesceFound @(_:_))
+                 -> colorScan_spin iterative triv spill graph2
+                        ksTriv ksSpill (reverse kksCoalesceFound ++ kksCoalesce)
+
+                -- Freeze:
+                -- nothing could be coalesced (or was triv),
+                --      time to choose a node to freeze and give up on ever coalescing it.
+                (graph2, [])
+                 -> case freezeOneInGraph graph2 of
+
+                        -- we were able to freeze something
+                        --      hopefully this will free up something for Simplify
+                        (graph3, True)
+                         -> colorScan_spin iterative triv spill graph3
+                                ksTriv ksSpill kksCoalesce
+
+                        -- we couldn't find something to freeze either
+                        --      time for a spill
+                        (graph3, False)
+                         -> colorScan_spill iterative triv spill graph3
+                                ksTriv ksSpill kksCoalesce
+
+        -- spill time
+        | otherwise
+        = colorScan_spill iterative triv spill graph
+                ksTriv ksSpill kksCoalesce
 
 
 -- Select:
 -- we couldn't find any triv nodes or things to freeze or coalesce,
---	and the graph isn't empty yet.. We'll have to choose a spill
---	candidate and leave it uncolored.
+--      and the graph isn't empty yet.. We'll have to choose a spill
+--      candidate and leave it uncolored.
 --
+colorScan_spill
+        :: ( Uniquable k, Uniquable cls, Uniquable color
+           , Ord k,       Eq cls
+           , Outputable k, Outputable cls)
+        => Bool
+        -> Triv k cls color
+        -> (Graph k cls color -> k)
+        -> Graph k cls color
+        -> [k]
+        -> [k]
+        -> [(k, k)]
+        -> ([k], [k], [(k, k)])
+
 colorScan_spill iterative triv spill graph
-	ksTriv ksSpill kksCoalesce
+        ksTriv ksSpill kksCoalesce
+
+ = let  kSpill          = spill graph
+        Just graph'     = delNode kSpill graph
+   in   colorScan_spin iterative triv spill graph'
+                ksTriv (kSpill : ksSpill) kksCoalesce
 
- = let	kSpill		= spill graph
- 	Just graph'	= delNode kSpill graph
-   in	colorScan_spin iterative triv spill graph'
-   		ksTriv (kSpill : ksSpill) kksCoalesce
-	
 
 -- | Try to assign a color to all these nodes.
 
-assignColors 
-	:: ( Uniquable k, Uniquable cls, Uniquable color
-	   , Eq color, Outputable cls)
-	=> UniqFM (UniqSet color)	-- ^ map of (node class -> set of colors available for this class).
-	-> Graph k cls color		-- ^ the graph
-	-> [k]				-- ^ nodes to assign a color to.
-	-> ( Graph k cls color		-- the colored graph
-	   , [k])			-- the nodes that didn't color.
+assignColors
+        :: ( Uniquable k, Uniquable cls, Uniquable color
+           , Eq color, Outputable cls)
+        => UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).
+        -> Graph k cls color            -- ^ the graph
+        -> [k]                          -- ^ nodes to assign a color to.
+        -> ( Graph k cls color          -- the colored graph
+           , [k])                       -- the nodes that didn't color.
+
+assignColors colors graph ks
+        = assignColors' colors graph [] ks
+
+ where  assignColors' _ graph prob []
+                = (graph, prob)
 
-assignColors colors graph ks 
- 	= assignColors' colors graph [] ks
+        assignColors' colors graph prob (k:ks)
+         = case assignColor colors k graph of
 
- where	assignColors' _ graph prob []
-		= (graph, prob)
+                -- couldn't color this node
+                Nothing         -> assignColors' colors graph (k : prob) ks
 
-	assignColors' colors graph prob (k:ks)
-	 = case assignColor colors k graph of
+                -- this node colored ok, so do the rest
+                Just graph'     -> assignColors' colors graph' prob ks
 
-		-- couldn't color this node
-	 	Nothing		-> assignColors' colors graph (k : prob) ks
 
-		-- this node colored ok, so do the rest
-		Just graph'	-> assignColors' colors graph' prob ks
+        assignColor colors u graph
+                | Just c        <- selectColor colors graph u
+                = Just (setColor u c graph)
 
+                | otherwise
+                = Nothing
 
-	assignColor colors u graph
-		| Just c	<- selectColor colors graph u
-		= Just (setColor u c graph)
 
-		| otherwise
-		= Nothing
 
-	
-	
 -- | Select a color for a certain node
---	taking into account preferences, neighbors and exclusions.
---	returns Nothing if no color can be assigned to this node.
+--      taking into account preferences, neighbors and exclusions.
+--      returns Nothing if no color can be assigned to this node.
 --
 selectColor
-	:: ( Uniquable k, Uniquable cls, Uniquable color
-	   , Eq color, Outputable cls)
-	=> UniqFM (UniqSet color)	-- ^ map of (node class -> set of colors available for this class).
-	-> Graph k cls color		-- ^ the graph
-	-> k				-- ^ key of the node to select a color for.
-	-> Maybe color
-	
-selectColor colors graph u 
- = let	-- lookup the node
- 	Just node	= lookupNode graph u
-
-	-- lookup the available colors for the class of this node.
-	colors_avail
-	 = case lookupUFM colors (nodeClass node) of
-	 	Nothing	-> pprPanic "selectColor: no colors available for class " (ppr (nodeClass node))
-		Just cs	-> cs
-
-	-- find colors we can't use because they're already being used
-	--	by a node that conflicts with this one.
-	Just nsConflicts 	
-			= sequence
-			$ map (lookupNode graph)
-			$ uniqSetToList 
-			$ nodeConflicts node
-		
-	colors_conflict	= mkUniqSet 
-			$ catMaybes 
-			$ map nodeColor nsConflicts
-	
-	-- the prefs of our neighbors
-	colors_neighbor_prefs
-			= mkUniqSet
-			$ concat $ map nodePreference nsConflicts
-
-	-- colors that are still valid for us
-	colors_ok_ex	= minusUniqSet colors_avail (nodeExclusions node)
-	colors_ok	= minusUniqSet colors_ok_ex colors_conflict
-				
-	-- the colors that we prefer, and are still ok
-	colors_ok_pref	= intersectUniqSets
-				(mkUniqSet $ nodePreference node) colors_ok
-
-	-- the colors that we could choose while being nice to our neighbors
-	colors_ok_nice	= minusUniqSet
-				colors_ok colors_neighbor_prefs
-
-	-- the best of all possible worlds..
-	colors_ok_pref_nice
-			= intersectUniqSets
-				colors_ok_nice colors_ok_pref
-
-	-- make the decision
-	chooseColor
-
-		-- everyone is happy, yay!
-		| not $ isEmptyUniqSet colors_ok_pref_nice
-		, c : _		<- filter (\x -> elementOfUniqSet x colors_ok_pref_nice)
-					(nodePreference node)
-		= Just c
-
-		-- we've got one of our preferences
-		| not $ isEmptyUniqSet colors_ok_pref	
-		, c : _		<- filter (\x -> elementOfUniqSet x colors_ok_pref)
-					(nodePreference node)
-		= Just c
-		
-		-- it wasn't a preference, but it was still ok
-		| not $ isEmptyUniqSet colors_ok
-		, c : _		<- uniqSetToList colors_ok
-		= Just c
-		
-		-- no colors were available for us this time.
-		--	looks like we're going around the loop again..
-		| otherwise
-		= Nothing
-		
-   in	chooseColor 
+        :: ( Uniquable k, Uniquable cls, Uniquable color
+           , Eq color, Outputable cls)
+        => UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).
+        -> Graph k cls color            -- ^ the graph
+        -> k                            -- ^ key of the node to select a color for.
+        -> Maybe color
+
+selectColor colors graph u
+ = let  -- lookup the node
+        Just node       = lookupNode graph u
+
+        -- lookup the available colors for the class of this node.
+        colors_avail
+         = case lookupUFM colors (nodeClass node) of
+                Nothing -> pprPanic "selectColor: no colors available for class " (ppr (nodeClass node))
+                Just cs -> cs
+
+        -- find colors we can't use because they're already being used
+        --      by a node that conflicts with this one.
+        Just nsConflicts
+                        = sequence
+                        $ map (lookupNode graph)
+                        $ uniqSetToList
+                        $ nodeConflicts node
+
+        colors_conflict = mkUniqSet
+                        $ catMaybes
+                        $ map nodeColor nsConflicts
+
+        -- the prefs of our neighbors
+        colors_neighbor_prefs
+                        = mkUniqSet
+                        $ concat $ map nodePreference nsConflicts
+
+        -- colors that are still valid for us
+        colors_ok_ex    = minusUniqSet colors_avail (nodeExclusions node)
+        colors_ok       = minusUniqSet colors_ok_ex colors_conflict
+
+        -- the colors that we prefer, and are still ok
+        colors_ok_pref  = intersectUniqSets
+                                (mkUniqSet $ nodePreference node) colors_ok
+
+        -- the colors that we could choose while being nice to our neighbors
+        colors_ok_nice  = minusUniqSet
+                                colors_ok colors_neighbor_prefs
+
+        -- the best of all possible worlds..
+        colors_ok_pref_nice
+                        = intersectUniqSets
+                                colors_ok_nice colors_ok_pref
+
+        -- make the decision
+        chooseColor
+
+                -- everyone is happy, yay!
+                | not $ isEmptyUniqSet colors_ok_pref_nice
+                , c : _         <- filter (\x -> elementOfUniqSet x colors_ok_pref_nice)
+                                        (nodePreference node)
+                = Just c
+
+                -- we've got one of our preferences
+                | not $ isEmptyUniqSet colors_ok_pref
+                , c : _         <- filter (\x -> elementOfUniqSet x colors_ok_pref)
+                                        (nodePreference node)
+                = Just c
+
+                -- it wasn't a preference, but it was still ok
+                | not $ isEmptyUniqSet colors_ok
+                , c : _         <- uniqSetToList colors_ok
+                = Just c
+
+                -- no colors were available for us this time.
+                --      looks like we're going around the loop again..
+                | otherwise
+                = Nothing
+
+   in   chooseColor
 
 
 
diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index 69d4943fb0..7bf3ecdffb 100644
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -1,28 +1,20 @@
-{-# OPTIONS -fno-warn-missing-signatures #-}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 -- | Basic operations on graphs.
 --
 
 module GraphOps (
-	addNode, 	delNode,	getNode,	lookupNode,	modNode,
-	size,
-	union,
-	addConflict,	delConflict,	addConflicts,
-	addCoalesce,	delCoalesce,	
-	addExclusion,	addExclusions,
-	addPreference,
-	coalesceNodes,	coalesceGraph,
-	freezeNode,	freezeOneInGraph, freezeAllInGraph,
-	scanGraph,
-	setColor,
-	validateGraph,
-	slurpNodeConflictCount
+        addNode,        delNode,        getNode,       lookupNode,     modNode,
+        size,
+        union,
+        addConflict,    delConflict,    addConflicts,
+        addCoalesce,    delCoalesce,
+        addExclusion,   addExclusions,
+        addPreference,
+        coalesceNodes,  coalesceGraph,
+        freezeNode,     freezeOneInGraph, freezeAllInGraph,
+        scanGraph,
+        setColor,
+        validateGraph,
+        slurpNodeConflictCount
 )
 where
 
@@ -33,610 +25,641 @@ import Unique
 import UniqSet
 import UniqFM
 
-import Data.List	hiding (union)
+import Data.List        hiding (union)
 import Data.Maybe
 
 -- | Lookup a node from the graph.
-lookupNode 
-	:: Uniquable k
-	=> Graph k cls color
-	-> k -> Maybe (Node  k cls color)
+lookupNode
+        :: Uniquable k
+        => Graph k cls color
+        -> k -> Maybe (Node  k cls color)
 
-lookupNode graph k	
-	= lookupUFM (graphMap graph) k
+lookupNode graph k
+        = lookupUFM (graphMap graph) k
 
 
 -- | Get a node from the graph, throwing an error if it's not there
 getNode
-	:: Uniquable k
-	=> Graph k cls color
-	-> k -> Node k cls color
+        :: Uniquable k
+        => Graph k cls color
+        -> k -> Node k cls color
 
 getNode graph k
  = case lookupUFM (graphMap graph) k of
-	Just node	-> node
-	Nothing		-> panic "ColorOps.getNode: not found" 
+        Just node       -> node
+        Nothing         -> panic "ColorOps.getNode: not found"
 
 
 -- | Add a node to the graph, linking up its edges
 addNode :: Uniquable k
-	=> k -> Node k cls color 
-	-> Graph k cls color -> Graph k cls color
-	
+        => k -> Node k cls color
+        -> Graph k cls color -> Graph k cls color
+
 addNode k node graph
- = let	
- 	-- add back conflict edges from other nodes to this one
- 	map_conflict	
-		= foldUniqSet 
-			(adjustUFM_C (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k}))
-			(graphMap graph)
-			(nodeConflicts node)
-			
-	-- add back coalesce edges from other nodes to this one
-	map_coalesce
-		= foldUniqSet
-			(adjustUFM_C (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k}))
-			map_conflict
-			(nodeCoalesce node)
-	
-  in	graph
-  	{ graphMap	= addToUFM map_coalesce k node}
-		
+ = let
+        -- add back conflict edges from other nodes to this one
+        map_conflict
+                = foldUniqSet
+                        (adjustUFM_C (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k}))
+                        (graphMap graph)
+                        (nodeConflicts node)
+
+        -- add back coalesce edges from other nodes to this one
+        map_coalesce
+                = foldUniqSet
+                        (adjustUFM_C (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k}))
+                        map_conflict
+                        (nodeCoalesce node)
+
+  in    graph
+        { graphMap      = addToUFM map_coalesce k node}
+
 
 -- | Delete a node and all its edges from the graph.
 delNode :: (Uniquable k, Outputable k)
-	=> k -> Graph k cls color -> Maybe (Graph k cls color)
+        => k -> Graph k cls color -> Maybe (Graph k cls color)
 
 delNode k graph
-	| Just node	<- lookupNode graph k
-	= let	-- delete conflict edges from other nodes to this one.
-		graph1	= foldl' (\g k1 -> let Just g' = delConflict k1 k g in g') graph
-			$ uniqSetToList (nodeConflicts node)
-	
-		-- delete coalesce edge from other nodes to this one.
-		graph2	= foldl' (\g k1 -> let Just g' = delCoalesce k1 k g in g') graph1
-			$ uniqSetToList (nodeCoalesce node)
-	
-		-- delete the node
-		graph3	= graphMapModify (\fm -> delFromUFM fm k) graph2
-	
-	  in	Just graph3
-		
-	| otherwise
-	= Nothing
+        | Just node     <- lookupNode graph k
+        = let   -- delete conflict edges from other nodes to this one.
+                graph1  = foldl' (\g k1 -> let Just g' = delConflict k1 k g in g') graph
+                        $ uniqSetToList (nodeConflicts node)
+
+                -- delete coalesce edge from other nodes to this one.
+                graph2  = foldl' (\g k1 -> let Just g' = delCoalesce k1 k g in g') graph1
+                        $ uniqSetToList (nodeCoalesce node)
+
+                -- delete the node
+                graph3  = graphMapModify (\fm -> delFromUFM fm k) graph2
+
+          in    Just graph3
+
+        | otherwise
+        = Nothing
 
 
 -- | Modify a node in the graph.
---	returns Nothing if the node isn't present.
+--      returns Nothing if the node isn't present.
 --
 modNode :: Uniquable k
-	=> (Node k cls color -> Node k cls color) 
-	-> k -> Graph k cls color -> Maybe (Graph k cls color)
+        => (Node k cls color -> Node k cls color)
+        -> k -> Graph k cls color -> Maybe (Graph k cls color)
 
 modNode f k graph
  = case lookupNode graph k of
- 	Just Node{}
-	 -> Just
-	 $  graphMapModify
-		 (\fm	-> let	Just node	= lookupUFM fm k
-			   	node'		= f node
-			   in	addToUFM fm k node') 
-		graph
+        Just Node{}
+         -> Just
+         $  graphMapModify
+                 (\fm   -> let  Just node       = lookupUFM fm k
+                                node'           = f node
+                           in   addToUFM fm k node')
+                graph
 
-	Nothing	-> Nothing
+        Nothing -> Nothing
 
 
 -- | Get the size of the graph, O(n)
-size	:: Uniquable k 
-	=> Graph k cls color -> Int
-	
-size graph	
-	= sizeUFM $ graphMap graph
-	
+size    :: Uniquable k
+        => Graph k cls color -> Int
+
+size graph
+        = sizeUFM $ graphMap graph
+
 
 -- | Union two graphs together.
-union	:: Uniquable k
-	=> Graph k cls color -> Graph k cls color -> Graph k cls color
-	
-union	graph1 graph2
-	= Graph 
-	{ graphMap		= plusUFM (graphMap graph1) (graphMap graph2) }
+union   :: Uniquable k
+        => Graph k cls color -> Graph k cls color -> Graph k cls color
+
+union   graph1 graph2
+        = Graph
+        { graphMap              = plusUFM (graphMap graph1) (graphMap graph2) }
 
 
 -- | Add a conflict between nodes to the graph, creating the nodes required.
---	Conflicts are virtual regs which need to be colored differently.
+--      Conflicts are virtual regs which need to be colored differently.
 addConflict
-	:: Uniquable k
-	=> (k, cls) -> (k, cls) 
-	-> Graph k cls color -> Graph k cls color
+        :: Uniquable k
+        => (k, cls) -> (k, cls)
+        -> Graph k cls color -> Graph k cls color
 
 addConflict (u1, c1) (u2, c2)
- = let	addNeighbor u c u'
-	 	= adjustWithDefaultUFM
-			(\node -> node { nodeConflicts = addOneToUniqSet (nodeConflicts node) u' })
-			(newNode u c)  { nodeConflicts = unitUniqSet u' }
-			u
-	
-   in	graphMapModify
-   	( addNeighbor u1 c1 u2 
-	. addNeighbor u2 c2 u1)
-
- 
+ = let  addNeighbor u c u'
+                = adjustWithDefaultUFM
+                        (\node -> node { nodeConflicts = addOneToUniqSet (nodeConflicts node) u' })
+                        (newNode u c)  { nodeConflicts = unitUniqSet u' }
+                        u
+
+   in   graphMapModify
+        ( addNeighbor u1 c1 u2
+        . addNeighbor u2 c2 u1)
+
+
 -- | Delete a conflict edge. k1 -> k2
---	returns Nothing if the node isn't in the graph
-delConflict 
-	:: Uniquable k
-	=> k -> k
-	-> Graph k cls color -> Maybe (Graph k cls color)
-	
+--      returns Nothing if the node isn't in the graph
+delConflict
+        :: Uniquable k
+        => k -> k
+        -> Graph k cls color -> Maybe (Graph k cls color)
+
 delConflict k1 k2
-	= modNode
-		(\node -> node { nodeConflicts = delOneFromUniqSet (nodeConflicts node) k2 })
-		k1
+        = modNode
+                (\node -> node { nodeConflicts = delOneFromUniqSet (nodeConflicts node) k2 })
+                k1
 
 
 -- | Add some conflicts to the graph, creating nodes if required.
---	All the nodes in the set are taken to conflict with each other.
+--      All the nodes in the set are taken to conflict with each other.
 addConflicts
-	:: Uniquable k
-	=> UniqSet k -> (k -> cls)
-	-> Graph k cls color -> Graph k cls color
-	
-addConflicts conflicts getClass
-
-	-- just a single node, but no conflicts, create the node anyway.
-	| (u : [])	<- uniqSetToList conflicts
-	= graphMapModify 
-	$ adjustWithDefaultUFM 
-		id
-		(newNode u (getClass u)) 
-		u
-
-	| otherwise
-	= graphMapModify
-	$ (\fm -> foldl' (\g u  -> addConflictSet1 u getClass conflicts g) fm
-		$ uniqSetToList conflicts)
+        :: Uniquable k
+        => UniqSet k -> (k -> cls)
+        -> Graph k cls color -> Graph k cls color
 
+addConflicts conflicts getClass
 
-addConflictSet1 u getClass set 
+        -- just a single node, but no conflicts, create the node anyway.
+        | (u : [])      <- uniqSetToList conflicts
+        = graphMapModify
+        $ adjustWithDefaultUFM
+                id
+                (newNode u (getClass u))
+                u
+
+        | otherwise
+        = graphMapModify
+        $ (\fm -> foldl' (\g u  -> addConflictSet1 u getClass conflicts g) fm
+                $ uniqSetToList conflicts)
+
+
+addConflictSet1 :: Uniquable k
+                => k -> (k -> cls) -> UniqSet k
+                -> UniqFM (Node k cls color)
+                -> UniqFM (Node k cls color)
+addConflictSet1 u getClass set
  = case delOneFromUniqSet set u of
     set' -> adjustWithDefaultUFM
-		(\node -> node 			{ nodeConflicts = unionUniqSets set' (nodeConflicts node) } )
-		(newNode u (getClass u))	{ nodeConflicts = set' }
-		u
+                (\node -> node                  { nodeConflicts = unionUniqSets set' (nodeConflicts node) } )
+                (newNode u (getClass u))        { nodeConflicts = set' }
+                u
 
 
 -- | Add an exclusion to the graph, creating nodes if required.
---	These are extra colors that the node cannot use.
+--      These are extra colors that the node cannot use.
 addExclusion
-	:: (Uniquable k, Uniquable color)
-	=> k -> (k -> cls) -> color 
-	-> Graph k cls color -> Graph k cls color
-	
-addExclusion u getClass color 
- 	= graphMapModify
-	$ adjustWithDefaultUFM 
-		(\node -> node 			{ nodeExclusions = addOneToUniqSet (nodeExclusions node) color })
-		(newNode u (getClass u))  	{ nodeExclusions = unitUniqSet color }
-		u
+        :: (Uniquable k, Uniquable color)
+        => k -> (k -> cls) -> color
+        -> Graph k cls color -> Graph k cls color
+
+addExclusion u getClass color
+        = graphMapModify
+        $ adjustWithDefaultUFM
+                (\node -> node                  { nodeExclusions = addOneToUniqSet (nodeExclusions node) color })
+                (newNode u (getClass u))        { nodeExclusions = unitUniqSet color }
+                u
 
 addExclusions
-	:: (Uniquable k, Uniquable color)
-	=> k -> (k -> cls) -> [color]
-	-> Graph k cls color -> Graph k cls color
+        :: (Uniquable k, Uniquable color)
+        => k -> (k -> cls) -> [color]
+        -> Graph k cls color -> Graph k cls color
 
 addExclusions u getClass colors graph
-	= foldr (addExclusion u getClass) graph colors
+        = foldr (addExclusion u getClass) graph colors
 
 
 -- | Add a coalescence edge to the graph, creating nodes if requried.
---	It is considered adventageous to assign the same color to nodes in a coalesence.
-addCoalesce 
-	:: Uniquable k
-	=> (k, cls) -> (k, cls) 
-	-> Graph k cls color -> Graph k cls color
-	
-addCoalesce (u1, c1) (u2, c2) 
- = let	addCoalesce u c u'
- 	 = 	adjustWithDefaultUFM
-	 		(\node -> node { nodeCoalesce = addOneToUniqSet (nodeCoalesce node) u' })
-			(newNode u c)  { nodeCoalesce = unitUniqSet u' }
-			u
-			
-   in	graphMapModify
-     	( addCoalesce u1 c1 u2
+--      It is considered adventageous to assign the same color to nodes in a coalesence.
+addCoalesce
+        :: Uniquable k
+        => (k, cls) -> (k, cls)
+        -> Graph k cls color -> Graph k cls color
+
+addCoalesce (u1, c1) (u2, c2)
+ = let  addCoalesce u c u'
+         =      adjustWithDefaultUFM
+                        (\node -> node { nodeCoalesce = addOneToUniqSet (nodeCoalesce node) u' })
+                        (newNode u c)  { nodeCoalesce = unitUniqSet u' }
+                        u
+
+   in   graphMapModify
+        ( addCoalesce u1 c1 u2
         . addCoalesce u2 c2 u1)
 
 
 -- | Delete a coalescence edge (k1 -> k2) from the graph.
 delCoalesce
-	:: Uniquable k
-	=> k -> k 
-	-> Graph k cls color	-> Maybe (Graph k cls color)
+        :: Uniquable k
+        => k -> k
+        -> Graph k cls color    -> Maybe (Graph k cls color)
 
 delCoalesce k1 k2
-	= modNode (\node -> node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k2 })
-		k1
+        = modNode (\node -> node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k2 })
+                k1
 
 
 -- | Add a color preference to the graph, creating nodes if required.
---	The most recently added preference is the most prefered.
---	The algorithm tries to assign a node it's prefered color if possible.
+--      The most recently added preference is the most prefered.
+--      The algorithm tries to assign a node it's prefered color if possible.
 --
-addPreference 
-	:: Uniquable k
-	=> (k, cls) -> color
-	-> Graph k cls color -> Graph k cls color
-	
-addPreference (u, c) color 
- 	= graphMapModify
-	$ adjustWithDefaultUFM 
-		(\node -> node { nodePreference = color : (nodePreference node) })
-		(newNode u c)  { nodePreference = [color] }
-		u
+addPreference
+        :: Uniquable k
+        => (k, cls) -> color
+        -> Graph k cls color -> Graph k cls color
+
+addPreference (u, c) color
+        = graphMapModify
+        $ adjustWithDefaultUFM
+                (\node -> node { nodePreference = color : (nodePreference node) })
+                (newNode u c)  { nodePreference = [color] }
+                u
 
 
 -- | Do agressive coalescing on this graph.
---	returns	the new graph and the list of pairs of nodes that got coaleced together.
---	for each pair, the resulting node will have the least key and be second in the pair.
+--      returns the new graph and the list of pairs of nodes that got coaleced together.
+--      for each pair, the resulting node will have the least key and be second in the pair.
 --
 coalesceGraph
-	:: (Uniquable k, Ord k, Eq cls, Outputable k)
-	=> Bool			-- ^ If True, coalesce nodes even if this might make the graph
-				--	less colorable (aggressive coalescing)
-	-> Triv k cls color
-	-> Graph k cls color
-	-> ( Graph k cls color
-	   , [(k, k)])		-- pairs of nodes that were coalesced, in the order that the
-	   			--	coalescing was applied.
+        :: (Uniquable k, Ord k, Eq cls, Outputable k)
+        => Bool                 -- ^ If True, coalesce nodes even if this might make the graph
+                                --      less colorable (aggressive coalescing)
+        -> Triv k cls color
+        -> Graph k cls color
+        -> ( Graph k cls color
+           , [(k, k)])          -- pairs of nodes that were coalesced, in the order that the
+                                --      coalescing was applied.
 
 coalesceGraph aggressive triv graph
-	= coalesceGraph' aggressive triv graph []
-
+        = coalesceGraph' aggressive triv graph []
+
+coalesceGraph'
+        :: (Uniquable k, Ord k, Eq cls, Outputable k)
+        => Bool
+        -> Triv k cls color
+        -> Graph k cls color
+        -> [(k, k)]
+        -> ( Graph k cls color
+           , [(k, k)])
 coalesceGraph' aggressive triv graph kkPairsAcc
  = let
- 	-- find all the nodes that have coalescence edges
-	cNodes	= filter (\node -> not $ isEmptyUniqSet (nodeCoalesce node))
-		$ eltsUFM $ graphMap graph
-
-	-- build a list of pairs of keys for node's we'll try and coalesce
-	--	every pair of nodes will appear twice in this list
-	--	ie [(k1, k2), (k2, k1) ... ]
-	--	This is ok, GrapOps.coalesceNodes handles this and it's convenient for
-	--	build a list of what nodes get coalesced together for later on.
-	--
-	cList	= [ (nodeId node1, k2)
-			| node1	<- cNodes
-			, k2	<- uniqSetToList $ nodeCoalesce node1 ]
-
-	-- do the coalescing, returning the new graph and a list of pairs of keys
-	--	that got coalesced together.
-	(graph', mPairs)
-		= mapAccumL (coalesceNodes aggressive triv) graph cList
-
-	-- keep running until there are no more coalesces can be found
-   in	case catMaybes mPairs of
-	 []	-> (graph', reverse kkPairsAcc)
-	 pairs	-> coalesceGraph' aggressive triv graph' (reverse pairs ++ kkPairsAcc)
+        -- find all the nodes that have coalescence edges
+        cNodes  = filter (\node -> not $ isEmptyUniqSet (nodeCoalesce node))
+                $ eltsUFM $ graphMap graph
+
+        -- build a list of pairs of keys for node's we'll try and coalesce
+        --      every pair of nodes will appear twice in this list
+        --      ie [(k1, k2), (k2, k1) ... ]
+        --      This is ok, GrapOps.coalesceNodes handles this and it's convenient for
+        --      build a list of what nodes get coalesced together for later on.
+        --
+        cList   = [ (nodeId node1, k2)
+                        | node1 <- cNodes
+                        , k2    <- uniqSetToList $ nodeCoalesce node1 ]
+
+        -- do the coalescing, returning the new graph and a list of pairs of keys
+        --      that got coalesced together.
+        (graph', mPairs)
+                = mapAccumL (coalesceNodes aggressive triv) graph cList
+
+        -- keep running until there are no more coalesces can be found
+   in   case catMaybes mPairs of
+         []     -> (graph', reverse kkPairsAcc)
+         pairs  -> coalesceGraph' aggressive triv graph' (reverse pairs ++ kkPairsAcc)
 
 
 -- | Coalesce this pair of nodes unconditionally \/ agressively.
---	The resulting node is the one with the least key.
+--      The resulting node is the one with the least key.
 --
---	returns: Just 	 the pair of keys if the nodes were coalesced
---			 the second element of the pair being the least one
+--      returns: Just    the pair of keys if the nodes were coalesced
+--                       the second element of the pair being the least one
 --
---		 Nothing if either of the nodes weren't in the graph
+--               Nothing if either of the nodes weren't in the graph
 
 coalesceNodes
-	:: (Uniquable k, Ord k, Eq cls, Outputable k)
-	=> Bool			-- ^ If True, coalesce nodes even if this might make the graph
-				--	less colorable (aggressive coalescing)
-	-> Triv  k cls color
-	-> Graph k cls color
-	-> (k, k)		-- ^ keys of the nodes to be coalesced
-	-> (Graph k cls color, Maybe (k, k))
+        :: (Uniquable k, Ord k, Eq cls, Outputable k)
+        => Bool                 -- ^ If True, coalesce nodes even if this might make the graph
+                                --      less colorable (aggressive coalescing)
+        -> Triv  k cls color
+        -> Graph k cls color
+        -> (k, k)               -- ^ keys of the nodes to be coalesced
+        -> (Graph k cls color, Maybe (k, k))
 
 coalesceNodes aggressive triv graph (k1, k2)
-	| (kMin, kMax)	<- if k1 < k2
-				then (k1, k2)
-				else (k2, k1)
-
-	-- the nodes being coalesced must be in the graph
-	, Just nMin	<- lookupNode graph kMin
-	, Just nMax	<- lookupNode graph kMax
-
-	-- can't coalesce conflicting modes
-	, not $ elementOfUniqSet kMin (nodeConflicts nMax)
-	, not $ elementOfUniqSet kMax (nodeConflicts nMin)
-
-	-- can't coalesce the same node
-	, nodeId nMin /= nodeId nMax
-
-	= coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
+        | (kMin, kMax)  <- if k1 < k2
+                                then (k1, k2)
+                                else (k2, k1)
 
-	-- don't do the coalescing after all
-	| otherwise
-	= (graph, Nothing)
+        -- the nodes being coalesced must be in the graph
+        , Just nMin     <- lookupNode graph kMin
+        , Just nMax     <- lookupNode graph kMax
 
-coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
-
-	-- sanity checks
-	| nodeClass nMin /= nodeClass nMax
-	= error "GraphOps.coalesceNodes: can't coalesce nodes of different classes."
+        -- can't coalesce conflicting modes
+        , not $ elementOfUniqSet kMin (nodeConflicts nMax)
+        , not $ elementOfUniqSet kMax (nodeConflicts nMin)
 
-	| not (isNothing (nodeColor nMin) && isNothing (nodeColor nMax))
-	= error "GraphOps.coalesceNodes: can't coalesce colored nodes."
+        -- can't coalesce the same node
+        , nodeId nMin /= nodeId nMax
 
-	---
-	| otherwise
-	= let
-		-- the new node gets all the edges from its two components
-		node	=
-		 Node	{ nodeId		= kMin
-			, nodeClass		= nodeClass nMin
-			, nodeColor		= Nothing
+        = coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
 
-			-- nodes don't conflict with themselves..
-			, nodeConflicts
-				= (unionUniqSets (nodeConflicts nMin) (nodeConflicts nMax))
-					`delOneFromUniqSet` kMin
-					`delOneFromUniqSet` kMax
+        -- don't do the coalescing after all
+        | otherwise
+        = (graph, Nothing)
 
-			, nodeExclusions	= unionUniqSets (nodeExclusions nMin) (nodeExclusions nMax)
-			, nodePreference	= nodePreference nMin ++ nodePreference nMax
+coalesceNodes_merge
+        :: (Uniquable k, Ord k, Eq cls, Outputable k)
+        => Bool
+        -> Triv  k cls color
+        -> Graph k cls color
+        -> k -> k
+        -> Node k cls color
+        -> Node k cls color
+        -> (Graph k cls color, Maybe (k, k))
 
-			-- nodes don't coalesce with themselves..
-			, nodeCoalesce
-				= (unionUniqSets (nodeCoalesce nMin) (nodeCoalesce nMax))
-					`delOneFromUniqSet` kMin
-					`delOneFromUniqSet` kMax
-			}
+coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
 
-	  in	coalesceNodes_check aggressive triv graph kMin kMax node
+        -- sanity checks
+        | nodeClass nMin /= nodeClass nMax
+        = error "GraphOps.coalesceNodes: can't coalesce nodes of different classes."
+
+        | not (isNothing (nodeColor nMin) && isNothing (nodeColor nMax))
+        = error "GraphOps.coalesceNodes: can't coalesce colored nodes."
+
+        ---
+        | otherwise
+        = let
+                -- the new node gets all the edges from its two components
+                node    =
+                 Node   { nodeId                = kMin
+                        , nodeClass             = nodeClass nMin
+                        , nodeColor             = Nothing
+
+                        -- nodes don't conflict with themselves..
+                        , nodeConflicts
+                                = (unionUniqSets (nodeConflicts nMin) (nodeConflicts nMax))
+                                        `delOneFromUniqSet` kMin
+                                        `delOneFromUniqSet` kMax
+
+                        , nodeExclusions        = unionUniqSets (nodeExclusions nMin) (nodeExclusions nMax)
+                        , nodePreference        = nodePreference nMin ++ nodePreference nMax
+
+                        -- nodes don't coalesce with themselves..
+                        , nodeCoalesce
+                                = (unionUniqSets (nodeCoalesce nMin) (nodeCoalesce nMax))
+                                        `delOneFromUniqSet` kMin
+                                        `delOneFromUniqSet` kMax
+                        }
+
+          in    coalesceNodes_check aggressive triv graph kMin kMax node
+
+coalesceNodes_check
+        :: (Uniquable k, Ord k, Eq cls, Outputable k)
+        => Bool
+        -> Triv  k cls color
+        -> Graph k cls color
+        -> k -> k
+        -> Node k cls color
+        -> (Graph k cls color, Maybe (k, k))
 
 coalesceNodes_check aggressive triv graph kMin kMax node
 
-	-- Unless we're coalescing aggressively, if the result node is not trivially
-	--	colorable then don't do the coalescing.
-	| not aggressive
-	, not $ triv (nodeClass node) (nodeConflicts node) (nodeExclusions node)
-	= (graph, Nothing)
+        -- Unless we're coalescing aggressively, if the result node is not trivially
+        --      colorable then don't do the coalescing.
+        | not aggressive
+        , not $ triv (nodeClass node) (nodeConflicts node) (nodeExclusions node)
+        = (graph, Nothing)
 
-	| otherwise
-	= let -- delete the old nodes from the graph and add the new one
-		Just graph1	= delNode kMax graph
-		Just graph2	= delNode kMin graph1
-		graph3		= addNode kMin node graph2
+        | otherwise
+        = let -- delete the old nodes from the graph and add the new one
+                Just graph1     = delNode kMax graph
+                Just graph2     = delNode kMin graph1
+                graph3          = addNode kMin node graph2
 
-	  in	(graph3, Just (kMax, kMin))
+          in    (graph3, Just (kMax, kMin))
 
 
 -- | Freeze a node
---	This is for the iterative coalescer.
---	By freezing a node we give up on ever coalescing it.
---	Move all its coalesce edges into the frozen set - and update
---	back edges from other nodes.
+--      This is for the iterative coalescer.
+--      By freezing a node we give up on ever coalescing it.
+--      Move all its coalesce edges into the frozen set - and update
+--      back edges from other nodes.
 --
 freezeNode
-	:: Uniquable k
-	=> k			-- ^ key of the node to freeze
-	-> Graph k cls color	-- ^ the graph
-	-> Graph k cls color	-- ^ graph with that node frozen
+        :: Uniquable k
+        => k                    -- ^ key of the node to freeze
+        -> Graph k cls color    -- ^ the graph
+        -> Graph k cls color    -- ^ graph with that node frozen
 
 freezeNode k
   = graphMapModify
   $ \fm ->
-    let	-- freeze all the edges in the node to be frozen
-    	Just node = lookupUFM fm k
-	node'	= node
-		{ nodeCoalesce		= emptyUniqSet }
+    let -- freeze all the edges in the node to be frozen
+        Just node = lookupUFM fm k
+        node'   = node
+                { nodeCoalesce          = emptyUniqSet }
 
-	fm1	= addToUFM fm k node'
+        fm1     = addToUFM fm k node'
 
-	-- update back edges pointing to this node
-	freezeEdge k node
-	 = if elementOfUniqSet k (nodeCoalesce node)
-	 	then node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k }
-		else node 	-- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set"
-				-- If the edge isn't actually in the coelesce set then just ignore it.
+        -- update back edges pointing to this node
+        freezeEdge k node
+         = if elementOfUniqSet k (nodeCoalesce node)
+                then node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k }
+                else node       -- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set"
+                                -- If the edge isn't actually in the coelesce set then just ignore it.
 
-	fm2	= foldUniqSet (adjustUFM_C (freezeEdge k)) fm1
-	   		$ nodeCoalesce node
+        fm2     = foldUniqSet (adjustUFM_C (freezeEdge k)) fm1
+                        $ nodeCoalesce node
 
-    in	fm2
+    in  fm2
 
 
 -- | Freeze one node in the graph
---	This if for the iterative coalescer.
---	Look for a move related node of low degree and freeze it.
+--      This if for the iterative coalescer.
+--      Look for a move related node of low degree and freeze it.
 --
---	We probably don't need to scan the whole graph looking for the node of absolute
---	lowest degree. Just sample the first few and choose the one with the lowest 
---	degree out of those. Also, we don't make any distinction between conflicts of different
---	classes.. this is just a heuristic, after all.
+--      We probably don't need to scan the whole graph looking for the node of absolute
+--      lowest degree. Just sample the first few and choose the one with the lowest
+--      degree out of those. Also, we don't make any distinction between conflicts of different
+--      classes.. this is just a heuristic, after all.
 --
---	IDEA:	freezing a node might free it up for Simplify.. would be good to check for triv
---		right here, and add it to a worklist if known triv\/non-move nodes.
+--      IDEA:   freezing a node might free it up for Simplify.. would be good to check for triv
+--              right here, and add it to a worklist if known triv\/non-move nodes.
 --
 freezeOneInGraph
-	:: (Uniquable k, Outputable k)
-	=> Graph k cls color
-	-> ( Graph k cls color		-- the new graph
-	   , Bool )			-- whether we found a node to freeze
+        :: (Uniquable k, Outputable k)
+        => Graph k cls color
+        -> ( Graph k cls color          -- the new graph
+           , Bool )                     -- whether we found a node to freeze
 
 freezeOneInGraph graph
- = let	compareNodeDegree n1 n2
-		= compare (sizeUniqSet $ nodeConflicts n1) (sizeUniqSet $ nodeConflicts n2)
+ = let  compareNodeDegree n1 n2
+                = compare (sizeUniqSet $ nodeConflicts n1) (sizeUniqSet $ nodeConflicts n2)
 
-	candidates
-		= sortBy compareNodeDegree
-		$ take 5	-- 5 isn't special, it's just a small number.
-		$ scanGraph (\node -> not $ isEmptyUniqSet (nodeCoalesce node)) graph
+        candidates
+                = sortBy compareNodeDegree
+                $ take 5        -- 5 isn't special, it's just a small number.
+                $ scanGraph (\node -> not $ isEmptyUniqSet (nodeCoalesce node)) graph
 
-   in	case candidates of
+   in   case candidates of
 
-	 -- there wasn't anything available to freeze
-   	 []	-> (graph, False)
+         -- there wasn't anything available to freeze
+         []     -> (graph, False)
 
-	 -- we found something to freeze
-	 (n : _)
-	  -> ( freezeNode (nodeId n) graph
-	     , True)
+         -- we found something to freeze
+         (n : _)
+          -> ( freezeNode (nodeId n) graph
+             , True)
 
 
 -- | Freeze all the nodes in the graph
---	for debugging the iterative allocator.
+--      for debugging the iterative allocator.
 --
 freezeAllInGraph
-	:: (Uniquable k, Outputable k)
-	=> Graph k cls color
-	-> Graph k cls color
+        :: (Uniquable k, Outputable k)
+        => Graph k cls color
+        -> Graph k cls color
 
 freezeAllInGraph graph
-	= foldr freezeNode graph
-   		$ map nodeId
-		$ eltsUFM $ graphMap graph
+        = foldr freezeNode graph
+                $ map nodeId
+                $ eltsUFM $ graphMap graph
 
 
 -- | Find all the nodes in the graph that meet some criteria
 --
 scanGraph
-	:: Uniquable k
-	=> (Node k cls color -> Bool)
-	-> Graph k cls color
-	-> [Node k cls color]
+        :: Uniquable k
+        => (Node k cls color -> Bool)
+        -> Graph k cls color
+        -> [Node k cls color]
 
 scanGraph match graph
-	= filter match $ eltsUFM $ graphMap graph
+        = filter match $ eltsUFM $ graphMap graph
 
 
 -- | validate the internal structure of a graph
---	all its edges should point to valid nodes
---	If they don't then throw an error
+--      all its edges should point to valid nodes
+--      If they don't then throw an error
 --
 validateGraph
-	:: (Uniquable k, Outputable k, Eq color)
-	=> SDoc				-- ^ extra debugging info to display on error
-	-> Bool				-- ^ whether this graph is supposed to be colored.
-	-> Graph k cls color		-- ^ graph to validate
-	-> Graph k cls color		-- ^ validated graph
+        :: (Uniquable k, Outputable k, Eq color)
+        => SDoc                         -- ^ extra debugging info to display on error
+        -> Bool                         -- ^ whether this graph is supposed to be colored.
+        -> Graph k cls color            -- ^ graph to validate
+        -> Graph k cls color            -- ^ validated graph
 
 validateGraph doc isColored graph
 
-	-- Check that all edges point to valid nodes.
-  	| edges		<- unionManyUniqSets
- 				(  (map nodeConflicts       $ eltsUFM $ graphMap graph)
-				++ (map nodeCoalesce        $ eltsUFM $ graphMap graph))
-
-	, nodes		<- mkUniqSet $ map nodeId $ eltsUFM $ graphMap graph
-	, badEdges 	<- minusUniqSet edges nodes
-	, not $ isEmptyUniqSet badEdges
-	= pprPanic "GraphOps.validateGraph"
-		(  text "Graph has edges that point to non-existant nodes"
-		$$ text "  bad edges: " <> vcat (map ppr $ uniqSetToList badEdges)
-		$$ doc )
-
-	-- Check that no conflicting nodes have the same color
-	| badNodes	<- filter (not . (checkNode graph))
-			$ eltsUFM $ graphMap graph
-	, not $ null badNodes
-	= pprPanic "GraphOps.validateGraph"
-		(  text "Node has same color as one of it's conflicts"
-		$$ text "  bad nodes: " <> hcat (map (ppr . nodeId) badNodes)
-		$$ doc)
-
-	-- If this is supposed to be a colored graph,
-	--	check that all nodes have a color.
-	| isColored
-	, badNodes	<- filter (\n -> isNothing $ nodeColor n)
-			$  eltsUFM $ graphMap graph
-	, not $ null badNodes
-	= pprPanic "GraphOps.validateGraph"
-		(  text "Supposably colored graph has uncolored nodes."
-		$$ text "  uncolored nodes: " <> hcat (map (ppr . nodeId) badNodes)
-		$$ doc )
-
-
-	-- graph looks ok
-	| otherwise
-	= graph
+        -- Check that all edges point to valid nodes.
+        | edges         <- unionManyUniqSets
+                                (  (map nodeConflicts       $ eltsUFM $ graphMap graph)
+                                ++ (map nodeCoalesce        $ eltsUFM $ graphMap graph))
+
+        , nodes         <- mkUniqSet $ map nodeId $ eltsUFM $ graphMap graph
+        , badEdges      <- minusUniqSet edges nodes
+        , not $ isEmptyUniqSet badEdges
+        = pprPanic "GraphOps.validateGraph"
+                (  text "Graph has edges that point to non-existant nodes"
+                $$ text "  bad edges: " <> vcat (map ppr $ uniqSetToList badEdges)
+                $$ doc )
+
+        -- Check that no conflicting nodes have the same color
+        | badNodes      <- filter (not . (checkNode graph))
+                        $ eltsUFM $ graphMap graph
+        , not $ null badNodes
+        = pprPanic "GraphOps.validateGraph"
+                (  text "Node has same color as one of it's conflicts"
+                $$ text "  bad nodes: " <> hcat (map (ppr . nodeId) badNodes)
+                $$ doc)
+
+        -- If this is supposed to be a colored graph,
+        --      check that all nodes have a color.
+        | isColored
+        , badNodes      <- filter (\n -> isNothing $ nodeColor n)
+                        $  eltsUFM $ graphMap graph
+        , not $ null badNodes
+        = pprPanic "GraphOps.validateGraph"
+                (  text "Supposably colored graph has uncolored nodes."
+                $$ text "  uncolored nodes: " <> hcat (map (ppr . nodeId) badNodes)
+                $$ doc )
+
+
+        -- graph looks ok
+        | otherwise
+        = graph
 
 
 -- | If this node is colored, check that all the nodes which
---	conflict with it have different colors.
+--      conflict with it have different colors.
 checkNode
-	:: (Uniquable k, Eq color)
-	=> Graph k cls color
-	-> Node  k cls color
-	-> Bool			-- ^ True if this node is ok
-	
+        :: (Uniquable k, Eq color)
+        => Graph k cls color
+        -> Node  k cls color
+        -> Bool                 -- ^ True if this node is ok
+
 checkNode graph node
-	| Just color		<- nodeColor node
-	, Just neighbors	<- sequence $ map (lookupNode graph)
-				$  uniqSetToList $ nodeConflicts node
+        | Just color            <- nodeColor node
+        , Just neighbors        <- sequence $ map (lookupNode graph)
+                                $  uniqSetToList $ nodeConflicts node
+
+        , neighbourColors       <- catMaybes $ map nodeColor neighbors
+        , elem color neighbourColors
+        = False
 
-	, neighbourColors	<- catMaybes $ map nodeColor neighbors
-	, elem color neighbourColors
-	= False
-	
-	| otherwise
-	= True
+        | otherwise
+        = True
 
 
 
 -- | Slurp out a map of how many nodes had a certain number of conflict neighbours
 
 slurpNodeConflictCount
-	:: Uniquable k
-	=> Graph k cls color
-	-> UniqFM (Int, Int)	-- ^ (conflict neighbours, num nodes with that many conflicts)
+        :: Uniquable k
+        => Graph k cls color
+        -> UniqFM (Int, Int)    -- ^ (conflict neighbours, num nodes with that many conflicts)
 
 slurpNodeConflictCount graph
-	= addListToUFM_C
-		(\(c1, n1) (_, n2) -> (c1, n1 + n2))
-		emptyUFM
-	$ map 	(\node
-	 	  -> let count	= sizeUniqSet $ nodeConflicts node
-		     in  (count, (count, 1)))
-	$ eltsUFM
-	$ graphMap graph
+        = addListToUFM_C
+                (\(c1, n1) (_, n2) -> (c1, n1 + n2))
+                emptyUFM
+        $ map   (\node
+                  -> let count  = sizeUniqSet $ nodeConflicts node
+                     in  (count, (count, 1)))
+        $ eltsUFM
+        $ graphMap graph
 
 
 -- | Set the color of a certain node
-setColor 
-	:: Uniquable k
-	=> k -> color
-	-> Graph k cls color -> Graph k cls color
-	
+setColor
+        :: Uniquable k
+        => k -> color
+        -> Graph k cls color -> Graph k cls color
+
 setColor u color
- 	= graphMapModify
- 	$ adjustUFM_C
-		(\n -> n { nodeColor = Just color })
-		u 
-	
-
-{-# INLINE 	adjustWithDefaultUFM #-}
-adjustWithDefaultUFM 
-	:: Uniquable k 
-	=> (a -> a) -> a -> k 
-	-> UniqFM a -> UniqFM a
+        = graphMapModify
+        $ adjustUFM_C
+                (\n -> n { nodeColor = Just color })
+                u
+
+
+{-# INLINE adjustWithDefaultUFM #-}
+adjustWithDefaultUFM
+        :: Uniquable k
+        => (a -> a) -> a -> k
+        -> UniqFM a -> UniqFM a
 
 adjustWithDefaultUFM f def k map
-	= addToUFM_C 
-		(\old _ -> f old)
-		map
-		k def
-		
+        = addToUFM_C
+                (\old _ -> f old)
+                map
+                k def
+
 -- Argument order different from UniqFM's adjustUFM
 {-# INLINE adjustUFM_C #-}
-adjustUFM_C 
-	:: Uniquable k
-	=> (a -> a)
-	-> k -> UniqFM a -> UniqFM a
+adjustUFM_C
+        :: Uniquable k
+        => (a -> a)
+        -> k -> UniqFM a -> UniqFM a
 
 adjustUFM_C f k map
  = case lookupUFM map k of
- 	Nothing	-> map
-	Just a	-> addToUFM map k (f a)
+        Nothing -> map
+        Just a  -> addToUFM map k (f a)
 
diff --git a/compiler/utils/ListSetOps.lhs b/compiler/utils/ListSetOps.lhs
index 52415df353..0dc873eb62 100644
--- a/compiler/utils/ListSetOps.lhs
+++ b/compiler/utils/ListSetOps.lhs
@@ -19,8 +19,8 @@ module ListSetOps (
         equivClasses, equivClassesByUniq,
 
         -- Remove redudant elts
-        removeRedundant   -- Used in the ghc/InteractiveUI, 
-                          -- although not in the compiler itself
+        removeRedundant    -- Used in the ghc/InteractiveUI, 
+                           -- although not in the compiler itself
    ) where
 
 #include "HsVersions.h"
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 248f549aa3..b96ae5e063 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -23,7 +23,8 @@ module Outputable (
         char,
         text, ftext, ptext,
         int, intWithCommas, integer, float, double, rational,
-        parens, cparen, brackets, braces, quotes, quote, doubleQuotes, angleBrackets,
+        parens, cparen, brackets, braces, quotes, quote, 
+        doubleQuotes, angleBrackets, paBrackets,
         semi, comma, colon, dcolon, space, equals, dot, arrow, darrow,
         lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
         blankLine,
@@ -387,29 +388,29 @@ renderWithStyle sdoc sty =
 -- showSDoc, designed for when we're getting results like "Foo.bar"
 -- and "foo{uniq strictness}" so we don't want fancy layout anyway.
 showSDocOneLine :: SDoc -> String
-showSDocOneLine d =
-  Pretty.showDocWith PageMode
+showSDocOneLine d 
+ = Pretty.showDocWith PageMode
     (runSDoc d (initSDocContext defaultUserStyle))
 
 showSDocForUser :: PrintUnqualified -> SDoc -> String
-showSDocForUser unqual doc =
-  show (runSDoc doc (initSDocContext (mkUserStyle unqual AllTheWay)))
+showSDocForUser unqual doc
+ = show (runSDoc doc (initSDocContext (mkUserStyle unqual AllTheWay)))
 
 showSDocUnqual :: SDoc -> String
 -- Only used in the gruesome isOperator
-showSDocUnqual d =
-  show (runSDoc d (initSDocContext (mkUserStyle neverQualify AllTheWay)))
+showSDocUnqual d 
+ = show (runSDoc d (initSDocContext (mkUserStyle neverQualify AllTheWay)))
 
 showsPrecSDoc :: Int -> SDoc -> ShowS
 showsPrecSDoc p d = showsPrec p (runSDoc d (initSDocContext defaultUserStyle))
 
 showSDocDump :: SDoc -> String
-showSDocDump d =
-  Pretty.showDocWith PageMode (runSDoc d (initSDocContext PprDump))
+showSDocDump d 
+ = Pretty.showDocWith PageMode (runSDoc d (initSDocContext defaultDumpStyle))
 
 showSDocDumpOneLine :: SDoc -> String
-showSDocDumpOneLine d =
-  Pretty.showDocWith OneLineMode (runSDoc d (initSDocContext PprDump))
+showSDocDumpOneLine d
+ = Pretty.showDocWith OneLineMode (runSDoc d (initSDocContext PprDump))
 
 showSDocDebug :: SDoc -> String
 showSDocDebug d = show (runSDoc d (initSDocContext PprDebug))
@@ -444,27 +445,31 @@ float n     = docToSDoc $ Pretty.float n
 double n    = docToSDoc $ Pretty.double n
 rational n  = docToSDoc $ Pretty.rational n
 
-parens, braces, brackets, quotes, quote, doubleQuotes, angleBrackets :: SDoc -> SDoc
+parens, braces, brackets, quotes, quote, 
+        paBrackets, doubleQuotes, angleBrackets :: SDoc -> SDoc
 
-parens d       = SDoc $ Pretty.parens . runSDoc d
-braces d       = SDoc $ Pretty.braces . runSDoc d
-brackets d     = SDoc $ Pretty.brackets . runSDoc d
-quote d        = SDoc $ Pretty.quote . runSDoc d
-doubleQuotes d = SDoc $ Pretty.doubleQuotes . runSDoc d
+parens d        = SDoc $ Pretty.parens . runSDoc d
+braces d        = SDoc $ Pretty.braces . runSDoc d
+brackets d      = SDoc $ Pretty.brackets . runSDoc d
+quote d         = SDoc $ Pretty.quote . runSDoc d
+doubleQuotes d  = SDoc $ Pretty.doubleQuotes . runSDoc d
 angleBrackets d = char '<' <> d <> char '>'
+paBrackets d    = ptext (sLit "[:") <> d <> ptext (sLit ":]")
 
 cparen :: Bool -> SDoc -> SDoc
 
 cparen b d     = SDoc $ Pretty.cparen b . runSDoc d
 
 -- 'quotes' encloses something in single quotes...
--- but it omits them if the thing ends in a single quote
+-- but it omits them if the thing begins or ends in a single quote
 -- so that we don't get `foo''.  Instead we just have foo'.
 quotes d = SDoc $ \sty ->
-           let pp_d = runSDoc d sty in
-           case snocView (show pp_d) of
-             Just (_, '\'') -> pp_d
-             _other         -> Pretty.quotes pp_d
+           let pp_d = runSDoc d sty
+               str  = show pp_d
+           in case (str, snocView str) of
+             (_, Just (_, '\'')) -> pp_d
+             ('\'' : _, _)       -> pp_d
+             _other              -> Pretty.quotes pp_d
 
 semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc
 darrow, lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc
@@ -918,27 +923,27 @@ plural _   = char 's'
 
 pprPanic :: String -> SDoc -> a
 -- ^ Throw an exception saying "bug in GHC"
-pprPanic    = pprAndThen panic
+pprPanic    = pprDebugAndThen panic
 
 pprSorry :: String -> SDoc -> a
 -- ^ Throw an exception saying "this isn't finished yet"
-pprSorry    = pprAndThen sorry
+pprSorry    = pprDebugAndThen sorry
 
 
 pprPgmError :: String -> SDoc -> a
 -- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)
-pprPgmError = pprAndThen pgmError
+pprPgmError = pprDebugAndThen pgmError
 
 
 pprTrace :: String -> SDoc -> a -> a
 -- ^ If debug output is on, show some 'SDoc' on the screen
 pprTrace str doc x
    | opt_NoDebugOutput = x
-   | otherwise         = pprAndThen trace str doc x
+   | otherwise         = pprDebugAndThen trace str doc x
 
 pprDefiniteTrace :: String -> SDoc -> a -> a
 -- ^ Same as pprTrace, but show even if -dno-debug-output is on
-pprDefiniteTrace str doc x = pprAndThen trace str doc x
+pprDefiniteTrace str doc x = pprDebugAndThen trace str doc x
 
 pprPanicFastInt :: String -> SDoc -> FastInt
 -- ^ Specialization of pprPanic that can be safely used with 'FastInt'
@@ -947,33 +952,31 @@ pprPanicFastInt heading pretty_msg =
   where
     doc = text heading <+> pretty_msg
 
-
-pprAndThen :: (String -> a) -> String -> SDoc -> a
-pprAndThen cont heading pretty_msg =
-  cont (show (runSDoc doc (initSDocContext PprDebug)))
- where
-     doc = sep [text heading, nest 4 pretty_msg]
-
-assertPprPanic :: String -> Int -> SDoc -> a
--- ^ Panic with an assertation failure, recording the given file and line number.
--- Should typically be accessed with the ASSERT family of macros
-assertPprPanic file line msg
-  = panic (show (runSDoc doc (initSDocContext PprDebug)))
-  where
-    doc = sep [hsep[text "ASSERT failed! file",
-                           text file,
-                           text "line", int line],
-                    msg]
-
 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
 -- ^ Just warn about an assertion failure, recording the given file and line number.
 -- Should typically be accessed with the WARN macros
 warnPprTrace _     _file _line _msg x | opt_NoDebugOutput = x
 warnPprTrace False _file _line _msg x = x
 warnPprTrace True   file  line  msg x
-  = trace (show (runSDoc doc (initSDocContext defaultDumpStyle))) x
+  = pprDebugAndThen trace "WARNING:" doc x
   where
     doc = sep [hsep [text "WARNING: file", text file, text "line", int line],
                msg]
+
+assertPprPanic :: String -> Int -> SDoc -> a
+-- ^ Panic with an assertation failure, recording the given file and line number.
+-- Should typically be accessed with the ASSERT family of macros
+assertPprPanic file line msg
+  = pprDebugAndThen panic "ASSERT failed!" doc
+  where
+    doc = sep [ hsep [ text "file", text file
+                     , text "line", int line ]
+              , msg ]
+
+pprDebugAndThen :: (String -> a) -> String -> SDoc -> a
+pprDebugAndThen cont heading pretty_msg 
+ = cont (show (runSDoc doc (initSDocContext PprDebug)))
+ where
+     doc = sep [text heading, nest 4 pretty_msg]
 \end{code}
 
diff --git a/compiler/utils/Platform.hs b/compiler/utils/Platform.hs
index 66f51e64e6..47dd7798cd 100644
--- a/compiler/utils/Platform.hs
+++ b/compiler/utils/Platform.hs
@@ -58,6 +58,7 @@ data OS
         | OSOpenBSD
         | OSNetBSD
         | OSKFreeBSD
+        | OSHaiku
         deriving (Read, Show, Eq)
 
 -- | ARM Instruction Set Architecture and Extensions
@@ -91,6 +92,7 @@ osElfTarget OSSolaris2  = True
 osElfTarget OSDarwin    = False
 osElfTarget OSMinGW32   = False
 osElfTarget OSKFreeBSD  = True
+osElfTarget OSHaiku     = True
 osElfTarget OSUnknown   = False
  -- Defaulting to False is safe; it means don't rely on any
  -- ELF-specific functionality.  It is important to have a default for
diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 4ee6e190cc..259689c454 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -20,7 +20,9 @@ and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
 of arguments of combining function.
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs -XGeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{-# OPTIONS -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index d09a1ad345..12249d3a2b 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -74,7 +74,6 @@ module Util (
         maybeRead, maybeReadFuzzy,
 
         -- * IO-ish utilities
-        createDirectoryHierarchy,
         doesDirNameExist,
         getModificationUTCTime,
         modificationTimeIfExists,
@@ -109,10 +108,9 @@ import Data.List        hiding (group)
 import FastTypes
 #endif
 
-import Control.Monad    ( unless, liftM )
+import Control.Monad    ( liftM )
 import System.IO.Error as IO ( isDoesNotExistError )
-import System.Directory ( doesDirectoryExist, createDirectory,
-                          getModificationTime )
+import System.Directory ( doesDirectoryExist, getModificationTime )
 import System.FilePath
 
 import Data.Char        ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit )
@@ -1018,16 +1016,6 @@ maybeReadFuzzy str = case reads str of
                          Nothing
 
 -----------------------------------------------------------------------------
--- Create a hierarchy of directories
-
-createDirectoryHierarchy :: FilePath -> IO ()
-createDirectoryHierarchy dir | isDrive dir = return () -- XXX Hack
-createDirectoryHierarchy dir = do
-  b <- doesDirectoryExist dir
-  unless b $ do createDirectoryHierarchy (takeDirectory dir)
-                createDirectory dir
-
------------------------------------------------------------------------------
 -- Verify that the 'dirname' portion of a FilePath exists.
 --
 doesDirNameExist :: FilePath -> IO Bool