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