never executed always true always false
1 {-# LANGUAGE PatternSynonyms #-}
2
3 -- | Pretty-printing types and coercions.
4 module GHC.Core.TyCo.Ppr
5 (
6 -- * Precedence
7 PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,
8
9 -- * Pretty-printing types
10 pprType, pprParendType, pprTidiedType, pprPrecType, pprPrecTypeX,
11 pprTypeApp, pprTCvBndr, pprTCvBndrs,
12 pprSigmaType,
13 pprTheta, pprParendTheta, pprForAll, pprUserForAll,
14 pprTyVar, pprTyVars,
15 pprThetaArrowTy, pprClassPred,
16 pprKind, pprParendKind, pprTyLit,
17 pprDataCons, pprWithExplicitKindsWhen,
18 pprWithTYPE, pprSourceTyCon,
19
20
21 -- * Pretty-printing coercions
22 pprCo, pprParendCo,
23
24 debugPprType,
25 ) where
26
27 import GHC.Prelude
28
29 import {-# SOURCE #-} GHC.CoreToIface
30 ( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr
31 , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX )
32
33 import {-# SOURCE #-} GHC.Core.DataCon
34 ( dataConFullSig , dataConUserTyVarBinders, DataCon )
35
36 import GHC.Core.Type ( pickyIsLiftedTypeKind, pattern One, pattern Many,
37 splitForAllReqTVBinders, splitForAllInvisTVBinders )
38
39 import GHC.Core.TyCon
40 import GHC.Core.TyCo.Rep
41 import GHC.Core.TyCo.Tidy
42 import GHC.Core.TyCo.FVs
43 import GHC.Core.Class
44 import GHC.Types.Var
45
46 import GHC.Iface.Type
47
48 import GHC.Types.Var.Set
49 import GHC.Types.Var.Env
50
51 import GHC.Utils.Outputable
52 import GHC.Utils.Panic
53 import GHC.Types.Basic ( PprPrec(..), topPrec, sigPrec, opPrec
54 , funPrec, appPrec, maybeParen )
55
56 {-
57 %************************************************************************
58 %* *
59 Pretty-printing types
60
61 Defined very early because of debug printing in assertions
62 %* *
63 %************************************************************************
64
65 @pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
66 defined to use this. @pprParendType@ is the same, except it puts
67 parens around the type, except for the atomic cases. @pprParendType@
68 works just by setting the initial context precedence very high.
69
70 Note that any function which pretty-prints a @Type@ first converts the @Type@
71 to an @IfaceType@. See Note [IfaceType and pretty-printing] in GHC.Iface.Type.
72
73 See Note [Precedence in types] in GHC.Types.Basic.
74 -}
75
76 --------------------------------------------------------
77 -- When pretty-printing types, we convert to IfaceType,
78 -- and pretty-print that.
79 -- See Note [Pretty printing via Iface syntax] in GHC.Types.TyThing.Ppr
80 --------------------------------------------------------
81
82 pprType, pprParendType, pprTidiedType :: Type -> SDoc
83 pprType = pprPrecType topPrec
84 pprParendType = pprPrecType appPrec
85
86 -- already pre-tidied
87 pprTidiedType = pprIfaceType . toIfaceTypeX emptyVarSet
88
89 pprPrecType :: PprPrec -> Type -> SDoc
90 pprPrecType = pprPrecTypeX emptyTidyEnv
91
92 pprPrecTypeX :: TidyEnv -> PprPrec -> Type -> SDoc
93 pprPrecTypeX env prec ty
94 = getPprStyle $ \sty ->
95 getPprDebug $ \debug ->
96 if debug -- Use debugPprType when in
97 then debug_ppr_ty prec ty -- when in debug-style
98 else pprPrecIfaceType prec (tidyToIfaceTypeStyX env ty sty)
99 -- NB: debug-style is used for -dppr-debug
100 -- dump-style is used for -ddump-tc-trace etc
101
102 pprTyLit :: TyLit -> SDoc
103 pprTyLit = pprIfaceTyLit . toIfaceTyLit
104
105 pprKind, pprParendKind :: Kind -> SDoc
106 pprKind = pprType
107 pprParendKind = pprParendType
108
109 tidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType
110 tidyToIfaceTypeStyX env ty sty
111 | userStyle sty = tidyToIfaceTypeX env ty
112 | otherwise = toIfaceTypeX (tyCoVarsOfType ty) ty
113 -- in latter case, don't tidy, as we'll be printing uniques.
114
115 tidyToIfaceType :: Type -> IfaceType
116 tidyToIfaceType = tidyToIfaceTypeX emptyTidyEnv
117
118 tidyToIfaceTypeX :: TidyEnv -> Type -> IfaceType
119 -- It's vital to tidy before converting to an IfaceType
120 -- or nested binders will become indistinguishable!
121 --
122 -- Also for the free type variables, tell toIfaceTypeX to
123 -- leave them as IfaceFreeTyVar. This is super-important
124 -- for debug printing.
125 tidyToIfaceTypeX env ty = toIfaceTypeX (mkVarSet free_tcvs) (tidyType env' ty)
126 where
127 env' = tidyFreeTyCoVars env free_tcvs
128 free_tcvs = tyCoVarsOfTypeWellScoped ty
129
130 ------------
131 pprCo, pprParendCo :: Coercion -> SDoc
132 pprCo co = getPprStyle $ \ sty -> pprIfaceCoercion (tidyToIfaceCoSty co sty)
133 pprParendCo co = getPprStyle $ \ sty -> pprParendIfaceCoercion (tidyToIfaceCoSty co sty)
134
135 tidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion
136 tidyToIfaceCoSty co sty
137 | userStyle sty = tidyToIfaceCo co
138 | otherwise = toIfaceCoercionX (tyCoVarsOfCo co) co
139 -- in latter case, don't tidy, as we'll be printing uniques.
140
141 tidyToIfaceCo :: Coercion -> IfaceCoercion
142 -- It's vital to tidy before converting to an IfaceType
143 -- or nested binders will become indistinguishable!
144 --
145 -- Also for the free type variables, tell toIfaceCoercionX to
146 -- leave them as IfaceFreeCoVar. This is super-important
147 -- for debug printing.
148 tidyToIfaceCo co = toIfaceCoercionX (mkVarSet free_tcvs) (tidyCo env co)
149 where
150 env = tidyFreeTyCoVars emptyTidyEnv free_tcvs
151 free_tcvs = scopedSort $ tyCoVarsOfCoList co
152 ------------
153 pprClassPred :: Class -> [Type] -> SDoc
154 pprClassPred clas tys = pprTypeApp (classTyCon clas) tys
155
156 ------------
157 pprTheta :: ThetaType -> SDoc
158 pprTheta = pprIfaceContext topPrec . map tidyToIfaceType
159
160 pprParendTheta :: ThetaType -> SDoc
161 pprParendTheta = pprIfaceContext appPrec . map tidyToIfaceType
162
163 pprThetaArrowTy :: ThetaType -> SDoc
164 pprThetaArrowTy = pprIfaceContextArr . map tidyToIfaceType
165
166 ------------------
167 pprSigmaType :: Type -> SDoc
168 pprSigmaType = pprIfaceSigmaType ShowForAllWhen . tidyToIfaceType
169
170 pprForAll :: [TyCoVarBinder] -> SDoc
171 pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)
172
173 -- | Print a user-level forall; see @Note [When to print foralls]@ in
174 -- "GHC.Iface.Type".
175 pprUserForAll :: [TyCoVarBinder] -> SDoc
176 pprUserForAll = pprUserIfaceForAll . map toIfaceForAllBndr
177
178 pprTCvBndrs :: [TyCoVarBinder] -> SDoc
179 pprTCvBndrs tvs = sep (map pprTCvBndr tvs)
180
181 pprTCvBndr :: TyCoVarBinder -> SDoc
182 pprTCvBndr = pprTyVar . binderVar
183
184 pprTyVars :: [TyVar] -> SDoc
185 pprTyVars tvs = sep (map pprTyVar tvs)
186
187 pprTyVar :: TyVar -> SDoc
188 -- Print a type variable binder with its kind (but not if *)
189 -- Here we do not go via IfaceType, because the duplication with
190 -- pprIfaceTvBndr is minimal, and the loss of uniques etc in
191 -- debug printing is disastrous
192 pprTyVar tv
193 | pickyIsLiftedTypeKind kind = ppr tv -- See Note [Suppressing * kinds]
194 | otherwise = parens (ppr tv <+> dcolon <+> ppr kind)
195 where
196 kind = tyVarKind tv
197
198 {- Note [Suppressing * kinds]
199 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
200 Generally we want to print
201 forall a. a->a
202 not forall (a::*). a->a
203 or forall (a::Type). a->a
204 That is, for brevity we suppress a kind ascription of '*' (or Type).
205
206 But what if the kind is (Const Type x)?
207 type Const p q = p
208
209 Then (Const Type x) is just a long way of saying Type. But it may be
210 jolly confusing to suppress the 'x'. Suppose we have (polykinds/T18451a)
211 foo :: forall a b (c :: Const Type b). Proxy '[a, c]
212
213 Then this error message
214 • These kind and type variables: a b (c :: Const Type b)
215 are out of dependency order. Perhaps try this ordering:
216 (b :: k) (a :: Const (*) b) (c :: Const (*) b)
217 would be much less helpful if we suppressed the kind ascription on 'a'.
218
219 Hence the use of pickyIsLiftedTypeKind.
220 -}
221
222 -----------------
223 debugPprType :: Type -> SDoc
224 -- ^ debugPprType is a simple pretty printer that prints a type
225 -- without going through IfaceType. It does not format as prettily
226 -- as the normal route, but it's much more direct, and that can
227 -- be useful for debugging. E.g. with -dppr-debug it prints the
228 -- kind on type-variable /occurrences/ which the normal route
229 -- fundamentally cannot do.
230 debugPprType ty = debug_ppr_ty topPrec ty
231
232 debug_ppr_ty :: PprPrec -> Type -> SDoc
233 debug_ppr_ty _ (LitTy l)
234 = ppr l
235
236 debug_ppr_ty _ (TyVarTy tv)
237 = ppr tv -- With -dppr-debug we get (tv :: kind)
238
239 debug_ppr_ty prec ty@(FunTy { ft_af = af, ft_mult = mult, ft_arg = arg, ft_res = res })
240 = maybeParen prec funPrec $
241 sep [debug_ppr_ty funPrec arg, arr <+> debug_ppr_ty prec res]
242 where
243 arr = case af of
244 VisArg -> case mult of
245 One -> lollipop
246 Many -> arrow
247 w -> mulArrow (ppr w)
248 InvisArg -> case mult of
249 Many -> darrow
250 _ -> pprPanic "unexpected multiplicity" (ppr ty)
251
252 debug_ppr_ty prec (TyConApp tc tys)
253 | null tys = ppr tc
254 | otherwise = maybeParen prec appPrec $
255 hang (ppr tc) 2 (sep (map (debug_ppr_ty appPrec) tys))
256
257 debug_ppr_ty _ (AppTy t1 t2)
258 = hang (debug_ppr_ty appPrec t1) -- Print parens so we see ((a b) c)
259 2 (debug_ppr_ty appPrec t2) -- so that we can distinguish
260 -- TyConApp from AppTy
261
262 debug_ppr_ty prec (CastTy ty co)
263 = maybeParen prec topPrec $
264 hang (debug_ppr_ty topPrec ty)
265 2 (text "|>" <+> ppr co)
266
267 debug_ppr_ty _ (CoercionTy co)
268 = parens (text "CO" <+> ppr co)
269
270 -- Invisible forall: forall {k} (a :: k). t
271 debug_ppr_ty prec t
272 | (bndrs, body) <- splitForAllInvisTVBinders t
273 , not (null bndrs)
274 = maybeParen prec funPrec $
275 sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <> dot,
276 ppr body ]
277 where
278 -- (ppr tv) will print the binder kind-annotated
279 -- when in debug-style
280 ppr_bndr (Bndr tv InferredSpec) = braces (ppr tv)
281 ppr_bndr (Bndr tv SpecifiedSpec) = ppr tv
282
283 -- Visible forall: forall x y -> t
284 debug_ppr_ty prec t
285 | (bndrs, body) <- splitForAllReqTVBinders t
286 , not (null bndrs)
287 = maybeParen prec funPrec $
288 sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <+> arrow,
289 ppr body ]
290 where
291 -- (ppr tv) will print the binder kind-annotated
292 -- when in debug-style
293 ppr_bndr (Bndr tv ()) = ppr tv
294
295 -- Impossible case: neither visible nor invisible forall.
296 debug_ppr_ty _ ForAllTy{}
297 = panic "debug_ppr_ty: neither splitForAllInvisTVBinders nor splitForAllReqTVBinders returned any binders"
298
299 {-
300 Note [Infix type variables]
301 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
302 With TypeOperators you can say
303
304 f :: (a ~> b) -> b
305
306 and the (~>) is considered a type variable. However, the type
307 pretty-printer in this module will just see (a ~> b) as
308
309 App (App (TyVarTy "~>") (TyVarTy "a")) (TyVarTy "b")
310
311 So it'll print the type in prefix form. To avoid confusion we must
312 remember to parenthesise the operator, thus
313
314 (~>) a b -> b
315
316 See #2766.
317 -}
318
319 pprDataCons :: TyCon -> SDoc
320 pprDataCons = sepWithVBars . fmap pprDataConWithArgs . tyConDataCons
321 where
322 sepWithVBars [] = empty
323 sepWithVBars docs = sep (punctuate (space <> vbar) docs)
324
325 pprDataConWithArgs :: DataCon -> SDoc
326 pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc]
327 where
328 (_univ_tvs, _ex_tvs, _eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc
329 user_bndrs = tyVarSpecToBinders $ dataConUserTyVarBinders dc
330 forAllDoc = pprUserForAll user_bndrs
331 thetaDoc = pprThetaArrowTy theta
332 argsDoc = hsep (fmap pprParendType (map scaledThing arg_tys))
333
334
335 pprTypeApp :: TyCon -> [Type] -> SDoc
336 pprTypeApp tc tys
337 = pprIfaceTypeApp topPrec (toIfaceTyCon tc)
338 (toIfaceTcArgs tc tys)
339 -- TODO: toIfaceTcArgs seems rather wasteful here
340
341 ------------------
342 -- | Display all kind information (with @-fprint-explicit-kinds@) when the
343 -- provided 'Bool' argument is 'True'.
344 -- See @Note [Kind arguments in error messages]@ in "GHC.Tc.Errors".
345 pprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc
346 pprWithExplicitKindsWhen b
347 = updSDocContext $ \ctx ->
348 if b then ctx { sdocPrintExplicitKinds = True }
349 else ctx
350
351 -- | This variant preserves any use of TYPE in a type, effectively
352 -- locally setting -fprint-explicit-runtime-reps.
353 pprWithTYPE :: Type -> SDoc
354 pprWithTYPE ty = updSDocContext (\ctx -> ctx { sdocPrintExplicitRuntimeReps = True }) $
355 ppr ty
356
357 -- | Pretty prints a 'TyCon', using the family instance in case of a
358 -- representation tycon. For example:
359 --
360 -- > data T [a] = ...
361 --
362 -- In that case we want to print @T [a]@, where @T@ is the family 'TyCon'
363 pprSourceTyCon :: TyCon -> SDoc
364 pprSourceTyCon tycon
365 | Just (fam_tc, tys) <- tyConFamInst_maybe tycon
366 = ppr $ fam_tc `TyConApp` tys -- can't be FunTyCon
367 | otherwise
368 = ppr tycon