[commit: ghc] wip/spj-temp: Improve -dsuppress-uniques (88671b7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/spj-temp
Link       : http://ghc.haskell.org/trac/ghc/changeset/88671b7f99950f79bf1147a682dff79b40433660/ghc

>---------------------------------------------------------------

commit 88671b7f99950f79bf1147a682dff79b40433660
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sun Sep 25 06:23:56 2016 +0100

    Improve -dsuppress-uniques
    
    This just makes -dsuppress-uniques work more uniformly
    by putting the work into pprUnique


>---------------------------------------------------------------

88671b7f99950f79bf1147a682dff79b40433660
 compiler/basicTypes/Name.hs    | 6 +-----
 compiler/basicTypes/Unique.hs  | 6 +++++-
 compiler/main/DynFlags.hs      | 5 ++++-
 compiler/main/DynFlags.hs-boot | 3 ++-
 4 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index d1b05f3..54f946e 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -577,11 +577,7 @@ pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->
 ppr_underscore_unique :: Unique -> SDoc
 -- Print an underscore separating the name from its unique
 -- But suppress it if we aren't printing the uniques anyway
-ppr_underscore_unique uniq
-  = sdocWithDynFlags $ \dflags ->
-    if gopt Opt_SuppressUniques dflags
-    then empty
-    else char '_' <> pprUnique uniq
+ppr_underscore_unique uniq = char '_' <> pprUnique uniq
 
 ppr_occ_name :: OccName -> SDoc
 ppr_occ_name occ = ftext (occNameFS occ)
diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs
index c933d61..914fe77 100644
--- a/compiler/basicTypes/Unique.hs
+++ b/compiler/basicTypes/Unique.hs
@@ -66,6 +66,7 @@ module Unique (
 
 import BasicTypes
 import FastString
+import {-# SOURCE #-} DynFlags( suppressUniques )
 import Outputable
 import Util
 
@@ -262,7 +263,10 @@ finish_show 't' u _pp_u | u < 26
 finish_show tag _ pp_u = tag : pp_u
 
 pprUnique :: Unique -> SDoc
-pprUnique u = text (showUnique u)
+pprUnique u = sdocWithDynFlags $ \dflags ->
+              if (suppressUniques dflags)
+              then text "xxx"
+              else text (showUnique u)
 
 instance Outputable Unique where
     ppr = pprUnique
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b642bea..3a0ac76 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -32,7 +32,7 @@ module DynFlags (
         wopt, wopt_set, wopt_unset,
         xopt, xopt_set, xopt_unset,
         lang_set,
-        useUnicodeSyntax,
+        useUnicodeSyntax, suppressUniques,
         whenGeneratingDynamicToo, ifGeneratingDynamicToo,
         whenCannotGenerateDynamicToo,
         dynamicTooMkDynamicDynFlags,
@@ -1866,6 +1866,9 @@ lang_set dflags lang =
 useUnicodeSyntax :: DynFlags -> Bool
 useUnicodeSyntax = gopt Opt_PrintUnicodeSyntax
 
+suppressUniques :: DynFlags -> Bool
+suppressUniques = gopt Opt_SuppressUniques
+
 -- | Set the Haskell language standard to use
 setLanguage :: Language -> DynP ()
 setLanguage l = upd (`lang_set` Just l)
diff --git a/compiler/main/DynFlags.hs-boot b/compiler/main/DynFlags.hs-boot
index 5cf2166..2c45e0c 100644
--- a/compiler/main/DynFlags.hs-boot
+++ b/compiler/main/DynFlags.hs-boot
@@ -9,5 +9,6 @@ targetPlatform       :: DynFlags -> Platform
 pprUserLength        :: DynFlags -> Int
 pprCols              :: DynFlags -> Int
 unsafeGlobalDynFlags :: DynFlags
-useUnicode     :: DynFlags -> Bool
+useUnicode           :: DynFlags -> Bool
 useUnicodeSyntax     :: DynFlags -> Bool
+suppressUniques      :: DynFlags -> Bool