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