Add debugPprType

We pretty-print a type by converting it to an IfaceType and
pretty-printing that.  But
 (a) that's a bit indirect, and
 (b) delibrately loses information about (e.g.) the kind
      on the /occurrences/ of a type variable

So this patch implements debugPprType, which pretty prints
the type directly, with no fancy formatting.  It's just used
for debugging.

I took the opportunity to refactor the debug-pretty-printing
machinery a little.  In particular, define these functions
and use them:

  ifPprDeubug :: SDoc -> SDOc -> SDoc
    -- Says what to do with and without -dppr-debug
  whenPprDebug :: SDoc -> SDoc
    -- Says what to do with  -dppr-debug; without is empty
  getPprDebug :: (Bool -> SDoc) -> SDoc

getPprDebug used to be called sdocPprDebugWith
whenPprDebug used to be called ifPprDebug

So a lot of files get touched in a very mechanical way

2 files changed, 7 insertions, 8 deletions

diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs
index b5606754e6..a0f42cd2b5 100644
--- a/compiler/specialise/Rules.hs
+++ b/compiler/specialise/Rules.hs
@@ -418,14 +418,13 @@ findBest _      (rule,ans)   [] = (rule,ans)
 findBest target (rule1,ans1) ((rule2,ans2):prs)
   | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs
   | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs
-  | debugIsOn = let pp_rule rule = sdocWithPprDebug $ \dbg -> if dbg
-                        then ppr rule
-                        else doubleQuotes (ftext (ruleName rule))
+  | debugIsOn = let pp_rule rule
+                      = ifPprDebug (ppr rule)
+                                   (doubleQuotes (ftext (ruleName rule)))
                 in pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"
-                         (vcat [ sdocWithPprDebug $ \dbg -> if dbg
-                                   then text "Expression to match:" <+> ppr fn
-                                        <+> sep (map ppr args)
-                                   else empty
+                         (vcat [ whenPprDebug $
+                                 text "Expression to match:" <+> ppr fn
+                                 <+> sep (map ppr args)
                                , text "Rule 1:" <+> pp_rule rule1
                                , text "Rule 2:" <+> pp_rule rule2]) $
                 findBest target (rule1,ans1) prs
diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs
index 0fb7eb0472..a0844b7dfa 100644
--- a/compiler/specialise/Specialise.hs
+++ b/compiler/specialise/Specialise.hs
@@ -733,7 +733,7 @@ specImport dflags this_mod top_env done callers rb fn calls_for_fn
   = do { warnMsg (vcat [ hang (text "Could not specialise imported function" <+> quotes (ppr fn))
                             2 (vcat [ text "when specialising" <+> quotes (ppr caller)
                                     | caller <- callers])
-                      , ifPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn))
+                      , whenPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn))
                       , text "Probable fix: add INLINABLE pragma on" <+> quotes (ppr fn) ])
        ; return ([], []) }