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