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