Merge remote-tracking branch 'origin/master' into tc-arrowstc-arrows

2 files changed, 13 insertions, 22 deletions

diff --git a/compiler/utils/Exception.hs b/compiler/utils/Exception.hs
index b4908997a8..850393e359 100644
--- a/compiler/utils/Exception.hs
+++ b/compiler/utils/Exception.hs
@@ -21,11 +21,11 @@ tryIO = try
 -- | A monad that can catch exceptions.  A minimal definition
 -- requires a definition of 'gcatch'.
 --
--- Implementations on top of 'IO' should implement 'gblock' and 'gunblock' to
--- eventually call the primitives 'Control.Exception.block' and
--- 'Control.Exception.unblock' respectively.  These are used for
+-- Implementations on top of 'IO' should implement 'gmask' to
+-- eventually call the primitive 'Control.Exception.mask'.
+-- These are used for
 -- implementations that support asynchronous exceptions.  The default
--- implementations of 'gbracket' and 'gfinally' use 'gblock' and 'gunblock'
+-- implementations of 'gbracket' and 'gfinally' use 'gmask'
 -- thus rarely require overriding.
 --
 class MonadIO m => ExceptionMonad m where
@@ -46,20 +46,6 @@ class MonadIO m => ExceptionMonad m where
   -- exception handling monad instead of just 'IO'.
   gfinally :: m a -> m b -> m a
 
-  -- | DEPRECATED, here for backwards compatibilty.  Instances can
-  -- define either 'gmask', or both 'block' and 'unblock'.
-  gblock   :: m a -> m a
-  -- | DEPRECATED, here for backwards compatibilty  Instances can
-  -- define either 'gmask', or both 'block' and 'unblock'.
-  gunblock :: m a -> m a
-  -- XXX we're keeping these two methods for the time being because we
-  -- have to interact with Haskeline's MonadException class which
-  -- still has block/unblock; see GhciMonad.hs.
-
-  gmask    f = gblock (f gunblock)
-  gblock   f = gmask (\_ -> f)
-  gunblock f = f -- XXX wrong; better override this if you need it
-
   gbracket before after thing =
     gmask $ \restore -> do
       a <- before
@@ -76,8 +62,6 @@ class MonadIO m => ExceptionMonad m where
 instance ExceptionMonad IO where
   gcatch    = Control.Exception.catch
   gmask f   = mask (\x -> f x)
-  gblock    = block
-  gunblock  = unblock
 
 gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
 gtry act = gcatch (act >>= \a -> return (Right a))
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 4e741b44fb..f26f918068 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -72,6 +72,7 @@ module Outputable (
 
 import {-# SOURCE #-}   DynFlags( DynFlags,
                                   targetPlatform, pprUserLength, pprCols,
+                                  useUnicodeQuotes,
                                   unsafeGlobalDynFlags )
 import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
 import {-# SOURCE #-}   Name( Name, nameModule )
@@ -260,7 +261,9 @@ pprDeeper d = SDoc $ \ctx -> case ctx of
 
 pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
 -- Truncate a list that list that is longer than the current depth
-pprDeeperList f ds = SDoc work
+pprDeeperList f ds 
+  | null ds   = f []
+  | otherwise = SDoc work
  where
   work ctx@SDC{sdocStyle=PprUser q (PartWay n)}
    | n==0      = Pretty.text "..."
@@ -446,7 +449,11 @@ cparen b d     = SDoc $ Pretty.cparen b . runSDoc d
 -- 'quotes' encloses something in single quotes...
 -- 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 ->
+quotes d =
+      sdocWithDynFlags $ \dflags ->
+      if useUnicodeQuotes dflags
+      then char '‛' <> d <> char '’'
+      else SDoc $ \sty ->
            let pp_d = runSDoc d sty
                str  = show pp_d
            in case (str, snocView str) of