Refine the suppression of RuntimeRep variables
[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 {-# LANGUAGE TupleSections #-}
12 -- FlexibleInstances for Binary (DefMethSpec IfaceType)
13
14 module IfaceType (
15 IfExtName, IfLclName,
16
17 IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
18 IfaceMCoercion(..),
19 IfaceUnivCoProv(..),
20 IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..),
21 IfaceTyLit(..), IfaceAppArgs(..),
22 IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
23 IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
24 IfaceForAllBndr, ArgFlag(..), ShowForAllFlag(..),
25 mkIfaceForAllTvBndr,
26
27 ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
28 ifTyConBinderVar, ifTyConBinderName,
29
30 -- Equality testing
31 isIfaceLiftedTypeKind,
32
33 -- Conversion from IfaceAppArgs to IfaceTypes/ArgFlags
34 appArgsIfaceTypes, appArgsIfaceTypesArgFlags,
35
36 -- Printing
37 pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
38 pprIfaceContext, pprIfaceContextArr,
39 pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
40 pprIfaceBndrs, pprIfaceAppArgs, pprParendIfaceAppArgs,
41 pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,
42 pprIfaceSigmaType, pprIfaceTyLit,
43 pprIfaceCoercion, pprParendIfaceCoercion,
44 splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
45 pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
46
47 suppressIfaceInvisibles,
48 stripIfaceInvisVars,
49 stripInvisArgs,
50
51 mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst
52 ) where
53
54 #include "HsVersions.h"
55
56 import GhcPrelude
57
58 import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon
59 , liftedRepDataConTyCon )
60 import {-# SOURCE #-} TyCoRep ( isRuntimeRepTy )
61
62 import DynFlags
63 import TyCon hiding ( pprPromotionQuote )
64 import CoAxiom
65 import Var
66 import PrelNames
67 import Name
68 import BasicTypes
69 import Binary
70 import Outputable
71 import FastString
72 import FastStringEnv
73 import Util
74
75 import Data.Maybe( isJust )
76 import qualified Data.Semigroup as Semi
77
78 {-
79 ************************************************************************
80 * *
81 Local (nested) binders
82 * *
83 ************************************************************************
84 -}
85
86 type IfLclName = FastString -- A local name in iface syntax
87
88 type IfExtName = Name -- An External or WiredIn Name can appear in IfaceSyn
89 -- (However Internal or System Names never should)
90
91 data IfaceBndr -- Local (non-top-level) binders
92 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
93 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
94
95 type IfaceIdBndr = (IfLclName, IfaceType)
96 type IfaceTvBndr = (IfLclName, IfaceKind)
97
98 ifaceTvBndrName :: IfaceTvBndr -> IfLclName
99 ifaceTvBndrName (n,_) = n
100
101 ifaceIdBndrName :: IfaceIdBndr -> IfLclName
102 ifaceIdBndrName (n,_) = n
103
104 ifaceBndrName :: IfaceBndr -> IfLclName
105 ifaceBndrName (IfaceTvBndr bndr) = ifaceTvBndrName bndr
106 ifaceBndrName (IfaceIdBndr bndr) = ifaceIdBndrName bndr
107
108 type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
109
110 data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy
111 = IfaceNoOneShot -- and Note [The oneShot function] in MkId
112 | IfaceOneShot
113
114
115 {-
116 %************************************************************************
117 %* *
118 IfaceType
119 %* *
120 %************************************************************************
121 -}
122
123 -------------------------------
124 type IfaceKind = IfaceType
125
126 -- | A kind of universal type, used for types and kinds.
127 --
128 -- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType'
129 -- before being printed. See Note [Pretty printing via IfaceSyn] in PprTyThing
130 data IfaceType
131 = IfaceFreeTyVar TyVar -- See Note [Free tyvars in IfaceType]
132 | IfaceTyVar IfLclName -- Type/coercion variable only, not tycon
133 | IfaceLitTy IfaceTyLit
134 | IfaceAppTy IfaceType IfaceAppArgs
135 -- See Note [Suppressing invisible arguments] for
136 -- an explanation of why the second field isn't
137 -- IfaceType, analogous to AppTy.
138 | IfaceFunTy IfaceType IfaceType
139 | IfaceDFunTy IfaceType IfaceType
140 | IfaceForAllTy IfaceForAllBndr IfaceType
141 | IfaceTyConApp IfaceTyCon IfaceAppArgs -- Not necessarily saturated
142 -- Includes newtypes, synonyms, tuples
143 | IfaceCastTy IfaceType IfaceCoercion
144 | IfaceCoercionTy IfaceCoercion
145
146 | IfaceTupleTy -- Saturated tuples (unsaturated ones use IfaceTyConApp)
147 TupleSort -- What sort of tuple?
148 PromotionFlag -- A bit like IfaceTyCon
149 IfaceAppArgs -- arity = length args
150 -- For promoted data cons, the kind args are omitted
151
152 type IfacePredType = IfaceType
153 type IfaceContext = [IfacePredType]
154
155 data IfaceTyLit
156 = IfaceNumTyLit Integer
157 | IfaceStrTyLit FastString
158 deriving (Eq)
159
160 type IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis
161 type IfaceForAllBndr = VarBndr IfaceBndr ArgFlag
162
163 -- | Make an 'IfaceForAllBndr' from an 'IfaceTvBndr'.
164 mkIfaceForAllTvBndr :: ArgFlag -> IfaceTvBndr -> IfaceForAllBndr
165 mkIfaceForAllTvBndr vis var = Bndr (IfaceTvBndr var) vis
166
167 -- | Stores the arguments in a type application as a list.
168 -- See @Note [Suppressing invisible arguments]@.
169 data IfaceAppArgs
170 = IA_Nil
171 | IA_Arg IfaceType -- The type argument
172
173 ArgFlag -- The argument's visibility. We store this here so
174 -- that we can:
175 --
176 -- 1. Avoid pretty-printing invisible (i.e., specified
177 -- or inferred) arguments when
178 -- -fprint-explicit-kinds isn't enabled, or
179 -- 2. When -fprint-explicit-kinds *is*, enabled, print
180 -- specified arguments in @(...) and inferred
181 -- arguments in @{...}.
182
183 IfaceAppArgs -- The rest of the arguments
184
185 instance Semi.Semigroup IfaceAppArgs where
186 IA_Nil <> xs = xs
187 IA_Arg ty argf rest <> xs = IA_Arg ty argf (rest Semi.<> xs)
188
189 instance Monoid IfaceAppArgs where
190 mempty = IA_Nil
191 mappend = (Semi.<>)
192
193 -- Encodes type constructors, kind constructors,
194 -- coercion constructors, the lot.
195 -- We have to tag them in order to pretty print them
196 -- properly.
197 data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName
198 , ifaceTyConInfo :: IfaceTyConInfo }
199 deriving (Eq)
200
201 -- | The various types of TyCons which have special, built-in syntax.
202 data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon
203
204 | IfaceTupleTyCon !Arity !TupleSort
205 -- ^ e.g. @(a, b, c)@ or @(#a, b, c#)@.
206 -- The arity is the tuple width, not the tycon arity
207 -- (which is twice the width in the case of unboxed
208 -- tuples).
209
210 | IfaceSumTyCon !Arity
211 -- ^ e.g. @(a | b | c)@
212
213 | IfaceEqualityTyCon
214 -- ^ A heterogeneous equality TyCon
215 -- (i.e. eqPrimTyCon, eqReprPrimTyCon, heqTyCon)
216 -- that is actually being applied to two types
217 -- of the same kind. This affects pretty-printing
218 -- only: see Note [Equality predicates in IfaceType]
219 deriving (Eq)
220
221 {- Note [Free tyvars in IfaceType]
222 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
223 Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to
224 an IfaceType and pretty printing that. This eliminates a lot of
225 pretty-print duplication, and it matches what we do with pretty-
226 printing TyThings. See Note [Pretty printing via IfaceSyn] in PprTyThing.
227
228 It works fine for closed types, but when printing debug traces (e.g.
229 when using -ddump-tc-trace) we print a lot of /open/ types. These
230 types are full of TcTyVars, and it's absolutely crucial to print them
231 in their full glory, with their unique, TcTyVarDetails etc.
232
233 So we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor.
234 Note that:
235
236 * We never expect to serialise an IfaceFreeTyVar into an interface file, nor
237 to deserialise one. IfaceFreeTyVar is used only in the "convert to IfaceType
238 and then pretty-print" pipeline.
239
240 We do the same for covars, naturally.
241
242 Note [Equality predicates in IfaceType]
243 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
244 GHC has several varieties of type equality (see Note [The equality types story]
245 in TysPrim for details). In an effort to avoid confusing users, we suppress
246 the differences during pretty printing unless certain flags are enabled.
247 Here is how each equality predicate* is printed in homogeneous and
248 heterogeneous contexts, depending on which combination of the
249 -fprint-explicit-kinds and -fprint-equality-relations flags is used:
250
251 --------------------------------------------------------------------------------------------
252 | Predicate | Neither flag | -fprint-explicit-kinds |
253 |-------------------------------|----------------------------|-----------------------------|
254 | a ~ b (homogeneous) | a ~ b | (a :: Type) ~ (b :: Type) |
255 | a ~~ b, homogeneously | a ~ b | (a :: Type) ~ (b :: Type) |
256 | a ~~ b, heterogeneously | a ~~ c | (a :: Type) ~~ (c :: k) |
257 | a ~# b, homogeneously | a ~ b | (a :: Type) ~ (b :: Type) |
258 | a ~# b, heterogeneously | a ~~ c | (a :: Type) ~~ (c :: k) |
259 | Coercible a b (homogeneous) | Coercible a b | Coercible @Type a b |
260 | a ~R# b, homogeneously | Coercible a b | Coercible @Type a b |
261 | a ~R# b, heterogeneously | a ~R# b | (a :: Type) ~R# (c :: k) |
262 |-------------------------------|----------------------------|-----------------------------|
263 | Predicate | -fprint-equality-relations | Both flags |
264 |-------------------------------|----------------------------|-----------------------------|
265 | a ~ b (homogeneous) | a ~ b | (a :: Type) ~ (b :: Type) |
266 | a ~~ b, homogeneously | a ~~ b | (a :: Type) ~~ (b :: Type) |
267 | a ~~ b, heterogeneously | a ~~ c | (a :: Type) ~~ (c :: k) |
268 | a ~# b, homogeneously | a ~# b | (a :: Type) ~# (b :: Type) |
269 | a ~# b, heterogeneously | a ~# c | (a :: Type) ~# (c :: k) |
270 | Coercible a b (homogeneous) | Coercible a b | Coercible @Type a b |
271 | a ~R# b, homogeneously | a ~R# b | (a :: Type) ~R# (b :: Type) |
272 | a ~R# b, heterogeneously | a ~R# b | (a :: Type) ~R# (c :: k) |
273 --------------------------------------------------------------------------------------------
274
275 (* There is no heterogeneous, representational, lifted equality counterpart
276 to (~~). There could be, but there seems to be no use for it.)
277
278 This table adheres to the following rules:
279
280 A. With -fprint-equality-relations, print the true equality relation.
281 B. Without -fprint-equality-relations:
282 i. If the equality is representational and homogeneous, use Coercible.
283 ii. Otherwise, if the equality is representational, use ~R#.
284 iii. If the equality is nominal and homogeneous, use ~.
285 iv. Otherwise, if the equality is nominal, use ~~.
286 C. With -fprint-explicit-kinds, print kinds on both sides of an infix operator,
287 as above; or print the kind with Coercible.
288 D. Without -fprint-explicit-kinds, don't print kinds.
289
290 A hetero-kinded equality is used homogeneously when it is applied to two
291 identical kinds. Unfortunately, determining this from an IfaceType isn't
292 possible since we can't see through type synonyms. Consequently, we need to
293 record whether this particular application is homogeneous in IfaceTyConSort
294 for the purposes of pretty-printing.
295
296 See Note [The equality types story] in TysPrim.
297 -}
298
299 data IfaceTyConInfo -- Used to guide pretty-printing
300 -- and to disambiguate D from 'D (they share a name)
301 = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag
302 , ifaceTyConSort :: IfaceTyConSort }
303 deriving (Eq)
304
305 data IfaceMCoercion
306 = IfaceMRefl
307 | IfaceMCo IfaceCoercion
308
309 data IfaceCoercion
310 = IfaceReflCo IfaceType
311 | IfaceGReflCo Role IfaceType (IfaceMCoercion)
312 | IfaceFunCo Role IfaceCoercion IfaceCoercion
313 | IfaceTyConAppCo Role IfaceTyCon [IfaceCoercion]
314 | IfaceAppCo IfaceCoercion IfaceCoercion
315 | IfaceForAllCo IfaceBndr IfaceCoercion IfaceCoercion
316 | IfaceCoVarCo IfLclName
317 | IfaceAxiomInstCo IfExtName BranchIndex [IfaceCoercion]
318 | IfaceAxiomRuleCo IfLclName [IfaceCoercion]
319 -- There are only a fixed number of CoAxiomRules, so it suffices
320 -- to use an IfaceLclName to distinguish them.
321 -- See Note [Adding built-in type families] in TcTypeNats
322 | IfaceUnivCo IfaceUnivCoProv Role IfaceType IfaceType
323 | IfaceSymCo IfaceCoercion
324 | IfaceTransCo IfaceCoercion IfaceCoercion
325 | IfaceNthCo Int IfaceCoercion
326 | IfaceLRCo LeftOrRight IfaceCoercion
327 | IfaceInstCo IfaceCoercion IfaceCoercion
328 | IfaceKindCo IfaceCoercion
329 | IfaceSubCo IfaceCoercion
330 | IfaceFreeCoVar CoVar -- See Note [Free tyvars in IfaceType]
331 | IfaceHoleCo CoVar -- ^ See Note [Holes in IfaceCoercion]
332
333 data IfaceUnivCoProv
334 = IfaceUnsafeCoerceProv
335 | IfacePhantomProv IfaceCoercion
336 | IfaceProofIrrelProv IfaceCoercion
337 | IfacePluginProv String
338
339 {- Note [Holes in IfaceCoercion]
340 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
341 When typechecking fails the typechecker will produce a HoleCo to stand
342 in place of the unproven assertion. While we generally don't want to
343 let these unproven assertions leak into interface files, we still need
344 to be able to pretty-print them as we use IfaceType's pretty-printer
345 to render Types. For this reason IfaceCoercion has a IfaceHoleCo
346 constructor; however, we fails when asked to serialize to a
347 IfaceHoleCo to ensure that they don't end up in an interface file.
348
349
350 %************************************************************************
351 %* *
352 Functions over IFaceTypes
353 * *
354 ************************************************************************
355 -}
356
357 ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
358 ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key
359
360 isIfaceLiftedTypeKind :: IfaceKind -> Bool
361 isIfaceLiftedTypeKind (IfaceTyConApp tc IA_Nil)
362 = isLiftedTypeKindTyConName (ifaceTyConName tc)
363 isIfaceLiftedTypeKind (IfaceTyConApp tc
364 (IA_Arg (IfaceTyConApp ptr_rep_lifted IA_Nil)
365 Required IA_Nil))
366 = tc `ifaceTyConHasKey` tYPETyConKey
367 && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey
368 isIfaceLiftedTypeKind _ = False
369
370 splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
371 -- Mainly for printing purposes
372 --
373 -- Here we split nested IfaceSigmaTy properly.
374 --
375 -- @
376 -- forall t. T t => forall m a b. M m => (a -> m b) -> t a -> m (t b)
377 -- @
378 --
379 -- If you called @splitIfaceSigmaTy@ on this type:
380 --
381 -- @
382 -- ([t, m, a, b], [T t, M m], (a -> m b) -> t a -> m (t b))
383 -- @
384 splitIfaceSigmaTy ty
385 = case (bndrs, theta) of
386 ([], []) -> (bndrs, theta, tau)
387 _ -> let (bndrs', theta', tau') = splitIfaceSigmaTy tau
388 in (bndrs ++ bndrs', theta ++ theta', tau')
389 where
390 (bndrs, rho) = split_foralls ty
391 (theta, tau) = split_rho rho
392
393 split_foralls (IfaceForAllTy bndr ty)
394 = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
395 split_foralls rho = ([], rho)
396
397 split_rho (IfaceDFunTy ty1 ty2)
398 = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
399 split_rho tau = ([], tau)
400
401 suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
402 suppressIfaceInvisibles dflags tys xs
403 | gopt Opt_PrintExplicitKinds dflags = xs
404 | otherwise = suppress tys xs
405 where
406 suppress _ [] = []
407 suppress [] a = a
408 suppress (k:ks) (x:xs)
409 | isInvisibleTyConBinder k = suppress ks xs
410 | otherwise = x : suppress ks xs
411
412 stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
413 stripIfaceInvisVars dflags tyvars
414 | gopt Opt_PrintExplicitKinds dflags = tyvars
415 | otherwise = filterOut isInvisibleTyConBinder tyvars
416
417 -- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'.
418 ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
419 ifForAllBndrVar = binderVar
420
421 -- | Extract the variable name from an 'IfaceForAllBndr'.
422 ifForAllBndrName :: IfaceForAllBndr -> IfLclName
423 ifForAllBndrName fab = ifaceBndrName (ifForAllBndrVar fab)
424
425 -- | Extract an 'IfaceBndr' from an 'IfaceTyConBinder'.
426 ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
427 ifTyConBinderVar = binderVar
428
429 -- | Extract the variable name from an 'IfaceTyConBinder'.
430 ifTyConBinderName :: IfaceTyConBinder -> IfLclName
431 ifTyConBinderName tcb = ifaceBndrName (ifTyConBinderVar tcb)
432
433 ifTypeIsVarFree :: IfaceType -> Bool
434 -- Returns True if the type definitely has no variables at all
435 -- Just used to control pretty printing
436 ifTypeIsVarFree ty = go ty
437 where
438 go (IfaceTyVar {}) = False
439 go (IfaceFreeTyVar {}) = False
440 go (IfaceAppTy fun args) = go fun && go_args args
441 go (IfaceFunTy arg res) = go arg && go res
442 go (IfaceDFunTy arg res) = go arg && go res
443 go (IfaceForAllTy {}) = False
444 go (IfaceTyConApp _ args) = go_args args
445 go (IfaceTupleTy _ _ args) = go_args args
446 go (IfaceLitTy _) = True
447 go (IfaceCastTy {}) = False -- Safe
448 go (IfaceCoercionTy {}) = False -- Safe
449
450 go_args IA_Nil = True
451 go_args (IA_Arg arg _ args) = go arg && go_args args
452
453 {- Note [Substitution on IfaceType]
454 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
455 Substitutions on IfaceType are done only during pretty-printing to
456 construct the result type of a GADT, and does not deal with binders
457 (eg IfaceForAll), so it doesn't need fancy capture stuff. -}
458
459 type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType]
460
461 mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst
462 -- See Note [Substitution on IfaceType]
463 mkIfaceTySubst eq_spec = mkFsEnv eq_spec
464
465 inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
466 -- See Note [Substitution on IfaceType]
467 inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst fs)
468
469 substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
470 -- See Note [Substitution on IfaceType]
471 substIfaceType env ty
472 = go ty
473 where
474 go (IfaceFreeTyVar tv) = IfaceFreeTyVar tv
475 go (IfaceTyVar tv) = substIfaceTyVar env tv
476 go (IfaceAppTy t ts) = IfaceAppTy (go t) (substIfaceAppArgs env ts)
477 go (IfaceFunTy t1 t2) = IfaceFunTy (go t1) (go t2)
478 go (IfaceDFunTy t1 t2) = IfaceDFunTy (go t1) (go t2)
479 go ty@(IfaceLitTy {}) = ty
480 go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceAppArgs env tys)
481 go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceAppArgs env tys)
482 go (IfaceForAllTy {}) = pprPanic "substIfaceType" (ppr ty)
483 go (IfaceCastTy ty co) = IfaceCastTy (go ty) (go_co co)
484 go (IfaceCoercionTy co) = IfaceCoercionTy (go_co co)
485
486 go_mco IfaceMRefl = IfaceMRefl
487 go_mco (IfaceMCo co) = IfaceMCo $ go_co co
488
489 go_co (IfaceReflCo ty) = IfaceReflCo (go ty)
490 go_co (IfaceGReflCo r ty mco) = IfaceGReflCo r (go ty) (go_mco mco)
491 go_co (IfaceFunCo r c1 c2) = IfaceFunCo r (go_co c1) (go_co c2)
492 go_co (IfaceTyConAppCo r tc cos) = IfaceTyConAppCo r tc (go_cos cos)
493 go_co (IfaceAppCo c1 c2) = IfaceAppCo (go_co c1) (go_co c2)
494 go_co (IfaceForAllCo {}) = pprPanic "substIfaceCoercion" (ppr ty)
495 go_co (IfaceFreeCoVar cv) = IfaceFreeCoVar cv
496 go_co (IfaceCoVarCo cv) = IfaceCoVarCo cv
497 go_co (IfaceHoleCo cv) = IfaceHoleCo cv
498 go_co (IfaceAxiomInstCo a i cos) = IfaceAxiomInstCo a i (go_cos cos)
499 go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2)
500 go_co (IfaceSymCo co) = IfaceSymCo (go_co co)
501 go_co (IfaceTransCo co1 co2) = IfaceTransCo (go_co co1) (go_co co2)
502 go_co (IfaceNthCo n co) = IfaceNthCo n (go_co co)
503 go_co (IfaceLRCo lr co) = IfaceLRCo lr (go_co co)
504 go_co (IfaceInstCo c1 c2) = IfaceInstCo (go_co c1) (go_co c2)
505 go_co (IfaceKindCo co) = IfaceKindCo (go_co co)
506 go_co (IfaceSubCo co) = IfaceSubCo (go_co co)
507 go_co (IfaceAxiomRuleCo n cos) = IfaceAxiomRuleCo n (go_cos cos)
508
509 go_cos = map go_co
510
511 go_prov IfaceUnsafeCoerceProv = IfaceUnsafeCoerceProv
512 go_prov (IfacePhantomProv co) = IfacePhantomProv (go_co co)
513 go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co)
514 go_prov (IfacePluginProv str) = IfacePluginProv str
515
516 substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
517 substIfaceAppArgs env args
518 = go args
519 where
520 go IA_Nil = IA_Nil
521 go (IA_Arg ty arg tys) = IA_Arg (substIfaceType env ty) arg (go tys)
522
523 substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
524 substIfaceTyVar env tv
525 | Just ty <- lookupFsEnv env tv = ty
526 | otherwise = IfaceTyVar tv
527
528
529 {-
530 ************************************************************************
531 * *
532 Functions over IfaceAppArgs
533 * *
534 ************************************************************************
535 -}
536
537 stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs
538 stripInvisArgs dflags tys
539 | gopt Opt_PrintExplicitKinds dflags = tys
540 | otherwise = suppress_invis tys
541 where
542 suppress_invis c
543 = case c of
544 IA_Nil -> IA_Nil
545 IA_Arg t argf ts
546 | isVisibleArgFlag argf
547 -> IA_Arg t argf $ suppress_invis ts
548 -- Keep recursing through the remainder of the arguments, as it's
549 -- possible that there are remaining invisible ones.
550 -- See the "In type declarations" section of Note [VarBndrs,
551 -- TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.
552 | otherwise
553 -> suppress_invis ts
554
555 appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
556 appArgsIfaceTypes IA_Nil = []
557 appArgsIfaceTypes (IA_Arg t _ ts) = t : appArgsIfaceTypes ts
558
559 appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceType, ArgFlag)]
560 appArgsIfaceTypesArgFlags IA_Nil = []
561 appArgsIfaceTypesArgFlags (IA_Arg t a ts)
562 = (t, a) : appArgsIfaceTypesArgFlags ts
563
564 ifaceVisAppArgsLength :: IfaceAppArgs -> Int
565 ifaceVisAppArgsLength = go 0
566 where
567 go !n IA_Nil = n
568 go n (IA_Arg _ argf rest)
569 | isVisibleArgFlag argf = go (n+1) rest
570 | otherwise = go n rest
571
572 {-
573 Note [Suppressing invisible arguments]
574 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
575 We use the IfaceAppArgs data type to specify which of the arguments to a type
576 should be displayed when pretty-printing, under the control of
577 -fprint-explicit-kinds.
578 See also Type.filterOutInvisibleTypes.
579 For example, given
580
581 T :: forall k. (k->*) -> k -> * -- Ordinary kind polymorphism
582 'Just :: forall k. k -> 'Maybe k -- Promoted
583
584 we want
585
586 T * Tree Int prints as T Tree Int
587 'Just * prints as Just *
588
589 For type constructors (IfaceTyConApp), IfaceAppArgs is a quite natural fit,
590 since the corresponding Core constructor:
591
592 data Type
593 = ...
594 | TyConApp TyCon [Type]
595
596 Already puts all of its arguments into a list. So when converting a Type to an
597 IfaceType (see toIfaceAppArgsX in ToIface), we simply use the kind of the TyCon
598 (which is cached) to guide the process of converting the argument Types into an
599 IfaceAppArgs list.
600
601 We also want this behavior for IfaceAppTy, since given:
602
603 data Proxy (a :: k)
604 f :: forall (t :: forall a. a -> Type). Proxy Type (t Bool True)
605
606 We want to print the return type as `Proxy (t True)` without the use of
607 -fprint-explicit-kinds (#15330). Accomplishing this is trickier than in the
608 tycon case, because the corresponding Core constructor for IfaceAppTy:
609
610 data Type
611 = ...
612 | AppTy Type Type
613
614 Only stores one argument at a time. Therefore, when converting an AppTy to an
615 IfaceAppTy (in toIfaceTypeX in ToIface), we:
616
617 1. Flatten the chain of AppTys down as much as possible
618 2. Use typeKind to determine the function Type's kind
619 3. Use this kind to guide the process of converting the argument Types into an
620 IfaceAppArgs list.
621
622 By flattening the arguments like this, we obtain two benefits:
623
624 (a) We can reuse the same machinery to pretty-print IfaceTyConApp arguments as
625 we do IfaceTyApp arguments, which means that we only need to implement the
626 logic to filter out invisible arguments once.
627 (b) Unlike for tycons, finding the kind of a type in general (through typeKind)
628 is not a constant-time operation, so by flattening the arguments first, we
629 decrease the number of times we have to call typeKind.
630
631 Note [Pretty-printing invisible arguments]
632 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
633 Note [Suppressing invisible arguments] is all about how to avoid printing
634 invisible arguments when the -fprint-explicit-kinds flag is disables. Well,
635 what about when it's enabled? Then we can and should print invisible kind
636 arguments, and this Note explains how we do it.
637
638 As two running examples, consider the following code:
639
640 {-# LANGUAGE PolyKinds #-}
641 data T1 a
642 data T2 (a :: k)
643
644 When displaying these types (with -fprint-explicit-kinds on), we could just
645 do the following:
646
647 T1 k a
648 T2 k a
649
650 That certainly gets the job done. But it lacks a crucial piece of information:
651 is the `k` argument inferred or specified? To communicate this, we use visible
652 kind application syntax to distinguish the two cases:
653
654 T1 @{k} a
655 T2 @k a
656
657 Here, @{k} indicates that `k` is an inferred argument, and @k indicates that
658 `k` is a specified argument. (See
659 Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep for
660 a lengthier explanation on what "inferred" and "specified" mean.)
661
662 ************************************************************************
663 * *
664 Pretty-printing
665 * *
666 ************************************************************************
667 -}
668
669 if_print_coercions :: SDoc -- ^ if printing coercions
670 -> SDoc -- ^ otherwise
671 -> SDoc
672 if_print_coercions yes no
673 = sdocWithDynFlags $ \dflags ->
674 getPprStyle $ \style ->
675 if gopt Opt_PrintExplicitCoercions dflags
676 || dumpStyle style || debugStyle style
677 then yes
678 else no
679
680 pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
681 pprIfaceInfixApp ctxt_prec pp_tc pp_ty1 pp_ty2
682 = maybeParen ctxt_prec opPrec $
683 sep [pp_ty1, pp_tc <+> pp_ty2]
684
685 pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
686 pprIfacePrefixApp ctxt_prec pp_fun pp_tys
687 | null pp_tys = pp_fun
688 | otherwise = maybeParen ctxt_prec appPrec $
689 hang pp_fun 2 (sep pp_tys)
690
691 -- ----------------------------- Printing binders ------------------------------------
692
693 instance Outputable IfaceBndr where
694 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
695 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr False bndr
696
697 pprIfaceBndrs :: [IfaceBndr] -> SDoc
698 pprIfaceBndrs bs = sep (map ppr bs)
699
700 pprIfaceLamBndr :: IfaceLamBndr -> SDoc
701 pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b
702 pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]"
703
704 pprIfaceIdBndr :: IfaceIdBndr -> SDoc
705 pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)
706
707 pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
708 pprIfaceTvBndr use_parens (tv, ki)
709 | isIfaceLiftedTypeKind ki = ppr tv
710 | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki)
711 where
712 maybe_parens | use_parens = parens
713 | otherwise = id
714
715 pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
716 pprIfaceTyConBinders = sep . map go
717 where
718 go :: IfaceTyConBinder -> SDoc
719 go (Bndr (IfaceIdBndr bndr) _) = pprIfaceIdBndr bndr
720 go (Bndr (IfaceTvBndr bndr) vis) =
721 -- See Note [Pretty-printing invisible arguments]
722 case vis of
723 AnonTCB -> ppr_bndr True
724 NamedTCB Required -> ppr_bndr True
725 NamedTCB Specified -> char '@' <> ppr_bndr True
726 NamedTCB Inferred -> char '@' <> braces (ppr_bndr False)
727 where
728 ppr_bndr use_parens = pprIfaceTvBndr use_parens bndr
729
730 instance Binary IfaceBndr where
731 put_ bh (IfaceIdBndr aa) = do
732 putByte bh 0
733 put_ bh aa
734 put_ bh (IfaceTvBndr ab) = do
735 putByte bh 1
736 put_ bh ab
737 get bh = do
738 h <- getByte bh
739 case h of
740 0 -> do aa <- get bh
741 return (IfaceIdBndr aa)
742 _ -> do ab <- get bh
743 return (IfaceTvBndr ab)
744
745 instance Binary IfaceOneShot where
746 put_ bh IfaceNoOneShot = do
747 putByte bh 0
748 put_ bh IfaceOneShot = do
749 putByte bh 1
750 get bh = do
751 h <- getByte bh
752 case h of
753 0 -> do return IfaceNoOneShot
754 _ -> do return IfaceOneShot
755
756 -- ----------------------------- Printing IfaceType ------------------------------------
757
758 ---------------------------------
759 instance Outputable IfaceType where
760 ppr ty = pprIfaceType ty
761
762 pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
763 pprIfaceType = pprPrecIfaceType topPrec
764 pprParendIfaceType = pprPrecIfaceType appPrec
765
766 pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
767 -- We still need `eliminateRuntimeRep`, since the `pprPrecIfaceType` maybe
768 -- called from other places, besides `:type` and `:info`.
769 pprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty
770
771 ppr_ty :: PprPrec -> IfaceType -> SDoc
772 ppr_ty _ (IfaceFreeTyVar tyvar) = ppr tyvar -- This is the main reason for IfaceFreeTyVar!
773 ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [TcTyVars in IfaceType]
774 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
775 ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys
776 ppr_ty _ (IfaceLitTy n) = pprIfaceTyLit n
777 -- Function types
778 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
779 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
780 maybeParen ctxt_prec funPrec $
781 sep [ppr_ty funPrec ty1, sep (ppr_fun_tail ty2)]
782 where
783 ppr_fun_tail (IfaceFunTy ty1 ty2)
784 = (arrow <+> ppr_ty funPrec ty1) : ppr_fun_tail ty2
785 ppr_fun_tail other_ty
786 = [arrow <+> pprIfaceType other_ty]
787
788 ppr_ty ctxt_prec (IfaceAppTy t ts)
789 = if_print_coercions
790 ppr_app_ty
791 ppr_app_ty_no_casts
792 where
793 ppr_app_ty =
794 sdocWithDynFlags $ \dflags ->
795 pprIfacePrefixApp ctxt_prec
796 (ppr_ty funPrec t)
797 (map (ppr_app_arg appPrec) (tys_wo_kinds dflags))
798
799 tys_wo_kinds dflags = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags ts
800
801 -- Strip any casts from the head of the application
802 ppr_app_ty_no_casts =
803 case t of
804 IfaceCastTy head _ -> ppr_ty ctxt_prec (mk_app_tys head ts)
805 _ -> ppr_app_ty
806
807 mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
808 mk_app_tys (IfaceTyConApp tc tys1) tys2 =
809 IfaceTyConApp tc (tys1 `mappend` tys2)
810 mk_app_tys t1 tys2 = IfaceAppTy t1 tys2
811
812 ppr_ty ctxt_prec (IfaceCastTy ty co)
813 = if_print_coercions
814 (parens (ppr_ty topPrec ty <+> text "|>" <+> ppr co))
815 (ppr_ty ctxt_prec ty)
816
817 ppr_ty ctxt_prec (IfaceCoercionTy co)
818 = if_print_coercions
819 (ppr_co ctxt_prec co)
820 (text "<>")
821
822 ppr_ty ctxt_prec ty -- IfaceForAllTy
823 = maybeParen ctxt_prec funPrec (pprIfaceSigmaType ShowForAllMust ty)
824
825 {- Note [Defaulting RuntimeRep variables]
826 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
827 RuntimeRep variables are considered by many (most?) users to be little
828 more than syntactic noise. When the notion was introduced there was a
829 signficant and understandable push-back from those with pedagogy in
830 mind, which argued that RuntimeRep variables would throw a wrench into
831 nearly any teach approach since they appear in even the lowly ($)
832 function's type,
833
834 ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b
835
836 which is significantly less readable than its non RuntimeRep-polymorphic type of
837
838 ($) :: (a -> b) -> a -> b
839
840 Moreover, unboxed types don't appear all that often in run-of-the-mill
841 Haskell programs, so it makes little sense to make all users pay this
842 syntactic overhead.
843
844 For this reason it was decided that we would hide RuntimeRep variables
845 for now (see #11549). We do this by defaulting all type variables of
846 kind RuntimeRep to LiftedRep. This is done in a pass right before
847 pretty-printing (defaultRuntimeRepVars, controlled by
848 -fprint-explicit-runtime-reps)
849
850 This applies to /quantified/ variables like 'w' above. What about
851 variables that are /free/ in the type being printed, which certainly
852 happens in error messages. Suppose (Trac #16074) we are reporting a
853 mismatch between two skolems
854 (a :: RuntimeRep) ~ (b :: RuntimeRep)
855 We certainly don't want to say "Can't match LiftedRep ~ LiftedRep"!
856
857 But if we are printing the type
858 (forall (a :: Type r). blah
859 we do want to turn that (free) r into LiftedRep, so it prints as
860 (forall a. blah)
861
862 Conclusion: keep track of whether we we are in the kind of a
863 binder; ohly if so, convert free RuntimeRep variables to LiftedRep.
864 -}
865
866 -- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g.
867 --
868 -- @
869 -- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
870 -- (a -> b) -> a -> b
871 -- @
872 --
873 -- turns in to,
874 --
875 -- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @
876 --
877 -- We do this to prevent RuntimeRep variables from incurring a significant
878 -- syntactic overhead in otherwise simple type signatures (e.g. ($)). See
879 -- Note [Defaulting RuntimeRep variables] and #11549 for further discussion.
880 --
881 defaultRuntimeRepVars :: IfaceType -> IfaceType
882 defaultRuntimeRepVars ty = go False emptyFsEnv ty
883 where
884 go :: Bool -- True <=> Inside the kind of a binder
885 -> FastStringEnv () -- Set of enclosing forall-ed RuntimeRep variables
886 -> IfaceType -- (replace them with LiftedRep)
887 -> IfaceType
888 go ink subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty)
889 | isRuntimeRep var_kind
890 , isInvisibleArgFlag argf -- Don't default *visible* quantification
891 -- or we get the mess in #13963
892 = let subs' = extendFsEnv subs var ()
893 -- Record that we should replace it with LiftedRep,
894 -- and recurse, discarding the forall
895 in go ink subs' ty
896
897 go ink subs (IfaceForAllTy bndr ty)
898 = IfaceForAllTy (go_ifacebndr subs bndr) (go ink subs ty)
899
900 go _ subs ty@(IfaceTyVar tv)
901 | tv `elemFsEnv` subs
902 = IfaceTyConApp liftedRep IA_Nil
903 | otherwise
904 = ty
905
906 go in_kind _ ty@(IfaceFreeTyVar tv)
907 -- See Note [Defaulting RuntimeRep variables], about free vars
908 | in_kind && TyCoRep.isRuntimeRepTy (tyVarKind tv)
909 = IfaceTyConApp liftedRep IA_Nil
910 | otherwise
911 = ty
912
913 go ink subs (IfaceTyConApp tc tc_args)
914 = IfaceTyConApp tc (go_args ink subs tc_args)
915
916 go ink subs (IfaceTupleTy sort is_prom tc_args)
917 = IfaceTupleTy sort is_prom (go_args ink subs tc_args)
918
919 go ink subs (IfaceFunTy arg res)
920 = IfaceFunTy (go ink subs arg) (go ink subs res)
921
922 go ink subs (IfaceAppTy t ts)
923 = IfaceAppTy (go ink subs t) (go_args ink subs ts)
924
925 go ink subs (IfaceDFunTy x y)
926 = IfaceDFunTy (go ink subs x) (go ink subs y)
927
928 go ink subs (IfaceCastTy x co)
929 = IfaceCastTy (go ink subs x) co
930
931 go _ _ ty@(IfaceLitTy {}) = ty
932 go _ _ ty@(IfaceCoercionTy {}) = ty
933
934 go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
935 go_ifacebndr subs (Bndr (IfaceIdBndr (n, t)) argf)
936 = Bndr (IfaceIdBndr (n, go True subs t)) argf
937 go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf)
938 = Bndr (IfaceTvBndr (n, go True subs t)) argf
939
940 go_args :: Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
941 go_args _ _ IA_Nil = IA_Nil
942 go_args ink subs (IA_Arg ty argf args)
943 = IA_Arg (go ink subs ty) argf (go_args ink subs args)
944
945 liftedRep :: IfaceTyCon
946 liftedRep = IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
947 where dc_name = getName liftedRepDataConTyCon
948
949 isRuntimeRep :: IfaceType -> Bool
950 isRuntimeRep (IfaceTyConApp tc _) =
951 tc `ifaceTyConHasKey` runtimeRepTyConKey
952 isRuntimeRep _ = False
953
954 eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
955 eliminateRuntimeRep f ty
956 = sdocWithDynFlags $ \dflags ->
957 getPprStyle $ \sty ->
958 if userStyle sty && not (gopt Opt_PrintExplicitRuntimeReps dflags)
959 then f (defaultRuntimeRepVars ty)
960 else f ty
961
962 instance Outputable IfaceAppArgs where
963 ppr tca = pprIfaceAppArgs tca
964
965 pprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
966 pprIfaceAppArgs = ppr_app_args topPrec
967 pprParendIfaceAppArgs = ppr_app_args appPrec
968
969 ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
970 ppr_app_args ctx_prec = go
971 where
972 go :: IfaceAppArgs -> SDoc
973 go IA_Nil = empty
974 go (IA_Arg t argf ts) = ppr_app_arg ctx_prec (t, argf) <+> go ts
975
976 -- See Note [Pretty-printing invisible arguments]
977 ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc
978 ppr_app_arg ctx_prec (t, argf) =
979 sdocWithDynFlags $ \dflags ->
980 let print_kinds = gopt Opt_PrintExplicitKinds dflags
981 in case argf of
982 Required -> ppr_ty ctx_prec t
983 Specified | print_kinds
984 -> char '@' <> ppr_ty appPrec t
985 Inferred | print_kinds
986 -> char '@' <> braces (ppr_ty topPrec t)
987 _ -> empty
988
989 -------------------
990 pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
991 pprIfaceForAllPart tvs ctxt sdoc
992 = ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc
993
994 -- | Like 'pprIfaceForAllPart', but always uses an explicit @forall@.
995 pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
996 pprIfaceForAllPartMust tvs ctxt sdoc
997 = ppr_iface_forall_part ShowForAllMust tvs ctxt sdoc
998
999 pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
1000 pprIfaceForAllCoPart tvs sdoc
1001 = sep [ pprIfaceForAllCo tvs, sdoc ]
1002
1003 ppr_iface_forall_part :: ShowForAllFlag
1004 -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
1005 ppr_iface_forall_part show_forall tvs ctxt sdoc
1006 = sep [ case show_forall of
1007 ShowForAllMust -> pprIfaceForAll tvs
1008 ShowForAllWhen -> pprUserIfaceForAll tvs
1009 , pprIfaceContextArr ctxt
1010 , sdoc]
1011
1012 -- | Render the "forall ... ." or "forall ... ->" bit of a type.
1013 pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
1014 pprIfaceForAll [] = empty
1015 pprIfaceForAll bndrs@(Bndr _ vis : _)
1016 = sep [ add_separator (forAllLit <+> fsep docs)
1017 , pprIfaceForAll bndrs' ]
1018 where
1019 (bndrs', docs) = ppr_itv_bndrs bndrs vis
1020
1021 add_separator stuff = case vis of
1022 Required -> stuff <+> arrow
1023 _inv -> stuff <> dot
1024
1025
1026 -- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
1027 -- Returns both the list of not-yet-rendered binders and the doc.
1028 -- No anonymous binders here!
1029 ppr_itv_bndrs :: [IfaceForAllBndr]
1030 -> ArgFlag -- ^ visibility of the first binder in the list
1031 -> ([IfaceForAllBndr], [SDoc])
1032 ppr_itv_bndrs all_bndrs@(bndr@(Bndr _ vis) : bndrs) vis1
1033 | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
1034 (bndrs', pprIfaceForAllBndr bndr : doc)
1035 | otherwise = (all_bndrs, [])
1036 ppr_itv_bndrs [] _ = ([], [])
1037
1038 pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
1039 pprIfaceForAllCo [] = empty
1040 pprIfaceForAllCo tvs = text "forall" <+> pprIfaceForAllCoBndrs tvs <> dot
1041
1042 pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
1043 pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
1044
1045 pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
1046 pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) Inferred)
1047 = sdocWithDynFlags $ \dflags ->
1048 if gopt Opt_PrintExplicitForalls dflags
1049 then braces $ pprIfaceTvBndr False tv
1050 else pprIfaceTvBndr True tv
1051 pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) _) = pprIfaceTvBndr True tv
1052 pprIfaceForAllBndr (Bndr (IfaceIdBndr idv) _) = pprIfaceIdBndr idv
1053
1054 pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
1055 pprIfaceForAllCoBndr (tv, kind_co)
1056 = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)
1057
1058 -- | Show forall flag
1059 --
1060 -- Unconditionally show the forall quantifier with ('ShowForAllMust')
1061 -- or when ('ShowForAllWhen') the names used are free in the binder
1062 -- or when compiling with -fprint-explicit-foralls.
1063 data ShowForAllFlag = ShowForAllMust | ShowForAllWhen
1064
1065 pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
1066 pprIfaceSigmaType show_forall ty
1067 = eliminateRuntimeRep ppr_fn ty
1068 where
1069 ppr_fn iface_ty =
1070 let (tvs, theta, tau) = splitIfaceSigmaTy iface_ty
1071 in ppr_iface_forall_part show_forall tvs theta (ppr tau)
1072
1073 pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
1074 pprUserIfaceForAll tvs
1075 = sdocWithDynFlags $ \dflags ->
1076 -- See Note [When to print foralls]
1077 ppWhen (any tv_has_kind_var tvs
1078 || any tv_is_required tvs
1079 || gopt Opt_PrintExplicitForalls dflags) $
1080 pprIfaceForAll tvs
1081 where
1082 tv_has_kind_var (Bndr (IfaceTvBndr (_,kind)) _)
1083 = not (ifTypeIsVarFree kind)
1084 tv_has_kind_var _ = False
1085
1086 tv_is_required = isVisibleArgFlag . binderArgFlag
1087
1088 {-
1089 Note [When to print foralls]
1090 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1091 We opt to explicitly pretty-print `forall`s if any of the following
1092 criteria are met:
1093
1094 1. -fprint-explicit-foralls is on.
1095
1096 2. A bound type variable has a polymorphic kind. E.g.,
1097
1098 forall k (a::k). Proxy a -> Proxy a
1099
1100 Since a's kind mentions a variable k, we print the foralls.
1101
1102 3. A bound type variable is a visible argument (#14238).
1103 Suppose we are printing the kind of:
1104
1105 T :: forall k -> k -> Type
1106
1107 The "forall k ->" notation means that this kind argument is required.
1108 That is, it must be supplied at uses of T. E.g.,
1109
1110 f :: T (Type->Type) Monad -> Int
1111
1112 So we print an explicit "T :: forall k -> k -> Type",
1113 because omitting it and printing "T :: k -> Type" would be
1114 utterly misleading.
1115
1116 See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]
1117 in TyCoRep.
1118
1119 N.B. Until now (Aug 2018) we didn't check anything for coercion variables.
1120
1121 Note [Printing foralls in type family instances]
1122 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1123 We use the same criteria as in Note [When to print foralls] to determine
1124 whether a type family instance should be pretty-printed with an explicit
1125 `forall`. Example:
1126
1127 type family Foo (a :: k) :: k where
1128 Foo Maybe = []
1129 Foo (a :: Type) = Int
1130 Foo a = a
1131
1132 Without -fprint-explicit-foralls enabled, this will be pretty-printed as:
1133
1134 type family Foo (a :: k) :: k where
1135 Foo Maybe = []
1136 Foo a = Int
1137 forall k (a :: k). Foo a = a
1138
1139 Note that only the third equation has an explicit forall, since it has a type
1140 variable with a non-Type kind. (If -fprint-explicit-foralls were enabled, then
1141 the second equation would be preceded with `forall a.`.)
1142
1143 There is one tricky point in the implementation: what visibility
1144 do we give the type variables in a type family instance? Type family instances
1145 only store type *variables*, not type variable *binders*, and only the latter
1146 has visibility information. We opt to default the visibility of each of these
1147 type variables to Specified because users can't ever instantiate these
1148 variables manually, so the choice of visibility is only relevant to
1149 pretty-printing. (This is why the `k` in `forall k (a :: k). ...` above is
1150 printed the way it is, even though it wasn't written explicitly in the
1151 original source code.)
1152
1153 We adopt the same strategy for data family instances. Example:
1154
1155 data family DF (a :: k)
1156 data instance DF '[a, b] = DFList
1157
1158 That data family instance is pretty-printed as:
1159
1160 data instance forall j (a :: j) (b :: j). DF '[a, b] = DFList
1161
1162 This is despite that the representation tycon for this data instance (call it
1163 $DF:List) actually has different visibilities for its binders.
1164 However, the visibilities of these binders are utterly irrelevant to the
1165 programmer, who cares only about the specificity of variables in `DF`'s type,
1166 not $DF:List's type. Therefore, we opt to pretty-print all variables in data
1167 family instances as Specified.
1168
1169 Note [Printing promoted type constructors]
1170 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1171 Consider this GHCi session (Trac #14343)
1172 > _ :: Proxy '[ 'True ]
1173 error:
1174 Found hole: _ :: Proxy '['True]
1175
1176 This would be bad, because the '[' looks like a character literal.
1177 Solution: in type-level lists and tuples, add a leading space
1178 if the first type is itself promoted. See pprSpaceIfPromotedTyCon.
1179 -}
1180
1181
1182 -------------------
1183
1184 -- | Prefix a space if the given 'IfaceType' is a promoted 'TyCon'.
1185 -- See Note [Printing promoted type constructors]
1186 pprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc
1187 pprSpaceIfPromotedTyCon (IfaceTyConApp tyCon _)
1188 = case ifaceTyConIsPromoted (ifaceTyConInfo tyCon) of
1189 IsPromoted -> (space <>)
1190 _ -> id
1191 pprSpaceIfPromotedTyCon _
1192 = id
1193
1194 -- See equivalent function in TyCoRep.hs
1195 pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
1196 -- Given a type-level list (t1 ': t2), see if we can print
1197 -- it in list notation [t1, ...].
1198 -- Precondition: Opt_PrintExplicitKinds is off
1199 pprIfaceTyList ctxt_prec ty1 ty2
1200 = case gather ty2 of
1201 (arg_tys, Nothing)
1202 -> char '\'' <> brackets (pprSpaceIfPromotedTyCon ty1 (fsep
1203 (punctuate comma (map (ppr_ty topPrec) (ty1:arg_tys)))))
1204 (arg_tys, Just tl)
1205 -> maybeParen ctxt_prec funPrec $ hang (ppr_ty funPrec ty1)
1206 2 (fsep [ colon <+> ppr_ty funPrec ty | ty <- arg_tys ++ [tl]])
1207 where
1208 gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
1209 -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
1210 -- = (tys, Just tl) means ty is of form t1:t2:...tn:tl
1211 gather (IfaceTyConApp tc tys)
1212 | tc `ifaceTyConHasKey` consDataConKey
1213 , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys
1214 , isInvisibleArgFlag argf
1215 , (args, tl) <- gather ty2
1216 = (ty1:args, tl)
1217 | tc `ifaceTyConHasKey` nilDataConKey
1218 = ([], Nothing)
1219 gather ty = ([], Just ty)
1220
1221 pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
1222 pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args
1223
1224 pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
1225 pprTyTcApp ctxt_prec tc tys =
1226 sdocWithDynFlags $ \dflags ->
1227 getPprStyle $ \style ->
1228 pprTyTcApp' ctxt_prec tc tys dflags style
1229
1230 pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs
1231 -> DynFlags -> PprStyle -> SDoc
1232 pprTyTcApp' ctxt_prec tc tys dflags style
1233 | ifaceTyConName tc `hasKey` ipClassKey
1234 , IA_Arg (IfaceLitTy (IfaceStrTyLit n))
1235 Required (IA_Arg ty Required IA_Nil) <- tys
1236 = maybeParen ctxt_prec funPrec
1237 $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty
1238
1239 | IfaceTupleTyCon arity sort <- ifaceTyConSort info
1240 , not (debugStyle style)
1241 , arity == ifaceVisAppArgsLength tys
1242 = pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys
1243
1244 | IfaceSumTyCon arity <- ifaceTyConSort info
1245 = pprSum arity (ifaceTyConIsPromoted info) tys
1246
1247 | tc `ifaceTyConHasKey` consDataConKey
1248 , not (gopt Opt_PrintExplicitKinds dflags)
1249 , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys
1250 , isInvisibleArgFlag argf
1251 = pprIfaceTyList ctxt_prec ty1 ty2
1252
1253 | tc `ifaceTyConHasKey` tYPETyConKey
1254 , IA_Arg (IfaceTyConApp rep IA_Nil) Required IA_Nil <- tys
1255 , rep `ifaceTyConHasKey` liftedRepDataConKey
1256 = kindType
1257
1258 | otherwise
1259 = getPprDebug $ \dbg ->
1260 if | not dbg && tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey
1261 -- Suppress detail unles you _really_ want to see
1262 -> text "(TypeError ...)"
1263
1264 | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys)
1265 -> doc
1266
1267 | otherwise
1268 -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc tys_wo_kinds
1269 where
1270 info = ifaceTyConInfo tc
1271 tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags tys
1272
1273 -- | Pretty-print a type-level equality.
1274 -- Returns (Just doc) if the argument is a /saturated/ application
1275 -- of eqTyCon (~)
1276 -- eqPrimTyCon (~#)
1277 -- eqReprPrimTyCon (~R#)
1278 -- heqTyCon (~~)
1279 --
1280 -- See Note [Equality predicates in IfaceType]
1281 -- and Note [The equality types story] in TysPrim
1282 ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
1283 ppr_equality ctxt_prec tc args
1284 | hetero_eq_tc
1285 , [k1, k2, t1, t2] <- args
1286 = Just $ print_equality (k1, k2, t1, t2)
1287
1288 | hom_eq_tc
1289 , [k, t1, t2] <- args
1290 = Just $ print_equality (k, k, t1, t2)
1291
1292 | otherwise
1293 = Nothing
1294 where
1295 homogeneous = tc_name `hasKey` eqTyConKey -- (~)
1296 || hetero_tc_used_homogeneously
1297 where
1298 hetero_tc_used_homogeneously
1299 = case ifaceTyConSort $ ifaceTyConInfo tc of
1300 IfaceEqualityTyCon -> True
1301 _other -> False
1302 -- True <=> a heterogeneous equality whose arguments
1303 -- are (in this case) of the same kind
1304
1305 tc_name = ifaceTyConName tc
1306 pp = ppr_ty
1307 hom_eq_tc = tc_name `hasKey` eqTyConKey -- (~)
1308 hetero_eq_tc = tc_name `hasKey` eqPrimTyConKey -- (~#)
1309 || tc_name `hasKey` eqReprPrimTyConKey -- (~R#)
1310 || tc_name `hasKey` heqTyConKey -- (~~)
1311 nominal_eq_tc = tc_name `hasKey` heqTyConKey -- (~~)
1312 || tc_name `hasKey` eqPrimTyConKey -- (~#)
1313 print_equality args =
1314 sdocWithDynFlags $ \dflags ->
1315 getPprStyle $ \style ->
1316 print_equality' args style dflags
1317
1318 print_equality' (ki1, ki2, ty1, ty2) style dflags
1319 | -- If -fprint-equality-relations is on, just print the original TyCon
1320 print_eqs
1321 = ppr_infix_eq (ppr tc)
1322
1323 | -- Homogeneous use of heterogeneous equality (ty1 ~~ ty2)
1324 -- or unlifted equality (ty1 ~# ty2)
1325 nominal_eq_tc, homogeneous
1326 = ppr_infix_eq (text "~")
1327
1328 | -- Heterogeneous use of unlifted equality (ty1 ~# ty2)
1329 not homogeneous
1330 = ppr_infix_eq (ppr heqTyCon)
1331
1332 | -- Homogeneous use of representational unlifted equality (ty1 ~R# ty2)
1333 tc_name `hasKey` eqReprPrimTyConKey, homogeneous
1334 = let ki | print_kinds = [pp appPrec ki1]
1335 | otherwise = []
1336 in pprIfacePrefixApp ctxt_prec (ppr coercibleTyCon)
1337 (ki ++ [pp appPrec ty1, pp appPrec ty2])
1338
1339 -- The other cases work as you'd expect
1340 | otherwise
1341 = ppr_infix_eq (ppr tc)
1342 where
1343 ppr_infix_eq :: SDoc -> SDoc
1344 ppr_infix_eq eq_op = pprIfaceInfixApp ctxt_prec eq_op
1345 (pp_ty_ki ty1 ki1) (pp_ty_ki ty2 ki2)
1346 where
1347 pp_ty_ki ty ki
1348 | print_kinds
1349 = parens (pp topPrec ty <+> dcolon <+> pp opPrec ki)
1350 | otherwise
1351 = pp opPrec ty
1352
1353 print_kinds = gopt Opt_PrintExplicitKinds dflags
1354 print_eqs = gopt Opt_PrintEqualityRelations dflags ||
1355 dumpStyle style || debugStyle style
1356
1357
1358 pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
1359 pprIfaceCoTcApp ctxt_prec tc tys =
1360 ppr_iface_tc_app (\prec (co, _) -> ppr_co prec co) ctxt_prec tc
1361 (map (, Required) tys)
1362 -- We are trying to re-use ppr_iface_tc_app here, which requires its
1363 -- arguments to be accompanied by visibilities. But visibility is
1364 -- irrelevant when printing coercions, so just default everything to
1365 -- Required.
1366
1367 -- | Pretty-prints an application of a type constructor to some arguments
1368 -- (whose visibilities are known). This is polymorphic (over @a@) since we use
1369 -- this function to pretty-print two different things:
1370 --
1371 -- 1. Types (from `pprTyTcApp'`)
1372 --
1373 -- 2. Coercions (from 'pprIfaceCoTcApp')
1374 ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
1375 -> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
1376 ppr_iface_tc_app pp _ tc [ty]
1377 | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty)
1378
1379 ppr_iface_tc_app pp ctxt_prec tc tys
1380 | tc `ifaceTyConHasKey` liftedTypeKindTyConKey
1381 = kindType
1382
1383 | not (isSymOcc (nameOccName (ifaceTyConName tc)))
1384 = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
1385
1386 | [ ty1@(_, Required)
1387 , ty2@(_, Required) ] <- tys
1388 -- Infix, two visible arguments (we know nothing of precedence though).
1389 -- Don't apply this special case if one of the arguments is invisible,
1390 -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
1391 = pprIfaceInfixApp ctxt_prec (ppr tc)
1392 (pp opPrec ty1) (pp opPrec ty2)
1393
1394 | otherwise
1395 = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)
1396
1397 pprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc
1398 pprSum _arity is_promoted args
1399 = -- drop the RuntimeRep vars.
1400 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
1401 let tys = appArgsIfaceTypes args
1402 args' = drop (length tys `div` 2) tys
1403 in pprPromotionQuoteI is_promoted
1404 <> sumParens (pprWithBars (ppr_ty topPrec) args')
1405
1406 pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
1407 pprTuple ctxt_prec ConstraintTuple NotPromoted IA_Nil
1408 = maybeParen ctxt_prec appPrec $
1409 text "() :: Constraint"
1410
1411 -- All promoted constructors have kind arguments
1412 pprTuple _ sort IsPromoted args
1413 = let tys = appArgsIfaceTypes args
1414 args' = drop (length tys `div` 2) tys
1415 spaceIfPromoted = case args' of
1416 arg0:_ -> pprSpaceIfPromotedTyCon arg0
1417 _ -> id
1418 in pprPromotionQuoteI IsPromoted <>
1419 tupleParens sort (spaceIfPromoted (pprWithCommas pprIfaceType args'))
1420
1421 pprTuple _ sort promoted args
1422 = -- drop the RuntimeRep vars.
1423 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
1424 let tys = appArgsIfaceTypes args
1425 args' = case sort of
1426 UnboxedTuple -> drop (length tys `div` 2) tys
1427 _ -> tys
1428 in
1429 pprPromotionQuoteI promoted <>
1430 tupleParens sort (pprWithCommas pprIfaceType args')
1431
1432 pprIfaceTyLit :: IfaceTyLit -> SDoc
1433 pprIfaceTyLit (IfaceNumTyLit n) = integer n
1434 pprIfaceTyLit (IfaceStrTyLit n) = text (show n)
1435
1436 pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
1437 pprIfaceCoercion = ppr_co topPrec
1438 pprParendIfaceCoercion = ppr_co appPrec
1439
1440 ppr_co :: PprPrec -> IfaceCoercion -> SDoc
1441 ppr_co _ (IfaceReflCo ty) = angleBrackets (ppr ty) <> ppr_role Nominal
1442 ppr_co _ (IfaceGReflCo r ty IfaceMRefl)
1443 = angleBrackets (ppr ty) <> ppr_role r
1444 ppr_co ctxt_prec (IfaceGReflCo r ty (IfaceMCo co))
1445 = ppr_special_co ctxt_prec
1446 (text "GRefl" <+> ppr r <+> pprParendIfaceType ty) [co]
1447 ppr_co ctxt_prec (IfaceFunCo r co1 co2)
1448 = maybeParen ctxt_prec funPrec $
1449 sep (ppr_co funPrec co1 : ppr_fun_tail co2)
1450 where
1451 ppr_fun_tail (IfaceFunCo r co1 co2)
1452 = (arrow <> ppr_role r <+> ppr_co funPrec co1) : ppr_fun_tail co2
1453 ppr_fun_tail other_co
1454 = [arrow <> ppr_role r <+> pprIfaceCoercion other_co]
1455
1456 ppr_co _ (IfaceTyConAppCo r tc cos)
1457 = parens (pprIfaceCoTcApp topPrec tc cos) <> ppr_role r
1458 ppr_co ctxt_prec (IfaceAppCo co1 co2)
1459 = maybeParen ctxt_prec appPrec $
1460 ppr_co funPrec co1 <+> pprParendIfaceCoercion co2
1461 ppr_co ctxt_prec co@(IfaceForAllCo {})
1462 = maybeParen ctxt_prec funPrec $
1463 pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co)
1464 where
1465 (tvs, inner_co) = split_co co
1466
1467 split_co (IfaceForAllCo (IfaceTvBndr (name, _)) kind_co co')
1468 = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
1469 split_co (IfaceForAllCo (IfaceIdBndr (name, _)) kind_co co')
1470 = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
1471 split_co co' = ([], co')
1472
1473 -- Why these three? See Note [TcTyVars in IfaceType]
1474 ppr_co _ (IfaceFreeCoVar covar) = ppr covar
1475 ppr_co _ (IfaceCoVarCo covar) = ppr covar
1476 ppr_co _ (IfaceHoleCo covar) = braces (ppr covar)
1477
1478 ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)
1479 = maybeParen ctxt_prec appPrec $
1480 text "UnsafeCo" <+> ppr r <+>
1481 pprParendIfaceType ty1 <+> pprParendIfaceType ty2
1482
1483 ppr_co _ (IfaceUnivCo prov role ty1 ty2)
1484 = text "Univ" <> (parens $
1485 sep [ ppr role <+> pprIfaceUnivCoProv prov
1486 , dcolon <+> ppr ty1 <> comma <+> ppr ty2 ])
1487
1488 ppr_co ctxt_prec (IfaceInstCo co ty)
1489 = maybeParen ctxt_prec appPrec $
1490 text "Inst" <+> pprParendIfaceCoercion co
1491 <+> pprParendIfaceCoercion ty
1492
1493 ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos)
1494 = maybeParen ctxt_prec appPrec $ ppr tc <+> parens (interpp'SP cos)
1495
1496 ppr_co ctxt_prec (IfaceAxiomInstCo n i cos)
1497 = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos
1498 ppr_co ctxt_prec (IfaceSymCo co)
1499 = ppr_special_co ctxt_prec (text "Sym") [co]
1500 ppr_co ctxt_prec (IfaceTransCo co1 co2)
1501 = maybeParen ctxt_prec opPrec $
1502 ppr_co opPrec co1 <+> semi <+> ppr_co opPrec co2
1503 ppr_co ctxt_prec (IfaceNthCo d co)
1504 = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co]
1505 ppr_co ctxt_prec (IfaceLRCo lr co)
1506 = ppr_special_co ctxt_prec (ppr lr) [co]
1507 ppr_co ctxt_prec (IfaceSubCo co)
1508 = ppr_special_co ctxt_prec (text "Sub") [co]
1509 ppr_co ctxt_prec (IfaceKindCo co)
1510 = ppr_special_co ctxt_prec (text "Kind") [co]
1511
1512 ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
1513 ppr_special_co ctxt_prec doc cos
1514 = maybeParen ctxt_prec appPrec
1515 (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))])
1516
1517 ppr_role :: Role -> SDoc
1518 ppr_role r = underscore <> pp_role
1519 where pp_role = case r of
1520 Nominal -> char 'N'
1521 Representational -> char 'R'
1522 Phantom -> char 'P'
1523
1524 ------------------
1525 pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
1526 pprIfaceUnivCoProv IfaceUnsafeCoerceProv
1527 = text "unsafe"
1528 pprIfaceUnivCoProv (IfacePhantomProv co)
1529 = text "phantom" <+> pprParendIfaceCoercion co
1530 pprIfaceUnivCoProv (IfaceProofIrrelProv co)
1531 = text "irrel" <+> pprParendIfaceCoercion co
1532 pprIfaceUnivCoProv (IfacePluginProv s)
1533 = text "plugin" <+> doubleQuotes (text s)
1534
1535 -------------------
1536 instance Outputable IfaceTyCon where
1537 ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
1538
1539 pprPromotionQuote :: IfaceTyCon -> SDoc
1540 pprPromotionQuote tc =
1541 pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc
1542
1543 pprPromotionQuoteI :: PromotionFlag -> SDoc
1544 pprPromotionQuoteI NotPromoted = empty
1545 pprPromotionQuoteI IsPromoted = char '\''
1546
1547 instance Outputable IfaceCoercion where
1548 ppr = pprIfaceCoercion
1549
1550 instance Binary IfaceTyCon where
1551 put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i
1552
1553 get bh = do n <- get bh
1554 i <- get bh
1555 return (IfaceTyCon n i)
1556
1557 instance Binary IfaceTyConSort where
1558 put_ bh IfaceNormalTyCon = putByte bh 0
1559 put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort
1560 put_ bh (IfaceSumTyCon arity) = putByte bh 2 >> put_ bh arity
1561 put_ bh IfaceEqualityTyCon = putByte bh 3
1562
1563 get bh = do
1564 n <- getByte bh
1565 case n of
1566 0 -> return IfaceNormalTyCon
1567 1 -> IfaceTupleTyCon <$> get bh <*> get bh
1568 2 -> IfaceSumTyCon <$> get bh
1569 _ -> return IfaceEqualityTyCon
1570
1571 instance Binary IfaceTyConInfo where
1572 put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s
1573
1574 get bh = IfaceTyConInfo <$> get bh <*> get bh
1575
1576 instance Outputable IfaceTyLit where
1577 ppr = pprIfaceTyLit
1578
1579 instance Binary IfaceTyLit where
1580 put_ bh (IfaceNumTyLit n) = putByte bh 1 >> put_ bh n
1581 put_ bh (IfaceStrTyLit n) = putByte bh 2 >> put_ bh n
1582
1583 get bh =
1584 do tag <- getByte bh
1585 case tag of
1586 1 -> do { n <- get bh
1587 ; return (IfaceNumTyLit n) }
1588 2 -> do { n <- get bh
1589 ; return (IfaceStrTyLit n) }
1590 _ -> panic ("get IfaceTyLit " ++ show tag)
1591
1592 instance Binary IfaceAppArgs where
1593 put_ bh tk =
1594 case tk of
1595 IA_Arg t a ts -> putByte bh 0 >> put_ bh t >> put_ bh a >> put_ bh ts
1596 IA_Nil -> putByte bh 1
1597
1598 get bh =
1599 do c <- getByte bh
1600 case c of
1601 0 -> do
1602 t <- get bh
1603 a <- get bh
1604 ts <- get bh
1605 return $! IA_Arg t a ts
1606 1 -> return IA_Nil
1607 _ -> panic ("get IfaceAppArgs " ++ show c)
1608
1609 -------------------
1610
1611 -- Some notes about printing contexts
1612 --
1613 -- In the event that we are printing a singleton context (e.g. @Eq a@) we can
1614 -- omit parentheses. However, we must take care to set the precedence correctly
1615 -- to opPrec, since something like @a :~: b@ must be parenthesized (see
1616 -- #9658).
1617 --
1618 -- When printing a larger context we use 'fsep' instead of 'sep' so that
1619 -- the context doesn't get displayed as a giant column. Rather than,
1620 -- instance (Eq a,
1621 -- Eq b,
1622 -- Eq c,
1623 -- Eq d,
1624 -- Eq e,
1625 -- Eq f,
1626 -- Eq g,
1627 -- Eq h,
1628 -- Eq i,
1629 -- Eq j,
1630 -- Eq k,
1631 -- Eq l) =>
1632 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
1633 --
1634 -- we want
1635 --
1636 -- instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
1637 -- Eq j, Eq k, Eq l) =>
1638 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
1639
1640
1641
1642 -- | Prints "(C a, D b) =>", including the arrow.
1643 -- Used when we want to print a context in a type, so we
1644 -- use 'funPrec' to decide whether to parenthesise a singleton
1645 -- predicate; e.g. Num a => a -> a
1646 pprIfaceContextArr :: [IfacePredType] -> SDoc
1647 pprIfaceContextArr [] = empty
1648 pprIfaceContextArr [pred] = ppr_ty funPrec pred <+> darrow
1649 pprIfaceContextArr preds = ppr_parend_preds preds <+> darrow
1650
1651 -- | Prints a context or @()@ if empty
1652 -- You give it the context precedence
1653 pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc
1654 pprIfaceContext _ [] = text "()"
1655 pprIfaceContext prec [pred] = ppr_ty prec pred
1656 pprIfaceContext _ preds = ppr_parend_preds preds
1657
1658 ppr_parend_preds :: [IfacePredType] -> SDoc
1659 ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds)))
1660
1661 instance Binary IfaceType where
1662 put_ _ (IfaceFreeTyVar tv)
1663 = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv)
1664
1665 put_ bh (IfaceForAllTy aa ab) = do
1666 putByte bh 0
1667 put_ bh aa
1668 put_ bh ab
1669 put_ bh (IfaceTyVar ad) = do
1670 putByte bh 1
1671 put_ bh ad
1672 put_ bh (IfaceAppTy ae af) = do
1673 putByte bh 2
1674 put_ bh ae
1675 put_ bh af
1676 put_ bh (IfaceFunTy ag ah) = do
1677 putByte bh 3
1678 put_ bh ag
1679 put_ bh ah
1680 put_ bh (IfaceDFunTy ag ah) = do
1681 putByte bh 4
1682 put_ bh ag
1683 put_ bh ah
1684 put_ bh (IfaceTyConApp tc tys)
1685 = do { putByte bh 5; put_ bh tc; put_ bh tys }
1686 put_ bh (IfaceCastTy a b)
1687 = do { putByte bh 6; put_ bh a; put_ bh b }
1688 put_ bh (IfaceCoercionTy a)
1689 = do { putByte bh 7; put_ bh a }
1690 put_ bh (IfaceTupleTy s i tys)
1691 = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys }
1692 put_ bh (IfaceLitTy n)
1693 = do { putByte bh 9; put_ bh n }
1694
1695 get bh = do
1696 h <- getByte bh
1697 case h of
1698 0 -> do aa <- get bh
1699 ab <- get bh
1700 return (IfaceForAllTy aa ab)
1701 1 -> do ad <- get bh
1702 return (IfaceTyVar ad)
1703 2 -> do ae <- get bh
1704 af <- get bh
1705 return (IfaceAppTy ae af)
1706 3 -> do ag <- get bh
1707 ah <- get bh
1708 return (IfaceFunTy ag ah)
1709 4 -> do ag <- get bh
1710 ah <- get bh
1711 return (IfaceDFunTy ag ah)
1712 5 -> do { tc <- get bh; tys <- get bh
1713 ; return (IfaceTyConApp tc tys) }
1714 6 -> do { a <- get bh; b <- get bh
1715 ; return (IfaceCastTy a b) }
1716 7 -> do { a <- get bh
1717 ; return (IfaceCoercionTy a) }
1718
1719 8 -> do { s <- get bh; i <- get bh; tys <- get bh
1720 ; return (IfaceTupleTy s i tys) }
1721 _ -> do n <- get bh
1722 return (IfaceLitTy n)
1723
1724 instance Binary IfaceMCoercion where
1725 put_ bh IfaceMRefl = do
1726 putByte bh 1
1727 put_ bh (IfaceMCo co) = do
1728 putByte bh 2
1729 put_ bh co
1730
1731 get bh = do
1732 tag <- getByte bh
1733 case tag of
1734 1 -> return IfaceMRefl
1735 2 -> do a <- get bh
1736 return $ IfaceMCo a
1737 _ -> panic ("get IfaceMCoercion " ++ show tag)
1738
1739 instance Binary IfaceCoercion where
1740 put_ bh (IfaceReflCo a) = do
1741 putByte bh 1
1742 put_ bh a
1743 put_ bh (IfaceGReflCo a b c) = do
1744 putByte bh 2
1745 put_ bh a
1746 put_ bh b
1747 put_ bh c
1748 put_ bh (IfaceFunCo a b c) = do
1749 putByte bh 3
1750 put_ bh a
1751 put_ bh b
1752 put_ bh c
1753 put_ bh (IfaceTyConAppCo a b c) = do
1754 putByte bh 4
1755 put_ bh a
1756 put_ bh b
1757 put_ bh c
1758 put_ bh (IfaceAppCo a b) = do
1759 putByte bh 5
1760 put_ bh a
1761 put_ bh b
1762 put_ bh (IfaceForAllCo a b c) = do
1763 putByte bh 6
1764 put_ bh a
1765 put_ bh b
1766 put_ bh c
1767 put_ bh (IfaceCoVarCo a) = do
1768 putByte bh 7
1769 put_ bh a
1770 put_ bh (IfaceAxiomInstCo a b c) = do
1771 putByte bh 8
1772 put_ bh a
1773 put_ bh b
1774 put_ bh c
1775 put_ bh (IfaceUnivCo a b c d) = do
1776 putByte bh 9
1777 put_ bh a
1778 put_ bh b
1779 put_ bh c
1780 put_ bh d
1781 put_ bh (IfaceSymCo a) = do
1782 putByte bh 10
1783 put_ bh a
1784 put_ bh (IfaceTransCo a b) = do
1785 putByte bh 11
1786 put_ bh a
1787 put_ bh b
1788 put_ bh (IfaceNthCo a b) = do
1789 putByte bh 12
1790 put_ bh a
1791 put_ bh b
1792 put_ bh (IfaceLRCo a b) = do
1793 putByte bh 13
1794 put_ bh a
1795 put_ bh b
1796 put_ bh (IfaceInstCo a b) = do
1797 putByte bh 14
1798 put_ bh a
1799 put_ bh b
1800 put_ bh (IfaceKindCo a) = do
1801 putByte bh 15
1802 put_ bh a
1803 put_ bh (IfaceSubCo a) = do
1804 putByte bh 16
1805 put_ bh a
1806 put_ bh (IfaceAxiomRuleCo a b) = do
1807 putByte bh 17
1808 put_ bh a
1809 put_ bh b
1810 put_ _ (IfaceFreeCoVar cv)
1811 = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)
1812 put_ _ (IfaceHoleCo cv)
1813 = pprPanic "Can't serialise IfaceHoleCo" (ppr cv)
1814 -- See Note [Holes in IfaceCoercion]
1815
1816 get bh = do
1817 tag <- getByte bh
1818 case tag of
1819 1 -> do a <- get bh
1820 return $ IfaceReflCo a
1821 2 -> do a <- get bh
1822 b <- get bh
1823 c <- get bh
1824 return $ IfaceGReflCo a b c
1825 3 -> do a <- get bh
1826 b <- get bh
1827 c <- get bh
1828 return $ IfaceFunCo a b c
1829 4 -> do a <- get bh
1830 b <- get bh
1831 c <- get bh
1832 return $ IfaceTyConAppCo a b c
1833 5 -> do a <- get bh
1834 b <- get bh
1835 return $ IfaceAppCo a b
1836 6 -> do a <- get bh
1837 b <- get bh
1838 c <- get bh
1839 return $ IfaceForAllCo a b c
1840 7 -> do a <- get bh
1841 return $ IfaceCoVarCo a
1842 8 -> do a <- get bh
1843 b <- get bh
1844 c <- get bh
1845 return $ IfaceAxiomInstCo a b c
1846 9 -> do a <- get bh
1847 b <- get bh
1848 c <- get bh
1849 d <- get bh
1850 return $ IfaceUnivCo a b c d
1851 10-> do a <- get bh
1852 return $ IfaceSymCo a
1853 11-> do a <- get bh
1854 b <- get bh
1855 return $ IfaceTransCo a b
1856 12-> do a <- get bh
1857 b <- get bh
1858 return $ IfaceNthCo a b
1859 13-> do a <- get bh
1860 b <- get bh
1861 return $ IfaceLRCo a b
1862 14-> do a <- get bh
1863 b <- get bh
1864 return $ IfaceInstCo a b
1865 15-> do a <- get bh
1866 return $ IfaceKindCo a
1867 16-> do a <- get bh
1868 return $ IfaceSubCo a
1869 17-> do a <- get bh
1870 b <- get bh
1871 return $ IfaceAxiomRuleCo a b
1872 _ -> panic ("get IfaceCoercion " ++ show tag)
1873
1874 instance Binary IfaceUnivCoProv where
1875 put_ bh IfaceUnsafeCoerceProv = putByte bh 1
1876 put_ bh (IfacePhantomProv a) = do
1877 putByte bh 2
1878 put_ bh a
1879 put_ bh (IfaceProofIrrelProv a) = do
1880 putByte bh 3
1881 put_ bh a
1882 put_ bh (IfacePluginProv a) = do
1883 putByte bh 4
1884 put_ bh a
1885
1886 get bh = do
1887 tag <- getByte bh
1888 case tag of
1889 1 -> return $ IfaceUnsafeCoerceProv
1890 2 -> do a <- get bh
1891 return $ IfacePhantomProv a
1892 3 -> do a <- get bh
1893 return $ IfaceProofIrrelProv a
1894 4 -> do a <- get bh
1895 return $ IfacePluginProv a
1896 _ -> panic ("get IfaceUnivCoProv " ++ show tag)
1897
1898
1899 instance Binary (DefMethSpec IfaceType) where
1900 put_ bh VanillaDM = putByte bh 0
1901 put_ bh (GenericDM t) = putByte bh 1 >> put_ bh t
1902 get bh = do
1903 h <- getByte bh
1904 case h of
1905 0 -> return VanillaDM
1906 _ -> do { t <- get bh; return (GenericDM t) }