Fix #14875 by introducing PprPrec, and using it
[ghc.git] / compiler / iface / IfaceType.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4
5
6 This module defines interface types and binders
7 -}
8
9 {-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-}
10 {-# LANGUAGE MultiWayIf #-}
11 -- FlexibleInstances for Binary (DefMethSpec IfaceType)
12
13 module IfaceType (
14 IfExtName, IfLclName,
15
16 IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
17 IfaceUnivCoProv(..),
18 IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..), IsPromoted(..),
19 IfaceTyLit(..), IfaceTcArgs(..),
20 IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
21 IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
22 IfaceForAllBndr, ArgFlag(..), ShowForAllFlag(..),
23
24 ifForAllBndrTyVar, ifForAllBndrName,
25 ifTyConBinderTyVar, ifTyConBinderName,
26
27 -- Equality testing
28 isIfaceLiftedTypeKind,
29
30 -- Conversion from IfaceTcArgs -> [IfaceType]
31 tcArgsIfaceTypes,
32
33 -- Printing
34 pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
35 pprIfaceContext, pprIfaceContextArr,
36 pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
37 pprIfaceBndrs, pprIfaceTcArgs, pprParendIfaceTcArgs,
38 pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,
39 pprIfaceSigmaType, pprIfaceTyLit,
40 pprIfaceCoercion, pprParendIfaceCoercion,
41 splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
42 pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
43
44 suppressIfaceInvisibles,
45 stripIfaceInvisVars,
46 stripInvisArgs,
47
48 mkIfaceTySubst, substIfaceTyVar, substIfaceTcArgs, inDomIfaceTySubst
49 ) where
50
51 #include "HsVersions.h"
52
53 import GhcPrelude
54
55 import {-# SOURCE #-} TysWiredIn ( liftedRepDataConTyCon )
56 import {-# SOURCE #-} TyCoRep ( isRuntimeRepTy )
57
58 import DynFlags
59 import TyCon hiding ( pprPromotionQuote )
60 import CoAxiom
61 import Var
62 import PrelNames
63 import Name
64 import BasicTypes
65 import Binary
66 import Outputable
67 import FastString
68 import FastStringEnv
69 import Util
70
71 import Data.Maybe( isJust )
72 import Data.List (foldl')
73 import qualified Data.Semigroup as Semi
74
75 {-
76 ************************************************************************
77 * *
78 Local (nested) binders
79 * *
80 ************************************************************************
81 -}
82
83 type IfLclName = FastString -- A local name in iface syntax
84
85 type IfExtName = Name -- An External or WiredIn Name can appear in IfaceSyn
86 -- (However Internal or System Names never should)
87
88 data IfaceBndr -- Local (non-top-level) binders
89 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
90 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
91
92 type IfaceIdBndr = (IfLclName, IfaceType)
93 type IfaceTvBndr = (IfLclName, IfaceKind)
94
95 ifaceTvBndrName :: IfaceTvBndr -> IfLclName
96 ifaceTvBndrName (n,_) = n
97
98 type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
99
100 data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy
101 = IfaceNoOneShot -- and Note [The oneShot function] in MkId
102 | IfaceOneShot
103
104
105 {-
106 %************************************************************************
107 %* *
108 IfaceType
109 %* *
110 %************************************************************************
111 -}
112
113 -------------------------------
114 type IfaceKind = IfaceType
115
116 data IfaceType -- A kind of universal type, used for types and kinds
117 = IfaceFreeTyVar TyVar -- See Note [Free tyvars in IfaceType]
118 | IfaceTyVar IfLclName -- Type/coercion variable only, not tycon
119 | IfaceLitTy IfaceTyLit
120 | IfaceAppTy IfaceType IfaceType
121 | IfaceFunTy IfaceType IfaceType
122 | IfaceDFunTy IfaceType IfaceType
123 | IfaceForAllTy IfaceForAllBndr IfaceType
124 | IfaceTyConApp IfaceTyCon IfaceTcArgs -- Not necessarily saturated
125 -- Includes newtypes, synonyms, tuples
126 | IfaceCastTy IfaceType IfaceCoercion
127 | IfaceCoercionTy IfaceCoercion
128
129 | IfaceTupleTy -- Saturated tuples (unsaturated ones use IfaceTyConApp)
130 TupleSort -- What sort of tuple?
131 IsPromoted -- A bit like IfaceTyCon
132 IfaceTcArgs -- arity = length args
133 -- For promoted data cons, the kind args are omitted
134
135 type IfacePredType = IfaceType
136 type IfaceContext = [IfacePredType]
137
138 data IfaceTyLit
139 = IfaceNumTyLit Integer
140 | IfaceStrTyLit FastString
141 deriving (Eq)
142
143 type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
144 type IfaceForAllBndr = TyVarBndr IfaceTvBndr ArgFlag
145
146 -- See Note [Suppressing invisible arguments]
147 -- We use a new list type (rather than [(IfaceType,Bool)], because
148 -- it'll be more compact and faster to parse in interface
149 -- files. Rather than two bytes and two decisions (nil/cons, and
150 -- type/kind) there'll just be one.
151 data IfaceTcArgs
152 = ITC_Nil
153 | ITC_Vis IfaceType IfaceTcArgs -- "Vis" means show when pretty-printing
154 | ITC_Invis IfaceKind IfaceTcArgs -- "Invis" means don't show when pretty-printing
155 -- except with -fprint-explicit-kinds
156
157 instance Semi.Semigroup IfaceTcArgs where
158 ITC_Nil <> xs = xs
159 ITC_Vis ty rest <> xs = ITC_Vis ty (rest Semi.<> xs)
160 ITC_Invis ki rest <> xs = ITC_Invis ki (rest Semi.<> xs)
161
162 instance Monoid IfaceTcArgs where
163 mempty = ITC_Nil
164 mappend = (Semi.<>)
165
166 -- Encodes type constructors, kind constructors,
167 -- coercion constructors, the lot.
168 -- We have to tag them in order to pretty print them
169 -- properly.
170 data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName
171 , ifaceTyConInfo :: IfaceTyConInfo }
172 deriving (Eq)
173
174 -- | Is a TyCon a promoted data constructor or just a normal type constructor?
175 data IsPromoted = IsNotPromoted | IsPromoted
176 deriving (Eq)
177
178 -- | The various types of TyCons which have special, built-in syntax.
179 data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon
180
181 | IfaceTupleTyCon !Arity !TupleSort
182 -- ^ e.g. @(a, b, c)@ or @(#a, b, c#)@.
183 -- The arity is the tuple width, not the tycon arity
184 -- (which is twice the width in the case of unboxed
185 -- tuples).
186
187 | IfaceSumTyCon !Arity
188 -- ^ e.g. @(a | b | c)@
189
190 | IfaceEqualityTyCon
191 -- ^ A heterogeneous equality TyCon
192 -- (i.e. eqPrimTyCon, eqReprPrimTyCon, heqTyCon)
193 -- that is actually being applied to two types
194 -- of the same kind. This affects pretty-printing
195 -- only: see Note [Equality predicates in IfaceType]
196 deriving (Eq)
197
198 {- Note [Free tyvars in IfaceType]
199 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
200 Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to
201 an IfaceType and pretty printing that. This eliminates a lot of
202 pretty-print duplication, and it matches what we do with
203 pretty-printing TyThings.
204
205 It works fine for closed types, but when printing debug traces (e.g.
206 when using -ddump-tc-trace) we print a lot of /open/ types. These
207 types are full of TcTyVars, and it's absolutely crucial to print them
208 in their full glory, with their unique, TcTyVarDetails etc.
209
210 So we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor.
211 Note that:
212
213 * We never expect to serialise an IfaceFreeTyVar into an interface file, nor
214 to deserialise one. IfaceFreeTyVar is used only in the "convert to IfaceType
215 and then pretty-print" pipeline.
216
217 We do the same for covars, naturally.
218
219 Note [Equality predicates in IfaceType]
220 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
221 GHC has several varieties of type equality (see Note [The equality types story]
222 in TysPrim for details). In an effort to avoid confusing users, we suppress
223 the differences during "normal" pretty printing. Specifically we display them
224 like this:
225
226 Predicate Pretty-printed as
227 Homogeneous case Heterogeneous case
228 ---------------- ----------------- -------------------
229 (~) eqTyCon ~ N/A
230 (~~) heqTyCon ~ ~~
231 (~#) eqPrimTyCon ~# ~~
232 (~R#) eqReprPrimTyCon Coercible Coercible
233
234 By "homogeneeous case" we mean cases where a hetero-kinded equality
235 (all but the first above) is actually applied to two identical kinds.
236 Unfortunately, determining this from an IfaceType isn't possible since
237 we can't see through type synonyms. Consequently, we need to record
238 whether this particular application is homogeneous in IfaceTyConSort
239 for the purposes of pretty-printing.
240
241 All this suppresses information. To get the ground truth, use -dppr-debug
242 (see 'print_eqs' in 'ppr_equality').
243
244 See Note [The equality types story] in TysPrim.
245 -}
246
247 data IfaceTyConInfo -- Used to guide pretty-printing
248 -- and to disambiguate D from 'D (they share a name)
249 = IfaceTyConInfo { ifaceTyConIsPromoted :: IsPromoted
250 , ifaceTyConSort :: IfaceTyConSort }
251 deriving (Eq)
252
253 data IfaceCoercion
254 = IfaceReflCo Role IfaceType
255 | IfaceFunCo Role IfaceCoercion IfaceCoercion
256 | IfaceTyConAppCo Role IfaceTyCon [IfaceCoercion]
257 | IfaceAppCo IfaceCoercion IfaceCoercion
258 | IfaceForAllCo IfaceTvBndr IfaceCoercion IfaceCoercion
259 | IfaceCoVarCo IfLclName
260 | IfaceAxiomInstCo IfExtName BranchIndex [IfaceCoercion]
261 | IfaceAxiomRuleCo IfLclName [IfaceCoercion]
262 -- There are only a fixed number of CoAxiomRules, so it suffices
263 -- to use an IfaceLclName to distinguish them.
264 -- See Note [Adding built-in type families] in TcTypeNats
265 | IfaceUnivCo IfaceUnivCoProv Role IfaceType IfaceType
266 | IfaceSymCo IfaceCoercion
267 | IfaceTransCo IfaceCoercion IfaceCoercion
268 | IfaceNthCo Int IfaceCoercion
269 | IfaceLRCo LeftOrRight IfaceCoercion
270 | IfaceInstCo IfaceCoercion IfaceCoercion
271 | IfaceCoherenceCo IfaceCoercion IfaceCoercion
272 | IfaceKindCo IfaceCoercion
273 | IfaceSubCo IfaceCoercion
274 | IfaceFreeCoVar CoVar -- See Note [Free tyvars in IfaceType]
275 | IfaceHoleCo CoVar -- ^ See Note [Holes in IfaceCoercion]
276
277 data IfaceUnivCoProv
278 = IfaceUnsafeCoerceProv
279 | IfacePhantomProv IfaceCoercion
280 | IfaceProofIrrelProv IfaceCoercion
281 | IfacePluginProv String
282
283 {- Note [Holes in IfaceCoercion]
284 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
285 When typechecking fails the typechecker will produce a HoleCo to stand
286 in place of the unproven assertion. While we generally don't want to
287 let these unproven assertions leak into interface files, we still need
288 to be able to pretty-print them as we use IfaceType's pretty-printer
289 to render Types. For this reason IfaceCoercion has a IfaceHoleCo
290 constructor; however, we fails when asked to serialize to a
291 IfaceHoleCo to ensure that they don't end up in an interface file.
292
293
294 %************************************************************************
295 %* *
296 Functions over IFaceTypes
297 * *
298 ************************************************************************
299 -}
300
301 ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
302 ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key
303
304 isIfaceLiftedTypeKind :: IfaceKind -> Bool
305 isIfaceLiftedTypeKind (IfaceTyConApp tc ITC_Nil)
306 = isLiftedTypeKindTyConName (ifaceTyConName tc)
307 isIfaceLiftedTypeKind (IfaceTyConApp tc
308 (ITC_Vis (IfaceTyConApp ptr_rep_lifted ITC_Nil) ITC_Nil))
309 = tc `ifaceTyConHasKey` tYPETyConKey
310 && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey
311 isIfaceLiftedTypeKind _ = False
312
313 splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
314 -- Mainly for printing purposes
315 splitIfaceSigmaTy ty
316 = (bndrs, theta, tau)
317 where
318 (bndrs, rho) = split_foralls ty
319 (theta, tau) = split_rho rho
320
321 split_foralls (IfaceForAllTy bndr ty)
322 = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
323 split_foralls rho = ([], rho)
324
325 split_rho (IfaceDFunTy ty1 ty2)
326 = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
327 split_rho tau = ([], tau)
328
329 suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
330 suppressIfaceInvisibles dflags tys xs
331 | gopt Opt_PrintExplicitKinds dflags = xs
332 | otherwise = suppress tys xs
333 where
334 suppress _ [] = []
335 suppress [] a = a
336 suppress (k:ks) (x:xs)
337 | isInvisibleTyConBinder k = suppress ks xs
338 | otherwise = x : suppress ks xs
339
340 stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
341 stripIfaceInvisVars dflags tyvars
342 | gopt Opt_PrintExplicitKinds dflags = tyvars
343 | otherwise = filterOut isInvisibleTyConBinder tyvars
344
345 -- | Extract an 'IfaceTvBndr' from an 'IfaceForAllBndr'.
346 ifForAllBndrTyVar :: IfaceForAllBndr -> IfaceTvBndr
347 ifForAllBndrTyVar = binderVar
348
349 -- | Extract the variable name from an 'IfaceForAllBndr'.
350 ifForAllBndrName :: IfaceForAllBndr -> IfLclName
351 ifForAllBndrName fab = ifaceTvBndrName (ifForAllBndrTyVar fab)
352
353 -- | Extract an 'IfaceTvBndr' from an 'IfaceTyConBinder'.
354 ifTyConBinderTyVar :: IfaceTyConBinder -> IfaceTvBndr
355 ifTyConBinderTyVar = binderVar
356
357 -- | Extract the variable name from an 'IfaceTyConBinder'.
358 ifTyConBinderName :: IfaceTyConBinder -> IfLclName
359 ifTyConBinderName tcb = ifaceTvBndrName (ifTyConBinderTyVar tcb)
360
361 ifTypeIsVarFree :: IfaceType -> Bool
362 -- Returns True if the type definitely has no variables at all
363 -- Just used to control pretty printing
364 ifTypeIsVarFree ty = go ty
365 where
366 go (IfaceTyVar {}) = False
367 go (IfaceFreeTyVar {}) = False
368 go (IfaceAppTy fun arg) = go fun && go arg
369 go (IfaceFunTy arg res) = go arg && go res
370 go (IfaceDFunTy arg res) = go arg && go res
371 go (IfaceForAllTy {}) = False
372 go (IfaceTyConApp _ args) = go_args args
373 go (IfaceTupleTy _ _ args) = go_args args
374 go (IfaceLitTy _) = True
375 go (IfaceCastTy {}) = False -- Safe
376 go (IfaceCoercionTy {}) = False -- Safe
377
378 go_args ITC_Nil = True
379 go_args (ITC_Vis arg args) = go arg && go_args args
380 go_args (ITC_Invis arg args) = go arg && go_args args
381
382 {- Note [Substitution on IfaceType]
383 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
384 Substitutions on IfaceType are done only during pretty-printing to
385 construct the result type of a GADT, and does not deal with binders
386 (eg IfaceForAll), so it doesn't need fancy capture stuff. -}
387
388 type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType]
389
390 mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst
391 -- See Note [Substitution on IfaceType]
392 mkIfaceTySubst eq_spec = mkFsEnv eq_spec
393
394 inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
395 -- See Note [Substitution on IfaceType]
396 inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst fs)
397
398 substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
399 -- See Note [Substitution on IfaceType]
400 substIfaceType env ty
401 = go ty
402 where
403 go (IfaceFreeTyVar tv) = IfaceFreeTyVar tv
404 go (IfaceTyVar tv) = substIfaceTyVar env tv
405 go (IfaceAppTy t1 t2) = IfaceAppTy (go t1) (go t2)
406 go (IfaceFunTy t1 t2) = IfaceFunTy (go t1) (go t2)
407 go (IfaceDFunTy t1 t2) = IfaceDFunTy (go t1) (go t2)
408 go ty@(IfaceLitTy {}) = ty
409 go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceTcArgs env tys)
410 go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceTcArgs env tys)
411 go (IfaceForAllTy {}) = pprPanic "substIfaceType" (ppr ty)
412 go (IfaceCastTy ty co) = IfaceCastTy (go ty) (go_co co)
413 go (IfaceCoercionTy co) = IfaceCoercionTy (go_co co)
414
415 go_co (IfaceReflCo r ty) = IfaceReflCo r (go ty)
416 go_co (IfaceFunCo r c1 c2) = IfaceFunCo r (go_co c1) (go_co c2)
417 go_co (IfaceTyConAppCo r tc cos) = IfaceTyConAppCo r tc (go_cos cos)
418 go_co (IfaceAppCo c1 c2) = IfaceAppCo (go_co c1) (go_co c2)
419 go_co (IfaceForAllCo {}) = pprPanic "substIfaceCoercion" (ppr ty)
420 go_co (IfaceFreeCoVar cv) = IfaceFreeCoVar cv
421 go_co (IfaceCoVarCo cv) = IfaceCoVarCo cv
422 go_co (IfaceHoleCo cv) = IfaceHoleCo cv
423 go_co (IfaceAxiomInstCo a i cos) = IfaceAxiomInstCo a i (go_cos cos)
424 go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2)
425 go_co (IfaceSymCo co) = IfaceSymCo (go_co co)
426 go_co (IfaceTransCo co1 co2) = IfaceTransCo (go_co co1) (go_co co2)
427 go_co (IfaceNthCo n co) = IfaceNthCo n (go_co co)
428 go_co (IfaceLRCo lr co) = IfaceLRCo lr (go_co co)
429 go_co (IfaceInstCo c1 c2) = IfaceInstCo (go_co c1) (go_co c2)
430 go_co (IfaceCoherenceCo c1 c2) = IfaceCoherenceCo (go_co c1) (go_co c2)
431 go_co (IfaceKindCo co) = IfaceKindCo (go_co co)
432 go_co (IfaceSubCo co) = IfaceSubCo (go_co co)
433 go_co (IfaceAxiomRuleCo n cos) = IfaceAxiomRuleCo n (go_cos cos)
434
435 go_cos = map go_co
436
437 go_prov IfaceUnsafeCoerceProv = IfaceUnsafeCoerceProv
438 go_prov (IfacePhantomProv co) = IfacePhantomProv (go_co co)
439 go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co)
440 go_prov (IfacePluginProv str) = IfacePluginProv str
441
442 substIfaceTcArgs :: IfaceTySubst -> IfaceTcArgs -> IfaceTcArgs
443 substIfaceTcArgs env args
444 = go args
445 where
446 go ITC_Nil = ITC_Nil
447 go (ITC_Vis ty tys) = ITC_Vis (substIfaceType env ty) (go tys)
448 go (ITC_Invis ty tys) = ITC_Invis (substIfaceType env ty) (go tys)
449
450 substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
451 substIfaceTyVar env tv
452 | Just ty <- lookupFsEnv env tv = ty
453 | otherwise = IfaceTyVar tv
454
455
456 {-
457 ************************************************************************
458 * *
459 Functions over IFaceTcArgs
460 * *
461 ************************************************************************
462 -}
463
464 stripInvisArgs :: DynFlags -> IfaceTcArgs -> IfaceTcArgs
465 stripInvisArgs dflags tys
466 | gopt Opt_PrintExplicitKinds dflags = tys
467 | otherwise = suppress_invis tys
468 where
469 suppress_invis c
470 = case c of
471 ITC_Invis _ ts -> suppress_invis ts
472 _ -> c
473
474 tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
475 tcArgsIfaceTypes ITC_Nil = []
476 tcArgsIfaceTypes (ITC_Invis t ts) = t : tcArgsIfaceTypes ts
477 tcArgsIfaceTypes (ITC_Vis t ts) = t : tcArgsIfaceTypes ts
478
479 ifaceVisTcArgsLength :: IfaceTcArgs -> Int
480 ifaceVisTcArgsLength = go 0
481 where
482 go !n ITC_Nil = n
483 go n (ITC_Vis _ rest) = go (n+1) rest
484 go n (ITC_Invis _ rest) = go n rest
485
486 {-
487 Note [Suppressing invisible arguments]
488 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
489 We use the IfaceTcArgs to specify which of the arguments to a type
490 constructor should be displayed when pretty-printing, under
491 the control of -fprint-explicit-kinds.
492 See also Type.filterOutInvisibleTypes.
493 For example, given
494 T :: forall k. (k->*) -> k -> * -- Ordinary kind polymorphism
495 'Just :: forall k. k -> 'Maybe k -- Promoted
496 we want
497 T * Tree Int prints as T Tree Int
498 'Just * prints as Just *
499
500
501 ************************************************************************
502 * *
503 Pretty-printing
504 * *
505 ************************************************************************
506 -}
507
508 if_print_coercions :: SDoc -- ^ if printing coercions
509 -> SDoc -- ^ otherwise
510 -> SDoc
511 if_print_coercions yes no
512 = sdocWithDynFlags $ \dflags ->
513 getPprStyle $ \style ->
514 if gopt Opt_PrintExplicitCoercions dflags
515 || dumpStyle style || debugStyle style
516 then yes
517 else no
518
519 pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
520 pprIfaceInfixApp ctxt_prec pp_tc pp_ty1 pp_ty2
521 = maybeParen ctxt_prec opPrec $
522 sep [pp_ty1, pp_tc <+> pp_ty2]
523
524 pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
525 pprIfacePrefixApp ctxt_prec pp_fun pp_tys
526 | null pp_tys = pp_fun
527 | otherwise = maybeParen ctxt_prec appPrec $
528 hang pp_fun 2 (sep pp_tys)
529
530 -- ----------------------------- Printing binders ------------------------------------
531
532 instance Outputable IfaceBndr where
533 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
534 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr False bndr
535
536 pprIfaceBndrs :: [IfaceBndr] -> SDoc
537 pprIfaceBndrs bs = sep (map ppr bs)
538
539 pprIfaceLamBndr :: IfaceLamBndr -> SDoc
540 pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b
541 pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]"
542
543 pprIfaceIdBndr :: IfaceIdBndr -> SDoc
544 pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)
545
546 pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
547 pprIfaceTvBndr use_parens (tv, ki)
548 | isIfaceLiftedTypeKind ki = ppr tv
549 | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki)
550 where
551 maybe_parens | use_parens = parens
552 | otherwise = id
553
554 pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
555 pprIfaceTyConBinders = sep . map go
556 where
557 go tcb = pprIfaceTvBndr True (ifTyConBinderTyVar tcb)
558
559 instance Binary IfaceBndr where
560 put_ bh (IfaceIdBndr aa) = do
561 putByte bh 0
562 put_ bh aa
563 put_ bh (IfaceTvBndr ab) = do
564 putByte bh 1
565 put_ bh ab
566 get bh = do
567 h <- getByte bh
568 case h of
569 0 -> do aa <- get bh
570 return (IfaceIdBndr aa)
571 _ -> do ab <- get bh
572 return (IfaceTvBndr ab)
573
574 instance Binary IfaceOneShot where
575 put_ bh IfaceNoOneShot = do
576 putByte bh 0
577 put_ bh IfaceOneShot = do
578 putByte bh 1
579 get bh = do
580 h <- getByte bh
581 case h of
582 0 -> do return IfaceNoOneShot
583 _ -> do return IfaceOneShot
584
585 -- ----------------------------- Printing IfaceType ------------------------------------
586
587 ---------------------------------
588 instance Outputable IfaceType where
589 ppr ty = pprIfaceType ty
590
591 pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
592 pprIfaceType = pprPrecIfaceType topPrec
593 pprParendIfaceType = pprPrecIfaceType appPrec
594
595 pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
596 pprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty
597
598 ppr_ty :: PprPrec -> IfaceType -> SDoc
599 ppr_ty _ (IfaceFreeTyVar tyvar) = ppr tyvar -- This is the main reson for IfaceFreeTyVar!
600 ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [TcTyVars in IfaceType]
601 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
602 ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys
603 ppr_ty _ (IfaceLitTy n) = pprIfaceTyLit n
604 -- Function types
605 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
606 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
607 maybeParen ctxt_prec funPrec $
608 sep [ppr_ty funPrec ty1, sep (ppr_fun_tail ty2)]
609 where
610 ppr_fun_tail (IfaceFunTy ty1 ty2)
611 = (arrow <+> ppr_ty funPrec ty1) : ppr_fun_tail ty2
612 ppr_fun_tail other_ty
613 = [arrow <+> pprIfaceType other_ty]
614
615 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
616 = if_print_coercions
617 ppr_app_ty
618 ppr_app_ty_no_casts
619 where
620 ppr_app_ty =
621 maybeParen ctxt_prec appPrec
622 $ ppr_ty funPrec ty1 <+> ppr_ty appPrec ty2
623
624 -- Strip any casts from the head of the application
625 ppr_app_ty_no_casts =
626 case split_app_tys ty1 (ITC_Vis ty2 ITC_Nil) of
627 (IfaceCastTy head _, args) -> ppr_ty ctxt_prec (mk_app_tys head args)
628 _ -> ppr_app_ty
629
630 split_app_tys :: IfaceType -> IfaceTcArgs -> (IfaceType, IfaceTcArgs)
631 split_app_tys (IfaceAppTy t1 t2) args = split_app_tys t1 (t2 `ITC_Vis` args)
632 split_app_tys head args = (head, args)
633
634 mk_app_tys :: IfaceType -> IfaceTcArgs -> IfaceType
635 mk_app_tys (IfaceTyConApp tc tys1) tys2 =
636 IfaceTyConApp tc (tys1 `mappend` tys2)
637 mk_app_tys t1 tys2 =
638 foldl' IfaceAppTy t1 (tcArgsIfaceTypes tys2)
639
640 ppr_ty ctxt_prec (IfaceCastTy ty co)
641 = if_print_coercions
642 (parens (ppr_ty topPrec ty <+> text "|>" <+> ppr co))
643 (ppr_ty ctxt_prec ty)
644
645 ppr_ty ctxt_prec (IfaceCoercionTy co)
646 = if_print_coercions
647 (ppr_co ctxt_prec co)
648 (text "<>")
649
650 ppr_ty ctxt_prec ty
651 = maybeParen ctxt_prec funPrec (pprIfaceSigmaType ShowForAllMust ty)
652
653 {-
654 Note [Defaulting RuntimeRep variables]
655 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
656
657 RuntimeRep variables are considered by many (most?) users to be little more than
658 syntactic noise. When the notion was introduced there was a signficant and
659 understandable push-back from those with pedagogy in mind, which argued that
660 RuntimeRep variables would throw a wrench into nearly any teach approach since
661 they appear in even the lowly ($) function's type,
662
663 ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b
664
665 which is significantly less readable than its non RuntimeRep-polymorphic type of
666
667 ($) :: (a -> b) -> a -> b
668
669 Moreover, unboxed types don't appear all that often in run-of-the-mill Haskell
670 programs, so it makes little sense to make all users pay this syntactic
671 overhead.
672
673 For this reason it was decided that we would hide RuntimeRep variables for now
674 (see #11549). We do this by defaulting all type variables of kind RuntimeRep to
675 LiftedRep. This is done in a pass right before pretty-printing
676 (defaultRuntimeRepVars, controlled by -fprint-explicit-runtime-reps)
677 -}
678
679 -- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g.
680 --
681 -- @
682 -- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
683 -- (a -> b) -> a -> b
684 -- @
685 --
686 -- turns in to,
687 --
688 -- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @
689 --
690 -- We do this to prevent RuntimeRep variables from incurring a significant
691 -- syntactic overhead in otherwise simple type signatures (e.g. ($)). See
692 -- Note [Defaulting RuntimeRep variables] and #11549 for further discussion.
693 --
694 defaultRuntimeRepVars :: PprStyle -> IfaceType -> IfaceType
695 defaultRuntimeRepVars sty = go emptyFsEnv
696 where
697 go :: FastStringEnv () -> IfaceType -> IfaceType
698 go subs (IfaceForAllTy bndr ty)
699 | isRuntimeRep var_kind
700 , isInvisibleArgFlag (binderArgFlag bndr) -- don't default *visible* quantification
701 -- or we get the mess in #13963
702 = let subs' = extendFsEnv subs var ()
703 in go subs' ty
704 | otherwise
705 = IfaceForAllTy (TvBndr (var, go subs var_kind) (binderArgFlag bndr))
706 (go subs ty)
707 where
708 var :: IfLclName
709 (var, var_kind) = binderVar bndr
710
711 go subs ty@(IfaceTyVar tv)
712 | tv `elemFsEnv` subs
713 = IfaceTyConApp liftedRep ITC_Nil
714 | otherwise
715 = ty
716
717 go _ ty@(IfaceFreeTyVar tv)
718 | userStyle sty && TyCoRep.isRuntimeRepTy (tyVarKind tv)
719 -- don't require -fprint-explicit-runtime-reps for good debugging output
720 = IfaceTyConApp liftedRep ITC_Nil
721 | otherwise
722 = ty
723
724 go subs (IfaceTyConApp tc tc_args)
725 = IfaceTyConApp tc (go_args subs tc_args)
726
727 go subs (IfaceTupleTy sort is_prom tc_args)
728 = IfaceTupleTy sort is_prom (go_args subs tc_args)
729
730 go subs (IfaceFunTy arg res)
731 = IfaceFunTy (go subs arg) (go subs res)
732
733 go subs (IfaceAppTy x y)
734 = IfaceAppTy (go subs x) (go subs y)
735
736 go subs (IfaceDFunTy x y)
737 = IfaceDFunTy (go subs x) (go subs y)
738
739 go subs (IfaceCastTy x co)
740 = IfaceCastTy (go subs x) co
741
742 go _ ty@(IfaceLitTy {}) = ty
743 go _ ty@(IfaceCoercionTy {}) = ty
744
745 go_args :: FastStringEnv () -> IfaceTcArgs -> IfaceTcArgs
746 go_args _ ITC_Nil = ITC_Nil
747 go_args subs (ITC_Vis ty args) = ITC_Vis (go subs ty) (go_args subs args)
748 go_args subs (ITC_Invis ty args) = ITC_Invis (go subs ty) (go_args subs args)
749
750 liftedRep :: IfaceTyCon
751 liftedRep =
752 IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
753 where dc_name = getName liftedRepDataConTyCon
754
755 isRuntimeRep :: IfaceType -> Bool
756 isRuntimeRep (IfaceTyConApp tc _) =
757 tc `ifaceTyConHasKey` runtimeRepTyConKey
758 isRuntimeRep _ = False
759
760 eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
761 eliminateRuntimeRep f ty = sdocWithDynFlags $ \dflags ->
762 if gopt Opt_PrintExplicitRuntimeReps dflags
763 then f ty
764 else getPprStyle $ \sty -> f (defaultRuntimeRepVars sty ty)
765
766 instance Outputable IfaceTcArgs where
767 ppr tca = pprIfaceTcArgs tca
768
769 pprIfaceTcArgs, pprParendIfaceTcArgs :: IfaceTcArgs -> SDoc
770 pprIfaceTcArgs = ppr_tc_args topPrec
771 pprParendIfaceTcArgs = ppr_tc_args appPrec
772
773 ppr_tc_args :: PprPrec -> IfaceTcArgs -> SDoc
774 ppr_tc_args ctx_prec args
775 = let pprTys t ts = ppr_ty ctx_prec t <+> ppr_tc_args ctx_prec ts
776 in case args of
777 ITC_Nil -> empty
778 ITC_Vis t ts -> pprTys t ts
779 ITC_Invis t ts -> pprTys t ts
780
781 -------------------
782 pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
783 pprIfaceForAllPart tvs ctxt sdoc
784 = ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc
785
786 -- | Like 'pprIfaceForAllPart', but always uses an explicit @forall@.
787 pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
788 pprIfaceForAllPartMust tvs ctxt sdoc
789 = ppr_iface_forall_part ShowForAllMust tvs ctxt sdoc
790
791 pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
792 pprIfaceForAllCoPart tvs sdoc
793 = sep [ pprIfaceForAllCo tvs, sdoc ]
794
795 ppr_iface_forall_part :: ShowForAllFlag
796 -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
797 ppr_iface_forall_part show_forall tvs ctxt sdoc
798 = sep [ case show_forall of
799 ShowForAllMust -> pprIfaceForAll tvs
800 ShowForAllWhen -> pprUserIfaceForAll tvs
801 , pprIfaceContextArr ctxt
802 , sdoc]
803
804 -- | Render the "forall ... ." or "forall ... ->" bit of a type.
805 pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
806 pprIfaceForAll [] = empty
807 pprIfaceForAll bndrs@(TvBndr _ vis : _)
808 = add_separator (forAllLit <+> doc) <+> pprIfaceForAll bndrs'
809 where
810 (bndrs', doc) = ppr_itv_bndrs bndrs vis
811
812 add_separator stuff = case vis of
813 Required -> stuff <+> arrow
814 _inv -> stuff <> dot
815
816
817 -- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
818 -- Returns both the list of not-yet-rendered binders and the doc.
819 -- No anonymous binders here!
820 ppr_itv_bndrs :: [IfaceForAllBndr]
821 -> ArgFlag -- ^ visibility of the first binder in the list
822 -> ([IfaceForAllBndr], SDoc)
823 ppr_itv_bndrs all_bndrs@(bndr@(TvBndr _ vis) : bndrs) vis1
824 | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
825 (bndrs', pprIfaceForAllBndr bndr <+> doc)
826 | otherwise = (all_bndrs, empty)
827 ppr_itv_bndrs [] _ = ([], empty)
828
829 pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
830 pprIfaceForAllCo [] = empty
831 pprIfaceForAllCo tvs = text "forall" <+> pprIfaceForAllCoBndrs tvs <> dot
832
833 pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
834 pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
835
836 pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
837 pprIfaceForAllBndr (TvBndr tv Inferred) = sdocWithDynFlags $ \dflags ->
838 if gopt Opt_PrintExplicitForalls dflags
839 then braces $ pprIfaceTvBndr False tv
840 else pprIfaceTvBndr True tv
841 pprIfaceForAllBndr (TvBndr tv _) = pprIfaceTvBndr True tv
842
843 pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
844 pprIfaceForAllCoBndr (tv, kind_co)
845 = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)
846
847 -- | Show forall flag
848 --
849 -- Unconditionally show the forall quantifier with ('ShowForAllMust')
850 -- or when ('ShowForAllWhen') the names used are free in the binder
851 -- or when compiling with -fprint-explicit-foralls.
852 data ShowForAllFlag = ShowForAllMust | ShowForAllWhen
853
854 pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
855 pprIfaceSigmaType show_forall ty
856 = ppr_iface_forall_part show_forall tvs theta (ppr tau)
857 where
858 (tvs, theta, tau) = splitIfaceSigmaTy ty
859
860 pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
861 pprUserIfaceForAll tvs
862 = sdocWithDynFlags $ \dflags ->
863 -- See Note [When to print foralls]
864 ppWhen (any tv_has_kind_var tvs
865 || any tv_is_required tvs
866 || gopt Opt_PrintExplicitForalls dflags) $
867 pprIfaceForAll tvs
868 where
869 tv_has_kind_var (TvBndr (_,kind) _) = not (ifTypeIsVarFree kind)
870 tv_is_required = isVisibleArgFlag . binderArgFlag
871
872 {-
873 Note [When to print foralls]
874 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
875 We opt to explicitly pretty-print `forall`s if any of the following
876 criteria are met:
877
878 1. -fprint-explicit-foralls is on.
879
880 2. A bound type variable has a polymorphic kind. E.g.,
881
882 forall k (a::k). Proxy a -> Proxy a
883
884 Since a's kind mentions a variable k, we print the foralls.
885
886 3. A bound type variable is a visible argument (#14238).
887 Suppose we are printing the kind of:
888
889 T :: forall k -> k -> Type
890
891 The "forall k ->" notation means that this kind argument is required.
892 That is, it must be supplied at uses of T. E.g.,
893
894 f :: T (Type->Type) Monad -> Int
895
896 So we print an explicit "T :: forall k -> k -> Type",
897 because omitting it and printing "T :: k -> Type" would be
898 utterly misleading.
899
900 See Note [TyVarBndrs, TyVarBinders, TyConBinders, and visibility]
901 in TyCoRep.
902 -}
903
904 -------------------
905
906 -- See equivalent function in TyCoRep.hs
907 pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
908 -- Given a type-level list (t1 ': t2), see if we can print
909 -- it in list notation [t1, ...].
910 -- Precondition: Opt_PrintExplicitKinds is off
911 pprIfaceTyList ctxt_prec ty1 ty2
912 = case gather ty2 of
913 (arg_tys, Nothing)
914 -> char '\'' <> brackets (fsep (punctuate comma
915 (map (ppr_ty topPrec) (ty1:arg_tys))))
916 (arg_tys, Just tl)
917 -> maybeParen ctxt_prec funPrec $ hang (ppr_ty funPrec ty1)
918 2 (fsep [ colon <+> ppr_ty funPrec ty | ty <- arg_tys ++ [tl]])
919 where
920 gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
921 -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
922 -- = (tys, Just tl) means ty is of form t1:t2:...tn:tl
923 gather (IfaceTyConApp tc tys)
924 | tc `ifaceTyConHasKey` consDataConKey
925 , (ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil))) <- tys
926 , (args, tl) <- gather ty2
927 = (ty1:args, tl)
928 | tc `ifaceTyConHasKey` nilDataConKey
929 = ([], Nothing)
930 gather ty = ([], Just ty)
931
932 pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
933 pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args
934
935 pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
936 pprTyTcApp ctxt_prec tc tys =
937 sdocWithDynFlags $ \dflags ->
938 getPprStyle $ \style ->
939 pprTyTcApp' ctxt_prec tc tys dflags style
940
941 pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceTcArgs
942 -> DynFlags -> PprStyle -> SDoc
943 pprTyTcApp' ctxt_prec tc tys dflags style
944 | ifaceTyConName tc `hasKey` ipClassKey
945 , ITC_Vis (IfaceLitTy (IfaceStrTyLit n)) (ITC_Vis ty ITC_Nil) <- tys
946 = maybeParen ctxt_prec funPrec
947 $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty
948
949 | IfaceTupleTyCon arity sort <- ifaceTyConSort info
950 , not (debugStyle style)
951 , arity == ifaceVisTcArgsLength tys
952 = pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys
953
954 | IfaceSumTyCon arity <- ifaceTyConSort info
955 = pprSum arity (ifaceTyConIsPromoted info) tys
956
957 | tc `ifaceTyConHasKey` consDataConKey
958 , not (gopt Opt_PrintExplicitKinds dflags)
959 , ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil)) <- tys
960 = pprIfaceTyList ctxt_prec ty1 ty2
961
962 | tc `ifaceTyConHasKey` tYPETyConKey
963 , ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
964 , rep `ifaceTyConHasKey` liftedRepDataConKey
965 = kindStar
966
967 | otherwise
968 = getPprDebug $ \dbg ->
969 if | not dbg && tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey
970 -- Suppress detail unles you _really_ want to see
971 -> text "(TypeError ...)"
972
973 | Just doc <- ppr_equality ctxt_prec tc (tcArgsIfaceTypes tys)
974 -> doc
975
976 | otherwise
977 -> ppr_iface_tc_app ppr_ty ctxt_prec tc tys_wo_kinds
978 where
979 info = ifaceTyConInfo tc
980 tys_wo_kinds = tcArgsIfaceTypes $ stripInvisArgs dflags tys
981
982 -- | Pretty-print a type-level equality.
983 -- Returns (Just doc) if the argument is a /saturated/ application
984 -- of eqTyCon (~)
985 -- eqPrimTyCon (~#)
986 -- eqReprPrimTyCon (~R#)
987 -- hEqTyCon (~~)
988 --
989 -- See Note [Equality predicates in IfaceType]
990 -- and Note [The equality types story] in TysPrim
991 ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
992 ppr_equality ctxt_prec tc args
993 | hetero_eq_tc
994 , [k1, k2, t1, t2] <- args
995 = Just $ print_equality (k1, k2, t1, t2)
996
997 | hom_eq_tc
998 , [k, t1, t2] <- args
999 = Just $ print_equality (k, k, t1, t2)
1000
1001 | otherwise
1002 = Nothing
1003 where
1004 homogeneous = case ifaceTyConSort $ ifaceTyConInfo tc of
1005 IfaceEqualityTyCon -> True
1006 _other -> False
1007 -- True <=> a heterogeneous equality whose arguments
1008 -- are (in this case) of the same kind
1009
1010 tc_name = ifaceTyConName tc
1011 pp = ppr_ty
1012 hom_eq_tc = tc_name `hasKey` eqTyConKey -- (~)
1013 hetero_eq_tc = tc_name `hasKey` eqPrimTyConKey -- (~#)
1014 || tc_name `hasKey` eqReprPrimTyConKey -- (~R#)
1015 || tc_name `hasKey` heqTyConKey -- (~~)
1016 print_equality args =
1017 sdocWithDynFlags $ \dflags ->
1018 getPprStyle $ \style ->
1019 print_equality' args style dflags
1020
1021 print_equality' (ki1, ki2, ty1, ty2) style dflags
1022 | print_eqs -- No magic, just print the original TyCon
1023 = ppr_infix_eq (ppr tc)
1024
1025 | hetero_eq_tc
1026 , print_kinds || not homogeneous
1027 = ppr_infix_eq (text "~~")
1028
1029 | otherwise
1030 = if tc_name `hasKey` eqReprPrimTyConKey
1031 then pprIfacePrefixApp ctxt_prec (text "Coercible")
1032 [pp appPrec ty1, pp appPrec ty2]
1033 else pprIfaceInfixApp ctxt_prec (char '~')
1034 (pp opPrec ty1) (pp opPrec ty2)
1035 where
1036 ppr_infix_eq eq_op
1037 = pprIfaceInfixApp ctxt_prec eq_op
1038 (parens (pp topPrec ty1 <+> dcolon <+> pp opPrec ki1))
1039 (parens (pp topPrec ty2 <+> dcolon <+> pp opPrec ki2))
1040
1041 print_kinds = gopt Opt_PrintExplicitKinds dflags
1042 print_eqs = gopt Opt_PrintEqualityRelations dflags ||
1043 dumpStyle style || debugStyle style
1044
1045
1046 pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
1047 pprIfaceCoTcApp ctxt_prec tc tys = ppr_iface_tc_app ppr_co ctxt_prec tc tys
1048
1049 ppr_iface_tc_app :: (PprPrec -> a -> SDoc) -> PprPrec -> IfaceTyCon -> [a] -> SDoc
1050 ppr_iface_tc_app pp _ tc [ty]
1051 | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty)
1052 | tc `ifaceTyConHasKey` parrTyConKey = pprPromotionQuote tc <> paBrackets (pp topPrec ty)
1053
1054 ppr_iface_tc_app pp ctxt_prec tc tys
1055 | tc `ifaceTyConHasKey` starKindTyConKey
1056 || tc `ifaceTyConHasKey` liftedTypeKindTyConKey
1057 || tc `ifaceTyConHasKey` unicodeStarKindTyConKey
1058 = kindStar -- Handle unicode; do not wrap * in parens
1059
1060 | not (isSymOcc (nameOccName (ifaceTyConName tc)))
1061 = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
1062
1063 | [ty1,ty2] <- tys -- Infix, two arguments;
1064 -- we know nothing of precedence though
1065 = pprIfaceInfixApp ctxt_prec (ppr tc)
1066 (pp opPrec ty1) (pp opPrec ty2)
1067
1068 | otherwise
1069 = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)
1070
1071 pprSum :: Arity -> IsPromoted -> IfaceTcArgs -> SDoc
1072 pprSum _arity is_promoted args
1073 = -- drop the RuntimeRep vars.
1074 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
1075 let tys = tcArgsIfaceTypes args
1076 args' = drop (length tys `div` 2) tys
1077 in pprPromotionQuoteI is_promoted
1078 <> sumParens (pprWithBars (ppr_ty topPrec) args')
1079
1080 pprTuple :: PprPrec -> TupleSort -> IsPromoted -> IfaceTcArgs -> SDoc
1081 pprTuple ctxt_prec ConstraintTuple IsNotPromoted ITC_Nil
1082 = maybeParen ctxt_prec appPrec $
1083 text "() :: Constraint"
1084
1085 -- All promoted constructors have kind arguments
1086 pprTuple _ sort IsPromoted args
1087 = let tys = tcArgsIfaceTypes args
1088 args' = drop (length tys `div` 2) tys
1089 in pprPromotionQuoteI IsPromoted <>
1090 tupleParens sort (pprWithCommas pprIfaceType args')
1091
1092 pprTuple _ sort promoted args
1093 = -- drop the RuntimeRep vars.
1094 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
1095 let tys = tcArgsIfaceTypes args
1096 args' = case sort of
1097 UnboxedTuple -> drop (length tys `div` 2) tys
1098 _ -> tys
1099 in
1100 pprPromotionQuoteI promoted <>
1101 tupleParens sort (pprWithCommas pprIfaceType args')
1102
1103 pprIfaceTyLit :: IfaceTyLit -> SDoc
1104 pprIfaceTyLit (IfaceNumTyLit n) = integer n
1105 pprIfaceTyLit (IfaceStrTyLit n) = text (show n)
1106
1107 pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
1108 pprIfaceCoercion = ppr_co topPrec
1109 pprParendIfaceCoercion = ppr_co appPrec
1110
1111 ppr_co :: PprPrec -> IfaceCoercion -> SDoc
1112 ppr_co _ (IfaceReflCo r ty) = angleBrackets (ppr ty) <> ppr_role r
1113 ppr_co ctxt_prec (IfaceFunCo r co1 co2)
1114 = maybeParen ctxt_prec funPrec $
1115 sep (ppr_co funPrec co1 : ppr_fun_tail co2)
1116 where
1117 ppr_fun_tail (IfaceFunCo r co1 co2)
1118 = (arrow <> ppr_role r <+> ppr_co funPrec co1) : ppr_fun_tail co2
1119 ppr_fun_tail other_co
1120 = [arrow <> ppr_role r <+> pprIfaceCoercion other_co]
1121
1122 ppr_co _ (IfaceTyConAppCo r tc cos)
1123 = parens (pprIfaceCoTcApp topPrec tc cos) <> ppr_role r
1124 ppr_co ctxt_prec (IfaceAppCo co1 co2)
1125 = maybeParen ctxt_prec appPrec $
1126 ppr_co funPrec co1 <+> pprParendIfaceCoercion co2
1127 ppr_co ctxt_prec co@(IfaceForAllCo {})
1128 = maybeParen ctxt_prec funPrec $
1129 pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co)
1130 where
1131 (tvs, inner_co) = split_co co
1132
1133 split_co (IfaceForAllCo (name, _) kind_co co')
1134 = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
1135 split_co co' = ([], co')
1136
1137 -- Why these three? See Note [TcTyVars in IfaceType]
1138 ppr_co _ (IfaceFreeCoVar covar) = ppr covar
1139 ppr_co _ (IfaceCoVarCo covar) = ppr covar
1140 ppr_co _ (IfaceHoleCo covar) = braces (ppr covar)
1141
1142 ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)
1143 = maybeParen ctxt_prec appPrec $
1144 text "UnsafeCo" <+> ppr r <+>
1145 pprParendIfaceType ty1 <+> pprParendIfaceType ty2
1146
1147 ppr_co _ (IfaceUnivCo prov role ty1 ty2)
1148 = text "Univ" <> (parens $
1149 sep [ ppr role <+> pprIfaceUnivCoProv prov
1150 , dcolon <+> ppr ty1 <> comma <+> ppr ty2 ])
1151
1152 ppr_co ctxt_prec (IfaceInstCo co ty)
1153 = maybeParen ctxt_prec appPrec $
1154 text "Inst" <+> pprParendIfaceCoercion co
1155 <+> pprParendIfaceCoercion ty
1156
1157 ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos)
1158 = maybeParen ctxt_prec appPrec $ ppr tc <+> parens (interpp'SP cos)
1159
1160 ppr_co ctxt_prec (IfaceAxiomInstCo n i cos)
1161 = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos
1162 ppr_co ctxt_prec (IfaceSymCo co)
1163 = ppr_special_co ctxt_prec (text "Sym") [co]
1164 ppr_co ctxt_prec (IfaceTransCo co1 co2)
1165 = maybeParen ctxt_prec opPrec $
1166 ppr_co opPrec co1 <+> semi <+> ppr_co opPrec co2
1167 ppr_co ctxt_prec (IfaceNthCo d co)
1168 = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co]
1169 ppr_co ctxt_prec (IfaceLRCo lr co)
1170 = ppr_special_co ctxt_prec (ppr lr) [co]
1171 ppr_co ctxt_prec (IfaceSubCo co)
1172 = ppr_special_co ctxt_prec (text "Sub") [co]
1173 ppr_co ctxt_prec (IfaceCoherenceCo co1 co2)
1174 = ppr_special_co ctxt_prec (text "Coh") [co1,co2]
1175 ppr_co ctxt_prec (IfaceKindCo co)
1176 = ppr_special_co ctxt_prec (text "Kind") [co]
1177
1178 ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
1179 ppr_special_co ctxt_prec doc cos
1180 = maybeParen ctxt_prec appPrec
1181 (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))])
1182
1183 ppr_role :: Role -> SDoc
1184 ppr_role r = underscore <> pp_role
1185 where pp_role = case r of
1186 Nominal -> char 'N'
1187 Representational -> char 'R'
1188 Phantom -> char 'P'
1189
1190 ------------------
1191 pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
1192 pprIfaceUnivCoProv IfaceUnsafeCoerceProv
1193 = text "unsafe"
1194 pprIfaceUnivCoProv (IfacePhantomProv co)
1195 = text "phantom" <+> pprParendIfaceCoercion co
1196 pprIfaceUnivCoProv (IfaceProofIrrelProv co)
1197 = text "irrel" <+> pprParendIfaceCoercion co
1198 pprIfaceUnivCoProv (IfacePluginProv s)
1199 = text "plugin" <+> doubleQuotes (text s)
1200
1201 -------------------
1202 instance Outputable IfaceTyCon where
1203 ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
1204
1205 pprPromotionQuote :: IfaceTyCon -> SDoc
1206 pprPromotionQuote tc =
1207 pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc
1208
1209 pprPromotionQuoteI :: IsPromoted -> SDoc
1210 pprPromotionQuoteI IsNotPromoted = empty
1211 pprPromotionQuoteI IsPromoted = char '\''
1212
1213 instance Outputable IfaceCoercion where
1214 ppr = pprIfaceCoercion
1215
1216 instance Binary IfaceTyCon where
1217 put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i
1218
1219 get bh = do n <- get bh
1220 i <- get bh
1221 return (IfaceTyCon n i)
1222
1223 instance Binary IsPromoted where
1224 put_ bh IsNotPromoted = putByte bh 0
1225 put_ bh IsPromoted = putByte bh 1
1226
1227 get bh = do
1228 n <- getByte bh
1229 case n of
1230 0 -> return IsNotPromoted
1231 1 -> return IsPromoted
1232 _ -> fail "Binary(IsPromoted): fail)"
1233
1234 instance Binary IfaceTyConSort where
1235 put_ bh IfaceNormalTyCon = putByte bh 0
1236 put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort
1237 put_ bh (IfaceSumTyCon arity) = putByte bh 2 >> put_ bh arity
1238 put_ bh IfaceEqualityTyCon = putByte bh 3
1239
1240 get bh = do
1241 n <- getByte bh
1242 case n of
1243 0 -> return IfaceNormalTyCon
1244 1 -> IfaceTupleTyCon <$> get bh <*> get bh
1245 2 -> IfaceSumTyCon <$> get bh
1246 _ -> return IfaceEqualityTyCon
1247
1248 instance Binary IfaceTyConInfo where
1249 put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s
1250
1251 get bh = IfaceTyConInfo <$> get bh <*> get bh
1252
1253 instance Outputable IfaceTyLit where
1254 ppr = pprIfaceTyLit
1255
1256 instance Binary IfaceTyLit where
1257 put_ bh (IfaceNumTyLit n) = putByte bh 1 >> put_ bh n
1258 put_ bh (IfaceStrTyLit n) = putByte bh 2 >> put_ bh n
1259
1260 get bh =
1261 do tag <- getByte bh
1262 case tag of
1263 1 -> do { n <- get bh
1264 ; return (IfaceNumTyLit n) }
1265 2 -> do { n <- get bh
1266 ; return (IfaceStrTyLit n) }
1267 _ -> panic ("get IfaceTyLit " ++ show tag)
1268
1269 instance Binary IfaceTcArgs where
1270 put_ bh tk =
1271 case tk of
1272 ITC_Vis t ts -> putByte bh 0 >> put_ bh t >> put_ bh ts
1273 ITC_Invis t ts -> putByte bh 1 >> put_ bh t >> put_ bh ts
1274 ITC_Nil -> putByte bh 2
1275
1276 get bh =
1277 do c <- getByte bh
1278 case c of
1279 0 -> do
1280 t <- get bh
1281 ts <- get bh
1282 return $! ITC_Vis t ts
1283 1 -> do
1284 t <- get bh
1285 ts <- get bh
1286 return $! ITC_Invis t ts
1287 2 -> return ITC_Nil
1288 _ -> panic ("get IfaceTcArgs " ++ show c)
1289
1290 -------------------
1291
1292 -- Some notes about printing contexts
1293 --
1294 -- In the event that we are printing a singleton context (e.g. @Eq a@) we can
1295 -- omit parentheses. However, we must take care to set the precedence correctly
1296 -- to opPrec, since something like @a :~: b@ must be parenthesized (see
1297 -- #9658).
1298 --
1299 -- When printing a larger context we use 'fsep' instead of 'sep' so that
1300 -- the context doesn't get displayed as a giant column. Rather than,
1301 -- instance (Eq a,
1302 -- Eq b,
1303 -- Eq c,
1304 -- Eq d,
1305 -- Eq e,
1306 -- Eq f,
1307 -- Eq g,
1308 -- Eq h,
1309 -- Eq i,
1310 -- Eq j,
1311 -- Eq k,
1312 -- Eq l) =>
1313 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
1314 --
1315 -- we want
1316 --
1317 -- instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
1318 -- Eq j, Eq k, Eq l) =>
1319 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
1320
1321
1322
1323 -- | Prints "(C a, D b) =>", including the arrow.
1324 -- Used when we want to print a context in a type, so we
1325 -- use 'funPrec' to decide whether to parenthesise a singleton
1326 -- predicate; e.g. Num a => a -> a
1327 pprIfaceContextArr :: [IfacePredType] -> SDoc
1328 pprIfaceContextArr [] = empty
1329 pprIfaceContextArr [pred] = ppr_ty funPrec pred <+> darrow
1330 pprIfaceContextArr preds = ppr_parend_preds preds <+> darrow
1331
1332 -- | Prints a context or @()@ if empty
1333 -- You give it the context precedence
1334 pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc
1335 pprIfaceContext _ [] = text "()"
1336 pprIfaceContext prec [pred] = ppr_ty prec pred
1337 pprIfaceContext _ preds = ppr_parend_preds preds
1338
1339 ppr_parend_preds :: [IfacePredType] -> SDoc
1340 ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds)))
1341
1342 instance Binary IfaceType where
1343 put_ _ (IfaceFreeTyVar tv)
1344 = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv)
1345
1346 put_ bh (IfaceForAllTy aa ab) = do
1347 putByte bh 0
1348 put_ bh aa
1349 put_ bh ab
1350 put_ bh (IfaceTyVar ad) = do
1351 putByte bh 1
1352 put_ bh ad
1353 put_ bh (IfaceAppTy ae af) = do
1354 putByte bh 2
1355 put_ bh ae
1356 put_ bh af
1357 put_ bh (IfaceFunTy ag ah) = do
1358 putByte bh 3
1359 put_ bh ag
1360 put_ bh ah
1361 put_ bh (IfaceDFunTy ag ah) = do
1362 putByte bh 4
1363 put_ bh ag
1364 put_ bh ah
1365 put_ bh (IfaceTyConApp tc tys)
1366 = do { putByte bh 5; put_ bh tc; put_ bh tys }
1367 put_ bh (IfaceCastTy a b)
1368 = do { putByte bh 6; put_ bh a; put_ bh b }
1369 put_ bh (IfaceCoercionTy a)
1370 = do { putByte bh 7; put_ bh a }
1371 put_ bh (IfaceTupleTy s i tys)
1372 = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys }
1373 put_ bh (IfaceLitTy n)
1374 = do { putByte bh 9; put_ bh n }
1375
1376 get bh = do
1377 h <- getByte bh
1378 case h of
1379 0 -> do aa <- get bh
1380 ab <- get bh
1381 return (IfaceForAllTy aa ab)
1382 1 -> do ad <- get bh
1383 return (IfaceTyVar ad)
1384 2 -> do ae <- get bh
1385 af <- get bh
1386 return (IfaceAppTy ae af)
1387 3 -> do ag <- get bh
1388 ah <- get bh
1389 return (IfaceFunTy ag ah)
1390 4 -> do ag <- get bh
1391 ah <- get bh
1392 return (IfaceDFunTy ag ah)
1393 5 -> do { tc <- get bh; tys <- get bh
1394 ; return (IfaceTyConApp tc tys) }
1395 6 -> do { a <- get bh; b <- get bh
1396 ; return (IfaceCastTy a b) }
1397 7 -> do { a <- get bh
1398 ; return (IfaceCoercionTy a) }
1399
1400 8 -> do { s <- get bh; i <- get bh; tys <- get bh
1401 ; return (IfaceTupleTy s i tys) }
1402 _ -> do n <- get bh
1403 return (IfaceLitTy n)
1404
1405 instance Binary IfaceCoercion where
1406 put_ bh (IfaceReflCo a b) = do
1407 putByte bh 1
1408 put_ bh a
1409 put_ bh b
1410 put_ bh (IfaceFunCo a b c) = do
1411 putByte bh 2
1412 put_ bh a
1413 put_ bh b
1414 put_ bh c
1415 put_ bh (IfaceTyConAppCo a b c) = do
1416 putByte bh 3
1417 put_ bh a
1418 put_ bh b
1419 put_ bh c
1420 put_ bh (IfaceAppCo a b) = do
1421 putByte bh 4
1422 put_ bh a
1423 put_ bh b
1424 put_ bh (IfaceForAllCo a b c) = do
1425 putByte bh 5
1426 put_ bh a
1427 put_ bh b
1428 put_ bh c
1429 put_ bh (IfaceCoVarCo a) = do
1430 putByte bh 6
1431 put_ bh a
1432 put_ bh (IfaceAxiomInstCo a b c) = do
1433 putByte bh 7
1434 put_ bh a
1435 put_ bh b
1436 put_ bh c
1437 put_ bh (IfaceUnivCo a b c d) = do
1438 putByte bh 8
1439 put_ bh a
1440 put_ bh b
1441 put_ bh c
1442 put_ bh d
1443 put_ bh (IfaceSymCo a) = do
1444 putByte bh 9
1445 put_ bh a
1446 put_ bh (IfaceTransCo a b) = do
1447 putByte bh 10
1448 put_ bh a
1449 put_ bh b
1450 put_ bh (IfaceNthCo a b) = do
1451 putByte bh 11
1452 put_ bh a
1453 put_ bh b
1454 put_ bh (IfaceLRCo a b) = do
1455 putByte bh 12
1456 put_ bh a
1457 put_ bh b
1458 put_ bh (IfaceInstCo a b) = do
1459 putByte bh 13
1460 put_ bh a
1461 put_ bh b
1462 put_ bh (IfaceCoherenceCo a b) = do
1463 putByte bh 14
1464 put_ bh a
1465 put_ bh b
1466 put_ bh (IfaceKindCo a) = do
1467 putByte bh 15
1468 put_ bh a
1469 put_ bh (IfaceSubCo a) = do
1470 putByte bh 16
1471 put_ bh a
1472 put_ bh (IfaceAxiomRuleCo a b) = do
1473 putByte bh 17
1474 put_ bh a
1475 put_ bh b
1476 put_ _ (IfaceFreeCoVar cv)
1477 = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)
1478 put_ _ (IfaceHoleCo cv)
1479 = pprPanic "Can't serialise IfaceHoleCo" (ppr cv)
1480 -- See Note [Holes in IfaceUnivCoProv]
1481
1482 get bh = do
1483 tag <- getByte bh
1484 case tag of
1485 1 -> do a <- get bh
1486 b <- get bh
1487 return $ IfaceReflCo a b
1488 2 -> do a <- get bh
1489 b <- get bh
1490 c <- get bh
1491 return $ IfaceFunCo a b c
1492 3 -> do a <- get bh
1493 b <- get bh
1494 c <- get bh
1495 return $ IfaceTyConAppCo a b c
1496 4 -> do a <- get bh
1497 b <- get bh
1498 return $ IfaceAppCo a b
1499 5 -> do a <- get bh
1500 b <- get bh
1501 c <- get bh
1502 return $ IfaceForAllCo a b c
1503 6 -> do a <- get bh
1504 return $ IfaceCoVarCo a
1505 7 -> do a <- get bh
1506 b <- get bh
1507 c <- get bh
1508 return $ IfaceAxiomInstCo a b c
1509 8 -> do a <- get bh
1510 b <- get bh
1511 c <- get bh
1512 d <- get bh
1513 return $ IfaceUnivCo a b c d
1514 9 -> do a <- get bh
1515 return $ IfaceSymCo a
1516 10-> do a <- get bh
1517 b <- get bh
1518 return $ IfaceTransCo a b
1519 11-> do a <- get bh
1520 b <- get bh
1521 return $ IfaceNthCo a b
1522 12-> do a <- get bh
1523 b <- get bh
1524 return $ IfaceLRCo a b
1525 13-> do a <- get bh
1526 b <- get bh
1527 return $ IfaceInstCo a b
1528 14-> do a <- get bh
1529 b <- get bh
1530 return $ IfaceCoherenceCo a b
1531 15-> do a <- get bh
1532 return $ IfaceKindCo a
1533 16-> do a <- get bh
1534 return $ IfaceSubCo a
1535 17-> do a <- get bh
1536 b <- get bh
1537 return $ IfaceAxiomRuleCo a b
1538 _ -> panic ("get IfaceCoercion " ++ show tag)
1539
1540 instance Binary IfaceUnivCoProv where
1541 put_ bh IfaceUnsafeCoerceProv = putByte bh 1
1542 put_ bh (IfacePhantomProv a) = do
1543 putByte bh 2
1544 put_ bh a
1545 put_ bh (IfaceProofIrrelProv a) = do
1546 putByte bh 3
1547 put_ bh a
1548 put_ bh (IfacePluginProv a) = do
1549 putByte bh 4
1550 put_ bh a
1551
1552 get bh = do
1553 tag <- getByte bh
1554 case tag of
1555 1 -> return $ IfaceUnsafeCoerceProv
1556 2 -> do a <- get bh
1557 return $ IfacePhantomProv a
1558 3 -> do a <- get bh
1559 return $ IfaceProofIrrelProv a
1560 4 -> do a <- get bh
1561 return $ IfacePluginProv a
1562 _ -> panic ("get IfaceUnivCoProv " ++ show tag)
1563
1564
1565 instance Binary (DefMethSpec IfaceType) where
1566 put_ bh VanillaDM = putByte bh 0
1567 put_ bh (GenericDM t) = putByte bh 1 >> put_ bh t
1568 get bh = do
1569 h <- getByte bh
1570 case h of
1571 0 -> return VanillaDM
1572 _ -> do { t <- get bh; return (GenericDM t) }