Merge branch 'master' into wip/ext-solverwip/ext-solver

25 files changed, 107 insertions, 63 deletions

diff --git a/compiler/utils/Bag.lhs b/compiler/utils/Bag.lhs
index 2d823e46bb..65c5b39df1 100644
--- a/compiler/utils/Bag.lhs
+++ b/compiler/utils/Bag.lhs
@@ -6,6 +6,8 @@
 Bag: an unordered collection with duplicates
 
 \begin{code}
+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
+
 module Bag (
         Bag, -- abstract type
 
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 332bfc8e0c..82d1497ee6 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -cpp #-}
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O -funbox-strict-fields #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
@@ -707,14 +707,13 @@ getBS bh = do
   l <- get bh
   fp <- mallocForeignPtrBytes l
   withForeignPtr fp $ \ptr -> do
-  let
-        go n | n == l = return $ BS.fromForeignPtr fp 0 l
+    let go n | n == l = return $ BS.fromForeignPtr fp 0 l
              | otherwise = do
                 b <- getByte bh
                 pokeElemOff ptr n b
                 go (n+1)
-  --
-  go 0
+    --
+    go 0
 
 instance Binary ByteString where
   put_ bh f = putBS bh f
@@ -834,18 +833,26 @@ instance Binary RecFlag where
               0 -> do return Recursive
               _ -> do return NonRecursive
 
-instance Binary OverlapFlag where
-    put_ bh (NoOverlap  b) = putByte bh 0 >> put_ bh b
-    put_ bh (OverlapOk  b) = putByte bh 1 >> put_ bh b
-    put_ bh (Incoherent b) = putByte bh 2 >> put_ bh b
+instance Binary OverlapMode where
+    put_ bh NoOverlap   = putByte bh 0
+    put_ bh OverlapOk   = putByte bh 1
+    put_ bh Incoherent  = putByte bh 2
     get bh = do
         h <- getByte bh
-        b <- get bh
         case h of
-            0 -> return $ NoOverlap b
-            1 -> return $ OverlapOk b
-            2 -> return $ Incoherent b
-            _ -> panic ("get OverlapFlag " ++ show h)
+            0 -> return NoOverlap
+            1 -> return OverlapOk
+            2 -> return Incoherent
+            _ -> panic ("get OverlapMode" ++ show h)
+
+
+instance Binary OverlapFlag where
+    put_ bh flag = do put_ bh (overlapMode flag)
+                      put_ bh (isSafeOverlap flag)
+    get bh = do
+        h <- get bh
+        b <- get bh
+        return OverlapFlag { overlapMode = h, isSafeOverlap = b }
 
 instance Binary FixityDirection where
     put_ bh InfixL = do
diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs
index f85ea8e792..7eba0753fe 100644
--- a/compiler/utils/BufWrite.hs
+++ b/compiler/utils/BufWrite.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Fast write-buffered Handles
@@ -10,7 +12,7 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -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/Digraph.lhs b/compiler/utils/Digraph.lhs
index cc684303b6..d22380ff6e 100644
--- a/compiler/utils/Digraph.lhs
+++ b/compiler/utils/Digraph.lhs
@@ -3,22 +3,22 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -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://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
 -- for details
 
-{-# LANGUAGE ScopedTypeVariables #-}
 module Digraph(
         Graph, graphFromVerticesAndAdjacency, graphFromEdgedVertices,
 
         SCC(..), Node, flattenSCC, flattenSCCs,
-        stronglyConnCompG, stronglyConnCompFromG,
+        stronglyConnCompG,
         topologicalSortG, dfsTopSortG,
         verticesG, edgesG, hasVertexG,
-        reachableG, transposeG,
+        reachableG, reachablesG, transposeG,
         outdegreeG, indegreeG,
         vertexGroupsG, emptyG,
         componentsG,
@@ -258,14 +258,6 @@ stronglyConnCompG :: Graph node -> [SCC node]
 stronglyConnCompG graph = decodeSccs graph forest
   where forest = {-# SCC "Digraph.scc" #-} scc (gr_int_graph graph)
 
--- Find the set of strongly connected components starting from the
--- given roots.  This is a good way to discard unreachable nodes at
--- the same time as computing SCCs.
-stronglyConnCompFromG :: Graph node -> [node] -> [SCC node]
-stronglyConnCompFromG graph roots = decodeSccs graph forest
-  where forest = {-# SCC "Digraph.scc" #-} sccFrom (gr_int_graph graph) vs
-        vs = [ v | Just v <- map (gr_node_to_vertex graph) roots ]
-
 decodeSccs :: Graph node -> Forest Vertex -> [SCC node]
 decodeSccs Graph { gr_int_graph = graph, gr_vertex_to_node = vertex_fn } forest
   = map decode forest
@@ -315,7 +307,13 @@ dfsTopSortG graph =
 reachableG :: Graph node -> node -> [node]
 reachableG graph from = map (gr_vertex_to_node graph) result
   where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from)
-        result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) from_vertex
+        result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) [from_vertex]
+
+reachablesG :: Graph node -> [node] -> [node]
+reachablesG graph froms = map (gr_vertex_to_node graph) result
+  where result = {-# SCC "Digraph.reachable" #-} 
+                 reachable (gr_int_graph graph) vs
+        vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ]
 
 hasVertexG :: Graph node -> node -> Bool
 hasVertexG graph node = isJust $ gr_node_to_vertex graph node
@@ -548,9 +546,6 @@ postorderF ts = foldr (.) id $ map postorder ts
 postOrd :: IntGraph -> [Vertex]
 postOrd g = postorderF (dff g) []
 
-postOrdFrom :: IntGraph -> [Vertex] -> [Vertex]
-postOrdFrom g vs = postorderF (dfs g vs) []
-
 topSort :: IntGraph -> [Vertex]
 topSort = reverse . postOrd
 \end{code}
@@ -574,9 +569,6 @@ undirected g  = buildG (bounds g) (edges g ++ reverseE g)
 \begin{code}
 scc  :: IntGraph -> Forest Vertex
 scc g = dfs g (reverse (postOrd (transpose g)))
-
-sccFrom  :: IntGraph -> [Vertex] -> Forest Vertex
-sccFrom g vs = reverse (dfs (transpose g) (reverse (postOrdFrom g vs)))
 \end{code}
 
 ------------------------------------------------------------
@@ -602,11 +594,11 @@ forward g tree pre = mapT select g
 ------------------------------------------------------------
 
 \begin{code}
-reachable    :: IntGraph -> Vertex -> [Vertex]
-reachable g v = preorderF (dfs g [v])
+reachable    :: IntGraph -> [Vertex] -> [Vertex]
+reachable g vs = preorderF (dfs g vs)
 
 path         :: IntGraph -> Vertex -> Vertex -> Bool
-path g v w    = w `elem` (reachable g v)
+path g v w    = w `elem` (reachable g [v])
 \end{code}
 
 ------------------------------------------------------------
diff --git a/compiler/utils/Encoding.hs b/compiler/utils/Encoding.hs
index c4a669c134..115703fc69 100644
--- a/compiler/utils/Encoding.hs
+++ b/compiler/utils/Encoding.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
diff --git a/compiler/utils/ExtsCompat46.hs b/compiler/utils/ExtsCompat46.hs
index da0e67ab93..a33fef57d8 100644
--- a/compiler/utils/ExtsCompat46.hs
+++ b/compiler/utils/ExtsCompat46.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
 
 -----------------------------------------------------------------------------
 -- |
diff --git a/compiler/utils/FastBool.lhs b/compiler/utils/FastBool.lhs
index 32cb7aef3a..9558da7079 100644
--- a/compiler/utils/FastBool.lhs
+++ b/compiler/utils/FastBool.lhs
@@ -4,6 +4,8 @@
 \section{Fast booleans}
 
 \begin{code}
+{-# LANGUAGE CPP, MagicHash #-}
+
 module FastBool (
     --fastBool could be called bBox; isFastTrue, bUnbox; but they're not
     FastBool, fastBool, isFastTrue, fastOr, fastAnd
diff --git a/compiler/utils/FastFunctions.lhs b/compiler/utils/FastFunctions.lhs
index b1dacdcd9b..457fcc9c93 100644
--- a/compiler/utils/FastFunctions.lhs
+++ b/compiler/utils/FastFunctions.lhs
@@ -4,6 +4,7 @@ Z%
 \section{Fast functions}
 
 \begin{code}
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
 
 module FastFunctions (
     unsafeChr, inlinePerformIO, unsafeDupableInterleaveIO,
diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs
index 7156cdc9fb..0f0ca78e14 100644
--- a/compiler/utils/FastMutInt.lhs
+++ b/compiler/utils/FastMutInt.lhs
@@ -1,6 +1,5 @@
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
-{-# OPTIONS -cpp #-}
+{-# LANGUAGE CPP, BangPatterns, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 5a78c0b59b..0396c02749 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -2,7 +2,7 @@
 % (c) The University of Glasgow, 1997-2006
 %
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O -funbox-strict-fields #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
diff --git a/compiler/utils/FastTypes.lhs b/compiler/utils/FastTypes.lhs
index 0ef10ade56..36d8e4c4fd 100644
--- a/compiler/utils/FastTypes.lhs
+++ b/compiler/utils/FastTypes.lhs
@@ -4,6 +4,7 @@
 \section{Fast integers, etc... booleans moved to FastBool for using panic}
 
 \begin{code}
+{-# LANGUAGE CPP, MagicHash #-}
 
 --Even if the optimizer could handle boxed arithmetic equally well,
 --this helps automatically check the sources to make sure that
diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc
index 9a55e385b3..464337b7a9 100644
--- a/compiler/utils/Fingerprint.hsc
+++ b/compiler/utils/Fingerprint.hsc
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- ----------------------------------------------------------------------------
 --
 --  (c) The University of Glasgow 2006
diff --git a/compiler/utils/GraphBase.hs b/compiler/utils/GraphBase.hs
index 8cb3acee71..2aa16ae99e 100644
--- a/compiler/utils/GraphBase.hs
+++ b/compiler/utils/GraphBase.hs
@@ -1,7 +1,7 @@
 
 -- | Types for the general graph colorer.
 
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -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/GraphPpr.hs b/compiler/utils/GraphPpr.hs
index a896bbbf63..2682c7347e 100644
--- a/compiler/utils/GraphPpr.hs
+++ b/compiler/utils/GraphPpr.hs
@@ -1,7 +1,7 @@
 
 -- | Pretty printing of graphs.
 
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -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/IOEnv.hs b/compiler/utils/IOEnv.hs
index 6885bbd127..1db15537c7 100644
--- a/compiler/utils/IOEnv.hs
+++ b/compiler/utils/IOEnv.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveDataTypeable, UndecidableInstances #-}
+
 --
 -- (c) The University of Glasgow 2002-2006
 --
@@ -7,7 +9,6 @@
 -- as its in the IO monad, mutable references can be used
 -- for updating state.
 --
-{-# LANGUAGE UndecidableInstances #-}
 
 module IOEnv (
         IOEnv, -- Instance of Monad
diff --git a/compiler/utils/ListSetOps.lhs b/compiler/utils/ListSetOps.lhs
index 5ad402d081..6247dc67f6 100644
--- a/compiler/utils/ListSetOps.lhs
+++ b/compiler/utils/ListSetOps.lhs
@@ -5,6 +5,7 @@
 \section[ListSetOps]{Set-like operations on lists}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 
 module ListSetOps (
         unionLists, minusList, insertList,
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 85d3d03557..e32261de65 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -22,11 +22,12 @@ module Outputable (
         char,
         text, ftext, ptext, ztext,
         int, intWithCommas, integer, float, double, rational,
-        parens, cparen, brackets, braces, quotes, quote, 
+        parens, cparen, brackets, braces, quotes, quote,
         doubleQuotes, angleBrackets, paBrackets,
-        semi, comma, colon, dcolon, space, equals, dot, arrow, darrow,
+        semi, comma, colon, dcolon, space, equals, dot,
+        arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt,
         lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
-        blankLine,
+        blankLine, forAllLit,
         (<>), (<+>), hcat, hsep,
         ($$), ($+$), vcat,
         sep, cat,
@@ -73,7 +74,7 @@ module Outputable (
 
 import {-# SOURCE #-}   DynFlags( DynFlags,
                                   targetPlatform, pprUserLength, pprCols,
-                                  useUnicodeQuotes,
+                                  useUnicode, useUnicodeSyntax,
                                   unsafeGlobalDynFlags )
 import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
 import {-# SOURCE #-}   OccName( OccName )
@@ -458,7 +459,7 @@ cparen b d     = SDoc $ Pretty.cparen b . runSDoc d
 -- so that we don't get `foo''.  Instead we just have foo'.
 quotes d =
       sdocWithDynFlags $ \dflags ->
-      if useUnicodeQuotes dflags
+      if useUnicode dflags
       then char '‘' <> d <> char '’'
       else SDoc $ \sty ->
            let pp_d = runSDoc d sty
@@ -468,13 +469,19 @@ quotes 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
+semi, comma, colon, equals, space, dcolon, underscore, dot :: SDoc
+arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt :: SDoc
+lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc
 
 blankLine  = docToSDoc $ Pretty.ptext (sLit "")
-dcolon     = docToSDoc $ Pretty.ptext (sLit "::")
-arrow      = docToSDoc $ Pretty.ptext (sLit "->")
-darrow     = docToSDoc $ Pretty.ptext (sLit "=>")
+dcolon     = unicodeSyntax (char '∷') (docToSDoc $ Pretty.ptext (sLit "::"))
+arrow      = unicodeSyntax (char '→') (docToSDoc $ Pretty.ptext (sLit "->"))
+larrow     = unicodeSyntax (char '←') (docToSDoc $ Pretty.ptext (sLit "<-"))
+darrow     = unicodeSyntax (char '⇒') (docToSDoc $ Pretty.ptext (sLit "=>"))
+arrowt     = unicodeSyntax (char '↣') (docToSDoc $ Pretty.ptext (sLit ">-"))
+larrowt    = unicodeSyntax (char '↢') (docToSDoc $ Pretty.ptext (sLit "-<"))
+arrowtt    = unicodeSyntax (char '⤜') (docToSDoc $ Pretty.ptext (sLit ">>-"))
+larrowtt   = unicodeSyntax (char '⤛') (docToSDoc $ Pretty.ptext (sLit "-<<"))
 semi       = docToSDoc $ Pretty.semi
 comma      = docToSDoc $ Pretty.comma
 colon      = docToSDoc $ Pretty.colon
@@ -489,6 +496,15 @@ rbrack     = docToSDoc $ Pretty.rbrack
 lbrace     = docToSDoc $ Pretty.lbrace
 rbrace     = docToSDoc $ Pretty.rbrace
 
+forAllLit :: SDoc
+forAllLit = unicodeSyntax (char '∀') (ptext (sLit "forall"))
+
+unicodeSyntax :: SDoc -> SDoc -> SDoc
+unicodeSyntax unicode plain = sdocWithDynFlags $ \dflags ->
+    if useUnicode dflags && useUnicodeSyntax dflags
+    then unicode
+    else plain
+
 nest :: Int -> SDoc -> SDoc
 -- ^ Indent 'SDoc' some specified amount
 (<>) :: SDoc -> SDoc -> SDoc
diff --git a/compiler/utils/Pair.lhs b/compiler/utils/Pair.lhs
index 9e847d6950..ca7c2a7f8e 100644
--- a/compiler/utils/Pair.lhs
+++ b/compiler/utils/Pair.lhs
@@ -3,6 +3,8 @@ A simple homogeneous pair type with useful Functor, Applicative, and
 Traversable instances.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module Pair ( Pair(..), unPair, toPair, swap ) where
 
 #include "HsVersions.h"
diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index fc04668ae1..583174b201 100644
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -8,6 +8,8 @@ It's hard to put these functions anywhere else without causing
 some unnecessary loops in the module dependency graph.
 
 \begin{code}
+{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
+
 module Panic (
      GhcException(..), showGhcException,
      throwGhcException, throwGhcExceptionIO,
diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs
index fb7fe2b7fb..f6a5a44e2e 100644
--- a/compiler/utils/Pretty.lhs
+++ b/compiler/utils/Pretty.lhs
@@ -152,7 +152,7 @@ Relative to John's original paper, there are the following new features:
 
 
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
 
 module Pretty (
         Doc,            -- Abstract
diff --git a/compiler/utils/Serialized.hs b/compiler/utils/Serialized.hs
index 902d2feea0..b1576a087f 100644
--- a/compiler/utils/Serialized.hs
+++ b/compiler/utils/Serialized.hs
@@ -1,9 +1,10 @@
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
+
 --
 -- (c) The University of Glasgow 2002-2006
 --
 -- Serialized values
 
-{-# LANGUAGE ScopedTypeVariables #-}
 module Serialized (
     -- * Main Serialized data type
     Serialized,
diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs
index 0b6a285562..216034fdbf 100644
--- a/compiler/utils/State.hs
+++ b/compiler/utils/State.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE UnboxedTuples #-}
 
 module State (module State, mapAccumLM {- XXX hack -}) where
 
diff --git a/compiler/utils/StringBuffer.lhs b/compiler/utils/StringBuffer.lhs
index 46cce5864d..a54f45ffff 100644
--- a/compiler/utils/StringBuffer.lhs
+++ b/compiler/utils/StringBuffer.lhs
@@ -6,7 +6,7 @@
 Buffers for scanning string input stored in external arrays.
 
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O -funbox-strict-fields #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index a13a17c412..d8e08f599a 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -20,9 +20,9 @@ and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
 of arguments of combining function.
 
 \begin{code}
-{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveTraversable, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -Wall #-}
 
-{-# OPTIONS -Wall #-}
 module UniqFM (
         -- * Unique-keyed mappings
         UniqFM,       -- abstract type
@@ -60,9 +60,10 @@ module UniqFM (
         eltsUFM, keysUFM, splitUFM,
         ufmToSet_Directly,
         ufmToList,
-        joinUFM
+        joinUFM, pprUniqFM
     ) where
 
+import FastString
 import Unique           ( Uniquable(..), Unique, getKey )
 import Outputable
 
@@ -319,5 +320,11 @@ joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange,
 
 \begin{code}
 instance Outputable a => Outputable (UniqFM a) where
-    ppr ufm = ppr (ufmToList ufm)
+    ppr ufm = pprUniqFM ppr ufm
+
+pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc
+pprUniqFM ppr_elt ufm
+  = brackets $ fsep $ punctuate comma $
+    [ ppr uq <+> ptext (sLit ":->") <+> ppr_elt elt
+    | (uq, elt) <- ufmToList ufm ]
 \end{code}
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 5c82c757aa..2dcc73fd89 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -3,6 +3,7 @@
 %
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 
 -- | Highly random utility functions
 --
@@ -46,7 +47,7 @@ module Util (
         nTimes,
 
         -- * Sorting
-        sortWith, minWith,
+        sortWith, minWith, nubSort,
 
         -- * Comparisons
         isEqual, eqListBy, eqMaybeBy,
@@ -125,6 +126,7 @@ import Data.Ord         ( comparing )
 import Data.Bits
 import Data.Word
 import qualified Data.IntMap as IM
+import qualified Data.Set as Set
 
 import Data.Time
 #if __GLASGOW_HASKELL__ < 705
@@ -489,6 +491,9 @@ sortWith get_key xs = sortBy (comparing get_key) xs
 minWith :: Ord b => (a -> b) -> [a] -> a
 minWith get_key xs = ASSERT( not (null xs) )
                      head (sortWith get_key xs)
+
+nubSort :: Ord a => [a] -> [a]
+nubSort = Set.toAscList . Set.fromList
 \end{code}
 
 %************************************************************************