ebbc68755b756781a100bac19a2011e6440f42b8
[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 {-
826 Note [Defaulting RuntimeRep variables]
827 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
828
829 RuntimeRep variables are considered by many (most?) users to be little more than
830 syntactic noise. When the notion was introduced there was a signficant and
831 understandable push-back from those with pedagogy in mind, which argued that
832 RuntimeRep variables would throw a wrench into nearly any teach approach since
833 they appear in even the lowly ($) function's type,
834
835 ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b
836
837 which is significantly less readable than its non RuntimeRep-polymorphic type of
838
839 ($) :: (a -> b) -> a -> b
840
841 Moreover, unboxed types don't appear all that often in run-of-the-mill Haskell
842 programs, so it makes little sense to make all users pay this syntactic
843 overhead.
844
845 For this reason it was decided that we would hide RuntimeRep variables for now
846 (see #11549). We do this by defaulting all type variables of kind RuntimeRep to
847 LiftedRep. This is done in a pass right before pretty-printing
848 (defaultRuntimeRepVars, controlled by -fprint-explicit-runtime-reps)
849 -}
850
851 -- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g.
852 --
853 -- @
854 -- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
855 -- (a -> b) -> a -> b
856 -- @
857 --
858 -- turns in to,
859 --
860 -- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @
861 --
862 -- We do this to prevent RuntimeRep variables from incurring a significant
863 -- syntactic overhead in otherwise simple type signatures (e.g. ($)). See
864 -- Note [Defaulting RuntimeRep variables] and #11549 for further discussion.
865 --
866 defaultRuntimeRepVars :: PprStyle -> IfaceType -> IfaceType
867 defaultRuntimeRepVars sty = go emptyFsEnv
868 where
869 go :: FastStringEnv () -> IfaceType -> IfaceType
870 go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty)
871 | isRuntimeRep var_kind
872 , isInvisibleArgFlag argf -- don't default *visible* quantification
873 -- or we get the mess in #13963
874 = let subs' = extendFsEnv subs var ()
875 in go subs' ty
876
877 go subs (IfaceForAllTy bndr ty)
878 = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty)
879
880 go subs ty@(IfaceTyVar tv)
881 | tv `elemFsEnv` subs
882 = IfaceTyConApp liftedRep IA_Nil
883 | otherwise
884 = ty
885
886 go _ ty@(IfaceFreeTyVar tv)
887 | userStyle sty && TyCoRep.isRuntimeRepTy (tyVarKind tv)
888 -- don't require -fprint-explicit-runtime-reps for good debugging output
889 = IfaceTyConApp liftedRep IA_Nil
890 | otherwise
891 = ty
892
893 go subs (IfaceTyConApp tc tc_args)
894 = IfaceTyConApp tc (go_args subs tc_args)
895
896 go subs (IfaceTupleTy sort is_prom tc_args)
897 = IfaceTupleTy sort is_prom (go_args subs tc_args)
898
899 go subs (IfaceFunTy arg res)
900 = IfaceFunTy (go subs arg) (go subs res)
901
902 go subs (IfaceAppTy t ts)
903 = IfaceAppTy (go subs t) (go_args subs ts)
904
905 go subs (IfaceDFunTy x y)
906 = IfaceDFunTy (go subs x) (go subs y)
907
908 go subs (IfaceCastTy x co)
909 = IfaceCastTy (go subs x) co
910
911 go _ ty@(IfaceLitTy {}) = ty
912 go _ ty@(IfaceCoercionTy {}) = ty
913
914 go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
915 go_ifacebndr subs (Bndr (IfaceIdBndr (n, t)) argf)
916 = Bndr (IfaceIdBndr (n, go subs t)) argf
917 go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf)
918 = Bndr (IfaceTvBndr (n, go subs t)) argf
919
920 go_args :: FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
921 go_args _ IA_Nil = IA_Nil
922 go_args subs (IA_Arg ty argf args)
923 = IA_Arg (go subs ty) argf (go_args subs args)
924
925 liftedRep :: IfaceTyCon
926 liftedRep =
927 IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
928 where dc_name = getName liftedRepDataConTyCon
929
930 isRuntimeRep :: IfaceType -> Bool
931 isRuntimeRep (IfaceTyConApp tc _) =
932 tc `ifaceTyConHasKey` runtimeRepTyConKey
933 isRuntimeRep _ = False
934
935 eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
936 eliminateRuntimeRep f ty = sdocWithDynFlags $ \dflags ->
937 if gopt Opt_PrintExplicitRuntimeReps dflags
938 then f ty
939 else getPprStyle $ \sty -> f (defaultRuntimeRepVars sty ty)
940
941 instance Outputable IfaceAppArgs where
942 ppr tca = pprIfaceAppArgs tca
943
944 pprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
945 pprIfaceAppArgs = ppr_app_args topPrec
946 pprParendIfaceAppArgs = ppr_app_args appPrec
947
948 ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
949 ppr_app_args ctx_prec = go
950 where
951 go :: IfaceAppArgs -> SDoc
952 go IA_Nil = empty
953 go (IA_Arg t argf ts) = ppr_app_arg ctx_prec (t, argf) <+> go ts
954
955 -- See Note [Pretty-printing invisible arguments]
956 ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc
957 ppr_app_arg ctx_prec (t, argf) =
958 sdocWithDynFlags $ \dflags ->
959 let print_kinds = gopt Opt_PrintExplicitKinds dflags
960 in case argf of
961 Required -> ppr_ty ctx_prec t
962 Specified | print_kinds
963 -> char '@' <> ppr_ty appPrec t
964 Inferred | print_kinds
965 -> char '@' <> braces (ppr_ty topPrec t)
966 _ -> empty
967
968 -------------------
969 pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
970 pprIfaceForAllPart tvs ctxt sdoc
971 = ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc
972
973 -- | Like 'pprIfaceForAllPart', but always uses an explicit @forall@.
974 pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
975 pprIfaceForAllPartMust tvs ctxt sdoc
976 = ppr_iface_forall_part ShowForAllMust tvs ctxt sdoc
977
978 pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
979 pprIfaceForAllCoPart tvs sdoc
980 = sep [ pprIfaceForAllCo tvs, sdoc ]
981
982 ppr_iface_forall_part :: ShowForAllFlag
983 -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
984 ppr_iface_forall_part show_forall tvs ctxt sdoc
985 = sep [ case show_forall of
986 ShowForAllMust -> pprIfaceForAll tvs
987 ShowForAllWhen -> pprUserIfaceForAll tvs
988 , pprIfaceContextArr ctxt
989 , sdoc]
990
991 -- | Render the "forall ... ." or "forall ... ->" bit of a type.
992 pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
993 pprIfaceForAll [] = empty
994 pprIfaceForAll bndrs@(Bndr _ vis : _)
995 = sep [ add_separator (forAllLit <+> fsep docs)
996 , pprIfaceForAll bndrs' ]
997 where
998 (bndrs', docs) = ppr_itv_bndrs bndrs vis
999
1000 add_separator stuff = case vis of
1001 Required -> stuff <+> arrow
1002 _inv -> stuff <> dot
1003
1004
1005 -- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
1006 -- Returns both the list of not-yet-rendered binders and the doc.
1007 -- No anonymous binders here!
1008 ppr_itv_bndrs :: [IfaceForAllBndr]
1009 -> ArgFlag -- ^ visibility of the first binder in the list
1010 -> ([IfaceForAllBndr], [SDoc])
1011 ppr_itv_bndrs all_bndrs@(bndr@(Bndr _ vis) : bndrs) vis1
1012 | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
1013 (bndrs', pprIfaceForAllBndr bndr : doc)
1014 | otherwise = (all_bndrs, [])
1015 ppr_itv_bndrs [] _ = ([], [])
1016
1017 pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
1018 pprIfaceForAllCo [] = empty
1019 pprIfaceForAllCo tvs = text "forall" <+> pprIfaceForAllCoBndrs tvs <> dot
1020
1021 pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
1022 pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
1023
1024 pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
1025 pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) Inferred)
1026 = sdocWithDynFlags $ \dflags ->
1027 if gopt Opt_PrintExplicitForalls dflags
1028 then braces $ pprIfaceTvBndr False tv
1029 else pprIfaceTvBndr True tv
1030 pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) _) = pprIfaceTvBndr True tv
1031 pprIfaceForAllBndr (Bndr (IfaceIdBndr idv) _) = pprIfaceIdBndr idv
1032
1033 pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
1034 pprIfaceForAllCoBndr (tv, kind_co)
1035 = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)
1036
1037 -- | Show forall flag
1038 --
1039 -- Unconditionally show the forall quantifier with ('ShowForAllMust')
1040 -- or when ('ShowForAllWhen') the names used are free in the binder
1041 -- or when compiling with -fprint-explicit-foralls.
1042 data ShowForAllFlag = ShowForAllMust | ShowForAllWhen
1043
1044 pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
1045 pprIfaceSigmaType show_forall ty
1046 = eliminateRuntimeRep ppr_fn ty
1047 where
1048 ppr_fn iface_ty =
1049 let (tvs, theta, tau) = splitIfaceSigmaTy iface_ty
1050 in ppr_iface_forall_part show_forall tvs theta (ppr tau)
1051
1052 pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
1053 pprUserIfaceForAll tvs
1054 = sdocWithDynFlags $ \dflags ->
1055 -- See Note [When to print foralls]
1056 ppWhen (any tv_has_kind_var tvs
1057 || any tv_is_required tvs
1058 || gopt Opt_PrintExplicitForalls dflags) $
1059 pprIfaceForAll tvs
1060 where
1061 tv_has_kind_var (Bndr (IfaceTvBndr (_,kind)) _)
1062 = not (ifTypeIsVarFree kind)
1063 tv_has_kind_var _ = False
1064
1065 tv_is_required = isVisibleArgFlag . binderArgFlag
1066
1067 {-
1068 Note [When to print foralls]
1069 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1070 We opt to explicitly pretty-print `forall`s if any of the following
1071 criteria are met:
1072
1073 1. -fprint-explicit-foralls is on.
1074
1075 2. A bound type variable has a polymorphic kind. E.g.,
1076
1077 forall k (a::k). Proxy a -> Proxy a
1078
1079 Since a's kind mentions a variable k, we print the foralls.
1080
1081 3. A bound type variable is a visible argument (#14238).
1082 Suppose we are printing the kind of:
1083
1084 T :: forall k -> k -> Type
1085
1086 The "forall k ->" notation means that this kind argument is required.
1087 That is, it must be supplied at uses of T. E.g.,
1088
1089 f :: T (Type->Type) Monad -> Int
1090
1091 So we print an explicit "T :: forall k -> k -> Type",
1092 because omitting it and printing "T :: k -> Type" would be
1093 utterly misleading.
1094
1095 See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]
1096 in TyCoRep.
1097
1098 N.B. Until now (Aug 2018) we didn't check anything for coercion variables.
1099
1100 Note [Printing foralls in type family instances]
1101 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1102 We use the same criteria as in Note [When to print foralls] to determine
1103 whether a type family instance should be pretty-printed with an explicit
1104 `forall`. Example:
1105
1106 type family Foo (a :: k) :: k where
1107 Foo Maybe = []
1108 Foo (a :: Type) = Int
1109 Foo a = a
1110
1111 Without -fprint-explicit-foralls enabled, this will be pretty-printed as:
1112
1113 type family Foo (a :: k) :: k where
1114 Foo Maybe = []
1115 Foo a = Int
1116 forall k (a :: k). Foo a = a
1117
1118 Note that only the third equation has an explicit forall, since it has a type
1119 variable with a non-Type kind. (If -fprint-explicit-foralls were enabled, then
1120 the second equation would be preceded with `forall a.`.)
1121
1122 There is one tricky point in the implementation: what visibility
1123 do we give the type variables in a type family instance? Type family instances
1124 only store type *variables*, not type variable *binders*, and only the latter
1125 has visibility information. We opt to default the visibility of each of these
1126 type variables to Specified because users can't ever instantiate these
1127 variables manually, so the choice of visibility is only relevant to
1128 pretty-printing. (This is why the `k` in `forall k (a :: k). ...` above is
1129 printed the way it is, even though it wasn't written explicitly in the
1130 original source code.)
1131
1132 We adopt the same strategy for data family instances. Example:
1133
1134 data family DF (a :: k)
1135 data instance DF '[a, b] = DFList
1136
1137 That data family instance is pretty-printed as:
1138
1139 data instance forall j (a :: j) (b :: j). DF '[a, b] = DFList
1140
1141 This is despite that the representation tycon for this data instance (call it
1142 $DF:List) actually has different visibilities for its binders.
1143 However, the visibilities of these binders are utterly irrelevant to the
1144 programmer, who cares only about the specificity of variables in `DF`'s type,
1145 not $DF:List's type. Therefore, we opt to pretty-print all variables in data
1146 family instances as Specified.
1147
1148 Note [Printing promoted type constructors]
1149 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1150 Consider this GHCi session (Trac #14343)
1151 > _ :: Proxy '[ 'True ]
1152 error:
1153 Found hole: _ :: Proxy '['True]
1154
1155 This would be bad, because the '[' looks like a character literal.
1156 Solution: in type-level lists and tuples, add a leading space
1157 if the first type is itself promoted. See pprSpaceIfPromotedTyCon.
1158 -}
1159
1160
1161 -------------------
1162
1163 -- | Prefix a space if the given 'IfaceType' is a promoted 'TyCon'.
1164 -- See Note [Printing promoted type constructors]
1165 pprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc
1166 pprSpaceIfPromotedTyCon (IfaceTyConApp tyCon _)
1167 = case ifaceTyConIsPromoted (ifaceTyConInfo tyCon) of
1168 IsPromoted -> (space <>)
1169 _ -> id
1170 pprSpaceIfPromotedTyCon _
1171 = id
1172
1173 -- See equivalent function in TyCoRep.hs
1174 pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
1175 -- Given a type-level list (t1 ': t2), see if we can print
1176 -- it in list notation [t1, ...].
1177 -- Precondition: Opt_PrintExplicitKinds is off
1178 pprIfaceTyList ctxt_prec ty1 ty2
1179 = case gather ty2 of
1180 (arg_tys, Nothing)
1181 -> char '\'' <> brackets (pprSpaceIfPromotedTyCon ty1 (fsep
1182 (punctuate comma (map (ppr_ty topPrec) (ty1:arg_tys)))))
1183 (arg_tys, Just tl)
1184 -> maybeParen ctxt_prec funPrec $ hang (ppr_ty funPrec ty1)
1185 2 (fsep [ colon <+> ppr_ty funPrec ty | ty <- arg_tys ++ [tl]])
1186 where
1187 gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
1188 -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
1189 -- = (tys, Just tl) means ty is of form t1:t2:...tn:tl
1190 gather (IfaceTyConApp tc tys)
1191 | tc `ifaceTyConHasKey` consDataConKey
1192 , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys
1193 , isInvisibleArgFlag argf
1194 , (args, tl) <- gather ty2
1195 = (ty1:args, tl)
1196 | tc `ifaceTyConHasKey` nilDataConKey
1197 = ([], Nothing)
1198 gather ty = ([], Just ty)
1199
1200 pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
1201 pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args
1202
1203 pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
1204 pprTyTcApp ctxt_prec tc tys =
1205 sdocWithDynFlags $ \dflags ->
1206 getPprStyle $ \style ->
1207 pprTyTcApp' ctxt_prec tc tys dflags style
1208
1209 pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs
1210 -> DynFlags -> PprStyle -> SDoc
1211 pprTyTcApp' ctxt_prec tc tys dflags style
1212 | ifaceTyConName tc `hasKey` ipClassKey
1213 , IA_Arg (IfaceLitTy (IfaceStrTyLit n))
1214 Required (IA_Arg ty Required IA_Nil) <- tys
1215 = maybeParen ctxt_prec funPrec
1216 $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty
1217
1218 | IfaceTupleTyCon arity sort <- ifaceTyConSort info
1219 , not (debugStyle style)
1220 , arity == ifaceVisAppArgsLength tys
1221 = pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys
1222
1223 | IfaceSumTyCon arity <- ifaceTyConSort info
1224 = pprSum arity (ifaceTyConIsPromoted info) tys
1225
1226 | tc `ifaceTyConHasKey` consDataConKey
1227 , not (gopt Opt_PrintExplicitKinds dflags)
1228 , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys
1229 , isInvisibleArgFlag argf
1230 = pprIfaceTyList ctxt_prec ty1 ty2
1231
1232 | tc `ifaceTyConHasKey` tYPETyConKey
1233 , IA_Arg (IfaceTyConApp rep IA_Nil) Required IA_Nil <- tys
1234 , rep `ifaceTyConHasKey` liftedRepDataConKey
1235 = kindType
1236
1237 | otherwise
1238 = getPprDebug $ \dbg ->
1239 if | not dbg && tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey
1240 -- Suppress detail unles you _really_ want to see
1241 -> text "(TypeError ...)"
1242
1243 | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys)
1244 -> doc
1245
1246 | otherwise
1247 -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc tys_wo_kinds
1248 where
1249 info = ifaceTyConInfo tc
1250 tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags tys
1251
1252 -- | Pretty-print a type-level equality.
1253 -- Returns (Just doc) if the argument is a /saturated/ application
1254 -- of eqTyCon (~)
1255 -- eqPrimTyCon (~#)
1256 -- eqReprPrimTyCon (~R#)
1257 -- heqTyCon (~~)
1258 --
1259 -- See Note [Equality predicates in IfaceType]
1260 -- and Note [The equality types story] in TysPrim
1261 ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
1262 ppr_equality ctxt_prec tc args
1263 | hetero_eq_tc
1264 , [k1, k2, t1, t2] <- args
1265 = Just $ print_equality (k1, k2, t1, t2)
1266
1267 | hom_eq_tc
1268 , [k, t1, t2] <- args
1269 = Just $ print_equality (k, k, t1, t2)
1270
1271 | otherwise
1272 = Nothing
1273 where
1274 homogeneous = tc_name `hasKey` eqTyConKey -- (~)
1275 || hetero_tc_used_homogeneously
1276 where
1277 hetero_tc_used_homogeneously
1278 = case ifaceTyConSort $ ifaceTyConInfo tc of
1279 IfaceEqualityTyCon -> True
1280 _other -> False
1281 -- True <=> a heterogeneous equality whose arguments
1282 -- are (in this case) of the same kind
1283
1284 tc_name = ifaceTyConName tc
1285 pp = ppr_ty
1286 hom_eq_tc = tc_name `hasKey` eqTyConKey -- (~)
1287 hetero_eq_tc = tc_name `hasKey` eqPrimTyConKey -- (~#)
1288 || tc_name `hasKey` eqReprPrimTyConKey -- (~R#)
1289 || tc_name `hasKey` heqTyConKey -- (~~)
1290 nominal_eq_tc = tc_name `hasKey` heqTyConKey -- (~~)
1291 || tc_name `hasKey` eqPrimTyConKey -- (~#)
1292 print_equality args =
1293 sdocWithDynFlags $ \dflags ->
1294 getPprStyle $ \style ->
1295 print_equality' args style dflags
1296
1297 print_equality' (ki1, ki2, ty1, ty2) style dflags
1298 | -- If -fprint-equality-relations is on, just print the original TyCon
1299 print_eqs
1300 = ppr_infix_eq (ppr tc)
1301
1302 | -- Homogeneous use of heterogeneous equality (ty1 ~~ ty2)
1303 -- or unlifted equality (ty1 ~# ty2)
1304 nominal_eq_tc, homogeneous
1305 = ppr_infix_eq (text "~")
1306
1307 | -- Heterogeneous use of unlifted equality (ty1 ~# ty2)
1308 not homogeneous
1309 = ppr_infix_eq (ppr heqTyCon)
1310
1311 | -- Homogeneous use of representational unlifted equality (ty1 ~R# ty2)
1312 tc_name `hasKey` eqReprPrimTyConKey, homogeneous
1313 = let ki | print_kinds = [pp appPrec ki1]
1314 | otherwise = []
1315 in pprIfacePrefixApp ctxt_prec (ppr coercibleTyCon)
1316 (ki ++ [pp appPrec ty1, pp appPrec ty2])
1317
1318 -- The other cases work as you'd expect
1319 | otherwise
1320 = ppr_infix_eq (ppr tc)
1321 where
1322 ppr_infix_eq :: SDoc -> SDoc
1323 ppr_infix_eq eq_op = pprIfaceInfixApp ctxt_prec eq_op
1324 (pp_ty_ki ty1 ki1) (pp_ty_ki ty2 ki2)
1325 where
1326 pp_ty_ki ty ki
1327 | print_kinds
1328 = parens (pp topPrec ty <+> dcolon <+> pp opPrec ki)
1329 | otherwise
1330 = pp opPrec ty
1331
1332 print_kinds = gopt Opt_PrintExplicitKinds dflags
1333 print_eqs = gopt Opt_PrintEqualityRelations dflags ||
1334 dumpStyle style || debugStyle style
1335
1336
1337 pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
1338 pprIfaceCoTcApp ctxt_prec tc tys =
1339 ppr_iface_tc_app (\prec (co, _) -> ppr_co prec co) ctxt_prec tc
1340 (map (, Required) tys)
1341 -- We are trying to re-use ppr_iface_tc_app here, which requires its
1342 -- arguments to be accompanied by visibilities. But visibility is
1343 -- irrelevant when printing coercions, so just default everything to
1344 -- Required.
1345
1346 -- | Pretty-prints an application of a type constructor to some arguments
1347 -- (whose visibilities are known). This is polymorphic (over @a@) since we use
1348 -- this function to pretty-print two different things:
1349 --
1350 -- 1. Types (from `pprTyTcApp'`)
1351 --
1352 -- 2. Coercions (from 'pprIfaceCoTcApp')
1353 ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
1354 -> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
1355 ppr_iface_tc_app pp _ tc [ty]
1356 | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty)
1357
1358 ppr_iface_tc_app pp ctxt_prec tc tys
1359 | tc `ifaceTyConHasKey` liftedTypeKindTyConKey
1360 = kindType
1361
1362 | not (isSymOcc (nameOccName (ifaceTyConName tc)))
1363 = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
1364
1365 | [ ty1@(_, Required)
1366 , ty2@(_, Required) ] <- tys
1367 -- Infix, two visible arguments (we know nothing of precedence though).
1368 -- Don't apply this special case if one of the arguments is invisible,
1369 -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
1370 = pprIfaceInfixApp ctxt_prec (ppr tc)
1371 (pp opPrec ty1) (pp opPrec ty2)
1372
1373 | otherwise
1374 = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)
1375
1376 pprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc
1377 pprSum _arity is_promoted args
1378 = -- drop the RuntimeRep vars.
1379 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
1380 let tys = appArgsIfaceTypes args
1381 args' = drop (length tys `div` 2) tys
1382 in pprPromotionQuoteI is_promoted
1383 <> sumParens (pprWithBars (ppr_ty topPrec) args')
1384
1385 pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
1386 pprTuple ctxt_prec ConstraintTuple NotPromoted IA_Nil
1387 = maybeParen ctxt_prec appPrec $
1388 text "() :: Constraint"
1389
1390 -- All promoted constructors have kind arguments
1391 pprTuple _ sort IsPromoted args
1392 = let tys = appArgsIfaceTypes args
1393 args' = drop (length tys `div` 2) tys
1394 spaceIfPromoted = case args' of
1395 arg0:_ -> pprSpaceIfPromotedTyCon arg0
1396 _ -> id
1397 in pprPromotionQuoteI IsPromoted <>
1398 tupleParens sort (spaceIfPromoted (pprWithCommas pprIfaceType args'))
1399
1400 pprTuple _ sort promoted args
1401 = -- drop the RuntimeRep vars.
1402 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
1403 let tys = appArgsIfaceTypes args
1404 args' = case sort of
1405 UnboxedTuple -> drop (length tys `div` 2) tys
1406 _ -> tys
1407 in
1408 pprPromotionQuoteI promoted <>
1409 tupleParens sort (pprWithCommas pprIfaceType args')
1410
1411 pprIfaceTyLit :: IfaceTyLit -> SDoc
1412 pprIfaceTyLit (IfaceNumTyLit n) = integer n
1413 pprIfaceTyLit (IfaceStrTyLit n) = text (show n)
1414
1415 pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
1416 pprIfaceCoercion = ppr_co topPrec
1417 pprParendIfaceCoercion = ppr_co appPrec
1418
1419 ppr_co :: PprPrec -> IfaceCoercion -> SDoc
1420 ppr_co _ (IfaceReflCo ty) = angleBrackets (ppr ty) <> ppr_role Nominal
1421 ppr_co _ (IfaceGReflCo r ty IfaceMRefl)
1422 = angleBrackets (ppr ty) <> ppr_role r
1423 ppr_co ctxt_prec (IfaceGReflCo r ty (IfaceMCo co))
1424 = ppr_special_co ctxt_prec
1425 (text "GRefl" <+> ppr r <+> pprParendIfaceType ty) [co]
1426 ppr_co ctxt_prec (IfaceFunCo r co1 co2)
1427 = maybeParen ctxt_prec funPrec $
1428 sep (ppr_co funPrec co1 : ppr_fun_tail co2)
1429 where
1430 ppr_fun_tail (IfaceFunCo r co1 co2)
1431 = (arrow <> ppr_role r <+> ppr_co funPrec co1) : ppr_fun_tail co2
1432 ppr_fun_tail other_co
1433 = [arrow <> ppr_role r <+> pprIfaceCoercion other_co]
1434
1435 ppr_co _ (IfaceTyConAppCo r tc cos)
1436 = parens (pprIfaceCoTcApp topPrec tc cos) <> ppr_role r
1437 ppr_co ctxt_prec (IfaceAppCo co1 co2)
1438 = maybeParen ctxt_prec appPrec $
1439 ppr_co funPrec co1 <+> pprParendIfaceCoercion co2
1440 ppr_co ctxt_prec co@(IfaceForAllCo {})
1441 = maybeParen ctxt_prec funPrec $
1442 pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co)
1443 where
1444 (tvs, inner_co) = split_co co
1445
1446 split_co (IfaceForAllCo (IfaceTvBndr (name, _)) kind_co co')
1447 = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
1448 split_co (IfaceForAllCo (IfaceIdBndr (name, _)) kind_co co')
1449 = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
1450 split_co co' = ([], co')
1451
1452 -- Why these three? See Note [TcTyVars in IfaceType]
1453 ppr_co _ (IfaceFreeCoVar covar) = ppr covar
1454 ppr_co _ (IfaceCoVarCo covar) = ppr covar
1455 ppr_co _ (IfaceHoleCo covar) = braces (ppr covar)
1456
1457 ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)
1458 = maybeParen ctxt_prec appPrec $
1459 text "UnsafeCo" <+> ppr r <+>
1460 pprParendIfaceType ty1 <+> pprParendIfaceType ty2
1461
1462 ppr_co _ (IfaceUnivCo prov role ty1 ty2)
1463 = text "Univ" <> (parens $
1464 sep [ ppr role <+> pprIfaceUnivCoProv prov
1465 , dcolon <+> ppr ty1 <> comma <+> ppr ty2 ])
1466
1467 ppr_co ctxt_prec (IfaceInstCo co ty)
1468 = maybeParen ctxt_prec appPrec $
1469 text "Inst" <+> pprParendIfaceCoercion co
1470 <+> pprParendIfaceCoercion ty
1471
1472 ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos)
1473 = maybeParen ctxt_prec appPrec $ ppr tc <+> parens (interpp'SP cos)
1474
1475 ppr_co ctxt_prec (IfaceAxiomInstCo n i cos)
1476 = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos
1477 ppr_co ctxt_prec (IfaceSymCo co)
1478 = ppr_special_co ctxt_prec (text "Sym") [co]
1479 ppr_co ctxt_prec (IfaceTransCo co1 co2)
1480 = maybeParen ctxt_prec opPrec $
1481 ppr_co opPrec co1 <+> semi <+> ppr_co opPrec co2
1482 ppr_co ctxt_prec (IfaceNthCo d co)
1483 = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co]
1484 ppr_co ctxt_prec (IfaceLRCo lr co)
1485 = ppr_special_co ctxt_prec (ppr lr) [co]
1486 ppr_co ctxt_prec (IfaceSubCo co)
1487 = ppr_special_co ctxt_prec (text "Sub") [co]
1488 ppr_co ctxt_prec (IfaceKindCo co)
1489 = ppr_special_co ctxt_prec (text "Kind") [co]
1490
1491 ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
1492 ppr_special_co ctxt_prec doc cos
1493 = maybeParen ctxt_prec appPrec
1494 (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))])
1495
1496 ppr_role :: Role -> SDoc
1497 ppr_role r = underscore <> pp_role
1498 where pp_role = case r of
1499 Nominal -> char 'N'
1500 Representational -> char 'R'
1501 Phantom -> char 'P'
1502
1503 ------------------
1504 pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
1505 pprIfaceUnivCoProv IfaceUnsafeCoerceProv
1506 = text "unsafe"
1507 pprIfaceUnivCoProv (IfacePhantomProv co)
1508 = text "phantom" <+> pprParendIfaceCoercion co
1509 pprIfaceUnivCoProv (IfaceProofIrrelProv co)
1510 = text "irrel" <+> pprParendIfaceCoercion co
1511 pprIfaceUnivCoProv (IfacePluginProv s)
1512 = text "plugin" <+> doubleQuotes (text s)
1513
1514 -------------------
1515 instance Outputable IfaceTyCon where
1516 ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
1517
1518 pprPromotionQuote :: IfaceTyCon -> SDoc
1519 pprPromotionQuote tc =
1520 pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc
1521
1522 pprPromotionQuoteI :: PromotionFlag -> SDoc
1523 pprPromotionQuoteI NotPromoted = empty
1524 pprPromotionQuoteI IsPromoted = char '\''
1525
1526 instance Outputable IfaceCoercion where
1527 ppr = pprIfaceCoercion
1528
1529 instance Binary IfaceTyCon where
1530 put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i
1531
1532 get bh = do n <- get bh
1533 i <- get bh
1534 return (IfaceTyCon n i)
1535
1536 instance Binary IfaceTyConSort where
1537 put_ bh IfaceNormalTyCon = putByte bh 0
1538 put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort
1539 put_ bh (IfaceSumTyCon arity) = putByte bh 2 >> put_ bh arity
1540 put_ bh IfaceEqualityTyCon = putByte bh 3
1541
1542 get bh = do
1543 n <- getByte bh
1544 case n of
1545 0 -> return IfaceNormalTyCon
1546 1 -> IfaceTupleTyCon <$> get bh <*> get bh
1547 2 -> IfaceSumTyCon <$> get bh
1548 _ -> return IfaceEqualityTyCon
1549
1550 instance Binary IfaceTyConInfo where
1551 put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s
1552
1553 get bh = IfaceTyConInfo <$> get bh <*> get bh
1554
1555 instance Outputable IfaceTyLit where
1556 ppr = pprIfaceTyLit
1557
1558 instance Binary IfaceTyLit where
1559 put_ bh (IfaceNumTyLit n) = putByte bh 1 >> put_ bh n
1560 put_ bh (IfaceStrTyLit n) = putByte bh 2 >> put_ bh n
1561
1562 get bh =
1563 do tag <- getByte bh
1564 case tag of
1565 1 -> do { n <- get bh
1566 ; return (IfaceNumTyLit n) }
1567 2 -> do { n <- get bh
1568 ; return (IfaceStrTyLit n) }
1569 _ -> panic ("get IfaceTyLit " ++ show tag)
1570
1571 instance Binary IfaceAppArgs where
1572 put_ bh tk =
1573 case tk of
1574 IA_Arg t a ts -> putByte bh 0 >> put_ bh t >> put_ bh a >> put_ bh ts
1575 IA_Nil -> putByte bh 1
1576
1577 get bh =
1578 do c <- getByte bh
1579 case c of
1580 0 -> do
1581 t <- get bh
1582 a <- get bh
1583 ts <- get bh
1584 return $! IA_Arg t a ts
1585 1 -> return IA_Nil
1586 _ -> panic ("get IfaceAppArgs " ++ show c)
1587
1588 -------------------
1589
1590 -- Some notes about printing contexts
1591 --
1592 -- In the event that we are printing a singleton context (e.g. @Eq a@) we can
1593 -- omit parentheses. However, we must take care to set the precedence correctly
1594 -- to opPrec, since something like @a :~: b@ must be parenthesized (see
1595 -- #9658).
1596 --
1597 -- When printing a larger context we use 'fsep' instead of 'sep' so that
1598 -- the context doesn't get displayed as a giant column. Rather than,
1599 -- instance (Eq a,
1600 -- Eq b,
1601 -- Eq c,
1602 -- Eq d,
1603 -- Eq e,
1604 -- Eq f,
1605 -- Eq g,
1606 -- Eq h,
1607 -- Eq i,
1608 -- Eq j,
1609 -- Eq k,
1610 -- Eq l) =>
1611 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
1612 --
1613 -- we want
1614 --
1615 -- instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
1616 -- Eq j, Eq k, Eq l) =>
1617 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
1618
1619
1620
1621 -- | Prints "(C a, D b) =>", including the arrow.
1622 -- Used when we want to print a context in a type, so we
1623 -- use 'funPrec' to decide whether to parenthesise a singleton
1624 -- predicate; e.g. Num a => a -> a
1625 pprIfaceContextArr :: [IfacePredType] -> SDoc
1626 pprIfaceContextArr [] = empty
1627 pprIfaceContextArr [pred] = ppr_ty funPrec pred <+> darrow
1628 pprIfaceContextArr preds = ppr_parend_preds preds <+> darrow
1629
1630 -- | Prints a context or @()@ if empty
1631 -- You give it the context precedence
1632 pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc
1633 pprIfaceContext _ [] = text "()"
1634 pprIfaceContext prec [pred] = ppr_ty prec pred
1635 pprIfaceContext _ preds = ppr_parend_preds preds
1636
1637 ppr_parend_preds :: [IfacePredType] -> SDoc
1638 ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds)))
1639
1640 instance Binary IfaceType where
1641 put_ _ (IfaceFreeTyVar tv)
1642 = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv)
1643
1644 put_ bh (IfaceForAllTy aa ab) = do
1645 putByte bh 0
1646 put_ bh aa
1647 put_ bh ab
1648 put_ bh (IfaceTyVar ad) = do
1649 putByte bh 1
1650 put_ bh ad
1651 put_ bh (IfaceAppTy ae af) = do
1652 putByte bh 2
1653 put_ bh ae
1654 put_ bh af
1655 put_ bh (IfaceFunTy ag ah) = do
1656 putByte bh 3
1657 put_ bh ag
1658 put_ bh ah
1659 put_ bh (IfaceDFunTy ag ah) = do
1660 putByte bh 4
1661 put_ bh ag
1662 put_ bh ah
1663 put_ bh (IfaceTyConApp tc tys)
1664 = do { putByte bh 5; put_ bh tc; put_ bh tys }
1665 put_ bh (IfaceCastTy a b)
1666 = do { putByte bh 6; put_ bh a; put_ bh b }
1667 put_ bh (IfaceCoercionTy a)
1668 = do { putByte bh 7; put_ bh a }
1669 put_ bh (IfaceTupleTy s i tys)
1670 = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys }
1671 put_ bh (IfaceLitTy n)
1672 = do { putByte bh 9; put_ bh n }
1673
1674 get bh = do
1675 h <- getByte bh
1676 case h of
1677 0 -> do aa <- get bh
1678 ab <- get bh
1679 return (IfaceForAllTy aa ab)
1680 1 -> do ad <- get bh
1681 return (IfaceTyVar ad)
1682 2 -> do ae <- get bh
1683 af <- get bh
1684 return (IfaceAppTy ae af)
1685 3 -> do ag <- get bh
1686 ah <- get bh
1687 return (IfaceFunTy ag ah)
1688 4 -> do ag <- get bh
1689 ah <- get bh
1690 return (IfaceDFunTy ag ah)
1691 5 -> do { tc <- get bh; tys <- get bh
1692 ; return (IfaceTyConApp tc tys) }
1693 6 -> do { a <- get bh; b <- get bh
1694 ; return (IfaceCastTy a b) }
1695 7 -> do { a <- get bh
1696 ; return (IfaceCoercionTy a) }
1697
1698 8 -> do { s <- get bh; i <- get bh; tys <- get bh
1699 ; return (IfaceTupleTy s i tys) }
1700 _ -> do n <- get bh
1701 return (IfaceLitTy n)
1702
1703 instance Binary IfaceMCoercion where
1704 put_ bh IfaceMRefl = do
1705 putByte bh 1
1706 put_ bh (IfaceMCo co) = do
1707 putByte bh 2
1708 put_ bh co
1709
1710 get bh = do
1711 tag <- getByte bh
1712 case tag of
1713 1 -> return IfaceMRefl
1714 2 -> do a <- get bh
1715 return $ IfaceMCo a
1716 _ -> panic ("get IfaceMCoercion " ++ show tag)
1717
1718 instance Binary IfaceCoercion where
1719 put_ bh (IfaceReflCo a) = do
1720 putByte bh 1
1721 put_ bh a
1722 put_ bh (IfaceGReflCo a b c) = do
1723 putByte bh 2
1724 put_ bh a
1725 put_ bh b
1726 put_ bh c
1727 put_ bh (IfaceFunCo a b c) = do
1728 putByte bh 3
1729 put_ bh a
1730 put_ bh b
1731 put_ bh c
1732 put_ bh (IfaceTyConAppCo a b c) = do
1733 putByte bh 4
1734 put_ bh a
1735 put_ bh b
1736 put_ bh c
1737 put_ bh (IfaceAppCo a b) = do
1738 putByte bh 5
1739 put_ bh a
1740 put_ bh b
1741 put_ bh (IfaceForAllCo a b c) = do
1742 putByte bh 6
1743 put_ bh a
1744 put_ bh b
1745 put_ bh c
1746 put_ bh (IfaceCoVarCo a) = do
1747 putByte bh 7
1748 put_ bh a
1749 put_ bh (IfaceAxiomInstCo a b c) = do
1750 putByte bh 8
1751 put_ bh a
1752 put_ bh b
1753 put_ bh c
1754 put_ bh (IfaceUnivCo a b c d) = do
1755 putByte bh 9
1756 put_ bh a
1757 put_ bh b
1758 put_ bh c
1759 put_ bh d
1760 put_ bh (IfaceSymCo a) = do
1761 putByte bh 10
1762 put_ bh a
1763 put_ bh (IfaceTransCo a b) = do
1764 putByte bh 11
1765 put_ bh a
1766 put_ bh b
1767 put_ bh (IfaceNthCo a b) = do
1768 putByte bh 12
1769 put_ bh a
1770 put_ bh b
1771 put_ bh (IfaceLRCo a b) = do
1772 putByte bh 13
1773 put_ bh a
1774 put_ bh b
1775 put_ bh (IfaceInstCo a b) = do
1776 putByte bh 14
1777 put_ bh a
1778 put_ bh b
1779 put_ bh (IfaceKindCo a) = do
1780 putByte bh 15
1781 put_ bh a
1782 put_ bh (IfaceSubCo a) = do
1783 putByte bh 16
1784 put_ bh a
1785 put_ bh (IfaceAxiomRuleCo a b) = do
1786 putByte bh 17
1787 put_ bh a
1788 put_ bh b
1789 put_ _ (IfaceFreeCoVar cv)
1790 = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)
1791 put_ _ (IfaceHoleCo cv)
1792 = pprPanic "Can't serialise IfaceHoleCo" (ppr cv)
1793 -- See Note [Holes in IfaceCoercion]
1794
1795 get bh = do
1796 tag <- getByte bh
1797 case tag of
1798 1 -> do a <- get bh
1799 return $ IfaceReflCo a
1800 2 -> do a <- get bh
1801 b <- get bh
1802 c <- get bh
1803 return $ IfaceGReflCo a b c
1804 3 -> do a <- get bh
1805 b <- get bh
1806 c <- get bh
1807 return $ IfaceFunCo a b c
1808 4 -> do a <- get bh
1809 b <- get bh
1810 c <- get bh
1811 return $ IfaceTyConAppCo a b c
1812 5 -> do a <- get bh
1813 b <- get bh
1814 return $ IfaceAppCo a b
1815 6 -> do a <- get bh
1816 b <- get bh
1817 c <- get bh
1818 return $ IfaceForAllCo a b c
1819 7 -> do a <- get bh
1820 return $ IfaceCoVarCo a
1821 8 -> do a <- get bh
1822 b <- get bh
1823 c <- get bh
1824 return $ IfaceAxiomInstCo a b c
1825 9 -> do a <- get bh
1826 b <- get bh
1827 c <- get bh
1828 d <- get bh
1829 return $ IfaceUnivCo a b c d
1830 10-> do a <- get bh
1831 return $ IfaceSymCo a
1832 11-> do a <- get bh
1833 b <- get bh
1834 return $ IfaceTransCo a b
1835 12-> do a <- get bh
1836 b <- get bh
1837 return $ IfaceNthCo a b
1838 13-> do a <- get bh
1839 b <- get bh
1840 return $ IfaceLRCo a b
1841 14-> do a <- get bh
1842 b <- get bh
1843 return $ IfaceInstCo a b
1844 15-> do a <- get bh
1845 return $ IfaceKindCo a
1846 16-> do a <- get bh
1847 return $ IfaceSubCo a
1848 17-> do a <- get bh
1849 b <- get bh
1850 return $ IfaceAxiomRuleCo a b
1851 _ -> panic ("get IfaceCoercion " ++ show tag)
1852
1853 instance Binary IfaceUnivCoProv where
1854 put_ bh IfaceUnsafeCoerceProv = putByte bh 1
1855 put_ bh (IfacePhantomProv a) = do
1856 putByte bh 2
1857 put_ bh a
1858 put_ bh (IfaceProofIrrelProv a) = do
1859 putByte bh 3
1860 put_ bh a
1861 put_ bh (IfacePluginProv a) = do
1862 putByte bh 4
1863 put_ bh a
1864
1865 get bh = do
1866 tag <- getByte bh
1867 case tag of
1868 1 -> return $ IfaceUnsafeCoerceProv
1869 2 -> do a <- get bh
1870 return $ IfacePhantomProv a
1871 3 -> do a <- get bh
1872 return $ IfaceProofIrrelProv a
1873 4 -> do a <- get bh
1874 return $ IfacePluginProv a
1875 _ -> panic ("get IfaceUnivCoProv " ++ show tag)
1876
1877
1878 instance Binary (DefMethSpec IfaceType) where
1879 put_ bh VanillaDM = putByte bh 0
1880 put_ bh (GenericDM t) = putByte bh 1 >> put_ bh t
1881 get bh = do
1882 h <- getByte bh
1883 case h of
1884 0 -> return VanillaDM
1885 _ -> do { t <- get bh; return (GenericDM t) }