diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-08-30 08:57:40 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-08-31 08:16:58 +0100 |
| commit | 805b29bb873c792ca5bcbd5540026848f9f11a8d (patch) | |
| tree | 993291054fd388c0e493d11175ec27922d61bb1f /compiler/iface | |
| parent | fca196280d38d07a697fbccdd8527821206b33eb (diff) | |
| download | haskell-805b29bb873c792ca5bcbd5540026848f9f11a8d.tar.gz | |
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
Diffstat (limited to 'compiler/iface')
| -rw-r--r-- | compiler/iface/IfaceSyn.hs | 2 | ||||
| -rw-r--r-- | compiler/iface/IfaceType.hs | 2 | ||||
| -rw-r--r-- | compiler/iface/LoadIface.hs | 2 |
3 files changed, 3 insertions, 3 deletions
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index 3360d742ef..13eb2089a7 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -996,7 +996,7 @@ pprIfaceConDecl ss gadt_style tycon tc_binders parent | otherwise = sep [pp_field_args, arrow <+> pp_res_ty] - ppr_bang IfNoBang = sdocWithPprDebug $ \dbg -> ppWhen dbg $ char '_' + ppr_bang IfNoBang = whenPprDebug $ char '_' ppr_bang IfStrict = char '!' ppr_bang IfUnpack = text "{-# UNPACK #-}" ppr_bang (IfUnpackCo co) = text "! {-# UNPACK #-}" <> diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index b1ad780782..f623ca2997 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -882,7 +882,7 @@ pprTyTcApp' ctxt_prec tc tys dflags style = kindStar | otherwise - = sdocWithPprDebug $ \dbg -> + = getPprDebug $ \dbg -> if | not dbg && tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey -- Suppress detail unles you _really_ want to see -> text "(TypeError ...)" diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index b1a3ef1e6f..01fdaacd9f 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -144,7 +144,7 @@ importDecl name { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of Just thing -> return $ Succeeded thing - Nothing -> let doc = ifPprDebug (found_things_msg eps $$ empty) + Nothing -> let doc = whenPprDebug (found_things_msg eps $$ empty) $$ not_found_msg in return $ Failed doc }}} |