574e15367e4940d4c560d79278d614319a135611
[ghc.git] / compiler / types / TypeRep.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1998
4
5 \section[TypeRep]{Type - friends' interface}
6
7 Note [The Type-related module hierarchy]
8 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
9 Class
10 TyCon imports Class
11 TypeRep
12 TysPrim imports TypeRep ( including mkTyConTy )
13 Kind imports TysPrim ( mainly for primitive kinds )
14 Type imports Kind
15 Coercion imports Type
16 -}
17
18 {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable,
19 DeriveTraversable #-}
20 {-# OPTIONS_HADDOCK hide #-}
21 -- We expose the relevant stuff from this module via the Type module
22
23 module TypeRep (
24 TyThing(..),
25 Type(..),
26 TyLit(..),
27 KindOrType, Kind, SuperKind,
28 PredType, ThetaType, -- Synonyms
29
30 -- Functions over types
31 mkTyConTy, mkTyVarTy, mkTyVarTys,
32 isLiftedTypeKind, isSuperKind, isTypeVar, isKindVar,
33
34 -- Pretty-printing
35 pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs,
36 pprTyThing, pprTyThingCategory, pprSigmaType,
37 pprTheta, pprForAll, pprUserForAll,
38 pprThetaArrowTy, pprClassPred,
39 pprKind, pprParendKind, pprTyLit, suppressKinds,
40 TyPrec(..), maybeParen, pprTcApp,
41 pprPrefixApp, pprArrowChain, ppr_type,
42 pprDataCons,
43
44 -- Free variables
45 tyVarsOfType, tyVarsOfTypes, closeOverKinds, varSetElemsKvsFirst,
46
47 -- * Tidying type related things up for printing
48 tidyType, tidyTypes,
49 tidyOpenType, tidyOpenTypes,
50 tidyOpenKind,
51 tidyTyVarBndr, tidyTyVarBndrs, tidyFreeTyVars,
52 tidyOpenTyVar, tidyOpenTyVars,
53 tidyTyVarOcc,
54 tidyTopType,
55 tidyKind,
56
57 -- Substitutions
58 TvSubst(..), TvSubstEnv
59 ) where
60
61 #include "HsVersions.h"
62
63 import {-# SOURCE #-} DataCon( DataCon, dataConTyCon, dataConFullSig )
64 import {-# SOURCE #-} ConLike ( ConLike(..) )
65 import {-# SOURCE #-} Type( isPredTy ) -- Transitively pulls in a LOT of stuff, better to break the loop
66
67 -- friends:
68 import Var
69 import VarEnv
70 import VarSet
71 import Name
72 import BasicTypes
73 import TyCon
74 import Class
75 import CoAxiom
76
77 -- others
78 import PrelNames
79 import Outputable
80 import FastString
81 import ListSetOps
82 import Util
83 import DynFlags
84 import StaticFlags( opt_PprStyle_Debug )
85
86 -- libraries
87 import Data.List( mapAccumL, partition )
88 import qualified Data.Data as Data hiding ( TyCon )
89
90 {-
91 ************************************************************************
92 * *
93 \subsection{The data type}
94 * *
95 ************************************************************************
96 -}
97
98 -- | The key representation of types within the compiler
99
100 -- If you edit this type, you may need to update the GHC formalism
101 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
102 data Type
103 = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable)
104
105 | AppTy -- See Note [AppTy rep]
106 Type
107 Type -- ^ Type application to something other than a 'TyCon'. Parameters:
108 --
109 -- 1) Function: must /not/ be a 'TyConApp',
110 -- must be another 'AppTy', or 'TyVarTy'
111 --
112 -- 2) Argument type
113
114 | TyConApp -- See Note [AppTy rep]
115 TyCon
116 [KindOrType] -- ^ Application of a 'TyCon', including newtypes /and/ synonyms.
117 -- Invariant: saturated applications of 'FunTyCon' must
118 -- use 'FunTy' and saturated synonyms must use their own
119 -- constructors. However, /unsaturated/ 'FunTyCon's
120 -- do appear as 'TyConApp's.
121 -- Parameters:
122 --
123 -- 1) Type constructor being applied to.
124 --
125 -- 2) Type arguments. Might not have enough type arguments
126 -- here to saturate the constructor.
127 -- Even type synonyms are not necessarily saturated;
128 -- for example unsaturated type synonyms
129 -- can appear as the right hand side of a type synonym.
130
131 | FunTy
132 Type
133 Type -- ^ Special case of 'TyConApp': @TyConApp FunTyCon [t1, t2]@
134 -- See Note [Equality-constrained types]
135
136 | ForAllTy
137 Var -- Type or kind variable
138 Type -- ^ A polymorphic type
139
140 | LitTy TyLit -- ^ Type literals are similar to type constructors.
141
142 deriving (Data.Data, Data.Typeable)
143
144
145 -- NOTE: Other parts of the code assume that type literals do not contain
146 -- types or type variables.
147 data TyLit
148 = NumTyLit Integer
149 | StrTyLit FastString
150 deriving (Eq, Ord, Data.Data, Data.Typeable)
151
152 type KindOrType = Type -- See Note [Arguments to type constructors]
153
154 -- | The key type representing kinds in the compiler.
155 -- Invariant: a kind is always in one of these forms:
156 --
157 -- > FunTy k1 k2
158 -- > TyConApp PrimTyCon [...]
159 -- > TyVar kv -- (during inference only)
160 -- > ForAll ... -- (for top-level coercions)
161 type Kind = Type
162
163 -- | "Super kinds", used to help encode 'Kind's as types.
164 -- Invariant: a super kind is always of this form:
165 --
166 -- > TyConApp SuperKindTyCon ...
167 type SuperKind = Type
168
169 {-
170 Note [The kind invariant]
171 ~~~~~~~~~~~~~~~~~~~~~~~~~
172 The kinds
173 # UnliftedTypeKind
174 OpenKind super-kind of *, #
175
176 can never appear under an arrow or type constructor in a kind; they
177 can only be at the top level of a kind. It follows that primitive TyCons,
178 which have a naughty pseudo-kind
179 State# :: * -> #
180 must always be saturated, so that we can never get a type whose kind
181 has a UnliftedTypeKind or ArgTypeKind underneath an arrow.
182
183 Nor can we abstract over a type variable with any of these kinds.
184
185 k :: = kk | # | ArgKind | (#) | OpenKind
186 kk :: = * | kk -> kk | T kk1 ... kkn
187
188 So a type variable can only be abstracted kk.
189
190 Note [Arguments to type constructors]
191 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
192 Because of kind polymorphism, in addition to type application we now
193 have kind instantiation. We reuse the same notations to do so.
194
195 For example:
196
197 Just (* -> *) Maybe
198 Right * Nat Zero
199
200 are represented by:
201
202 TyConApp (PromotedDataCon Just) [* -> *, Maybe]
203 TyConApp (PromotedDataCon Right) [*, Nat, (PromotedDataCon Zero)]
204
205 Important note: Nat is used as a *kind* and not as a type. This can be
206 confusing, since type-level Nat and kind-level Nat are identical. We
207 use the kind of (PromotedDataCon Right) to know if its arguments are
208 kinds or types.
209
210 This kind instantiation only happens in TyConApp currently.
211
212
213 Note [Equality-constrained types]
214 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
215 The type forall ab. (a ~ [b]) => blah
216 is encoded like this:
217
218 ForAllTy (a:*) $ ForAllTy (b:*) $
219 FunTy (TyConApp (~) [a, [b]]) $
220 blah
221
222 -------------------------------------
223 Note [PredTy]
224 -}
225
226 -- | A type of the form @p@ of kind @Constraint@ represents a value whose type is
227 -- the Haskell predicate @p@, where a predicate is what occurs before
228 -- the @=>@ in a Haskell type.
229 --
230 -- We use 'PredType' as documentation to mark those types that we guarantee to have
231 -- this kind.
232 --
233 -- It can be expanded into its representation, but:
234 --
235 -- * The type checker must treat it as opaque
236 --
237 -- * The rest of the compiler treats it as transparent
238 --
239 -- Consider these examples:
240 --
241 -- > f :: (Eq a) => a -> Int
242 -- > g :: (?x :: Int -> Int) => a -> Int
243 -- > h :: (r\l) => {r} => {l::Int | r}
244 --
245 -- Here the @Eq a@ and @?x :: Int -> Int@ and @r\l@ are all called \"predicates\"
246 type PredType = Type
247
248 -- | A collection of 'PredType's
249 type ThetaType = [PredType]
250
251 {-
252 (We don't support TREX records yet, but the setup is designed
253 to expand to allow them.)
254
255 A Haskell qualified type, such as that for f,g,h above, is
256 represented using
257 * a FunTy for the double arrow
258 * with a type of kind Constraint as the function argument
259
260 The predicate really does turn into a real extra argument to the
261 function. If the argument has type (p :: Constraint) then the predicate p is
262 represented by evidence of type p.
263
264 ************************************************************************
265 * *
266 Simple constructors
267 * *
268 ************************************************************************
269
270 These functions are here so that they can be used by TysPrim,
271 which in turn is imported by Type
272 -}
273
274 mkTyVarTy :: TyVar -> Type
275 mkTyVarTy = TyVarTy
276
277 mkTyVarTys :: [TyVar] -> [Type]
278 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
279
280 -- | Create the plain type constructor type which has been applied to no type arguments at all.
281 mkTyConTy :: TyCon -> Type
282 mkTyConTy tycon = TyConApp tycon []
283
284 -- Some basic functions, put here to break loops eg with the pretty printer
285
286 isLiftedTypeKind :: Kind -> Bool
287 isLiftedTypeKind (TyConApp tc []) = tc `hasKey` liftedTypeKindTyConKey
288 isLiftedTypeKind _ = False
289
290 -- | Is this a super-kind (i.e. a type-of-kinds)?
291 isSuperKind :: Type -> Bool
292 isSuperKind (TyConApp skc []) = skc `hasKey` superKindTyConKey
293 isSuperKind _ = False
294
295 isTypeVar :: Var -> Bool
296 isTypeVar v = isTKVar v && not (isSuperKind (varType v))
297
298 isKindVar :: Var -> Bool
299 isKindVar v = isTKVar v && isSuperKind (varType v)
300
301 {-
302 ************************************************************************
303 * *
304 Free variables of types and coercions
305 * *
306 ************************************************************************
307 -}
308
309 tyVarsOfType :: Type -> VarSet
310 -- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym
311 -- tyVarsOfType returns free variables of a type, including kind variables.
312 tyVarsOfType (TyVarTy v) = unitVarSet v
313 tyVarsOfType (TyConApp _ tys) = tyVarsOfTypes tys
314 tyVarsOfType (LitTy {}) = emptyVarSet
315 tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res
316 tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
317 tyVarsOfType (ForAllTy tyvar ty) = delVarSet (tyVarsOfType ty) tyvar
318 `unionVarSet` tyVarsOfType (tyVarKind tyvar)
319
320 tyVarsOfTypes :: [Type] -> TyVarSet
321 tyVarsOfTypes = mapUnionVarSet tyVarsOfType
322
323 closeOverKinds :: TyVarSet -> TyVarSet
324 -- Add the kind variables free in the kinds
325 -- of the tyvars in the given set
326 closeOverKinds tvs
327 = foldVarSet (\tv ktvs -> tyVarsOfType (tyVarKind tv) `unionVarSet` ktvs)
328 tvs tvs
329
330 varSetElemsKvsFirst :: VarSet -> [TyVar]
331 -- {k1,a,k2,b} --> [k1,k2,a,b]
332 varSetElemsKvsFirst set
333 = kvs ++ tvs
334 where
335 (kvs, tvs) = partition isKindVar (varSetElems set)
336
337 {-
338 ************************************************************************
339 * *
340 TyThing
341 * *
342 ************************************************************************
343
344 Despite the fact that DataCon has to be imported via a hi-boot route,
345 this module seems the right place for TyThing, because it's needed for
346 funTyCon and all the types in TysPrim.
347
348 Note [ATyCon for classes]
349 ~~~~~~~~~~~~~~~~~~~~~~~~~
350 Both classes and type constructors are represented in the type environment
351 as ATyCon. You can tell the difference, and get to the class, with
352 isClassTyCon :: TyCon -> Bool
353 tyConClass_maybe :: TyCon -> Maybe Class
354 The Class and its associated TyCon have the same Name.
355 -}
356
357 -- | A global typecheckable-thing, essentially anything that has a name.
358 -- Not to be confused with a 'TcTyThing', which is also a typecheckable
359 -- thing but in the *local* context. See 'TcEnv' for how to retrieve
360 -- a 'TyThing' given a 'Name'.
361 data TyThing
362 = AnId Id
363 | AConLike ConLike
364 | ATyCon TyCon -- TyCons and classes; see Note [ATyCon for classes]
365 | ACoAxiom (CoAxiom Branched)
366 deriving (Eq, Ord)
367
368 instance Outputable TyThing where
369 ppr = pprTyThing
370
371 pprTyThing :: TyThing -> SDoc
372 pprTyThing thing = pprTyThingCategory thing <+> quotes (ppr (getName thing))
373
374 pprTyThingCategory :: TyThing -> SDoc
375 pprTyThingCategory (ATyCon tc)
376 | isClassTyCon tc = ptext (sLit "Class")
377 | otherwise = ptext (sLit "Type constructor")
378 pprTyThingCategory (ACoAxiom _) = ptext (sLit "Coercion axiom")
379 pprTyThingCategory (AnId _) = ptext (sLit "Identifier")
380 pprTyThingCategory (AConLike (RealDataCon _)) = ptext (sLit "Data constructor")
381 pprTyThingCategory (AConLike (PatSynCon _)) = ptext (sLit "Pattern synonym")
382
383
384 instance NamedThing TyThing where -- Can't put this with the type
385 getName (AnId id) = getName id -- decl, because the DataCon instance
386 getName (ATyCon tc) = getName tc -- isn't visible there
387 getName (ACoAxiom cc) = getName cc
388 getName (AConLike cl) = getName cl
389
390 {-
391 ************************************************************************
392 * *
393 Substitutions
394 Data type defined here to avoid unnecessary mutual recursion
395 * *
396 ************************************************************************
397 -}
398
399 -- | Type substitution
400 --
401 -- #tvsubst_invariant#
402 -- The following invariants must hold of a 'TvSubst':
403 --
404 -- 1. The in-scope set is needed /only/ to
405 -- guide the generation of fresh uniques
406 --
407 -- 2. In particular, the /kind/ of the type variables in
408 -- the in-scope set is not relevant
409 --
410 -- 3. The substitution is only applied ONCE! This is because
411 -- in general such application will not reach a fixed point.
412 data TvSubst
413 = TvSubst InScopeSet -- The in-scope type and kind variables
414 TvSubstEnv -- Substitutes both type and kind variables
415 -- See Note [Apply Once]
416 -- and Note [Extending the TvSubstEnv]
417
418 -- | A substitution of 'Type's for 'TyVar's
419 -- and 'Kind's for 'KindVar's
420 type TvSubstEnv = TyVarEnv Type
421 -- A TvSubstEnv is used both inside a TvSubst (with the apply-once
422 -- invariant discussed in Note [Apply Once]), and also independently
423 -- in the middle of matching, and unification (see Types.Unify)
424 -- So you have to look at the context to know if it's idempotent or
425 -- apply-once or whatever
426
427 {-
428 Note [Apply Once]
429 ~~~~~~~~~~~~~~~~~
430 We use TvSubsts to instantiate things, and we might instantiate
431 forall a b. ty
432 \with the types
433 [a, b], or [b, a].
434 So the substitution might go [a->b, b->a]. A similar situation arises in Core
435 when we find a beta redex like
436 (/\ a /\ b -> e) b a
437 Then we also end up with a substitution that permutes type variables. Other
438 variations happen to; for example [a -> (a, b)].
439
440 ***************************************************
441 *** So a TvSubst must be applied precisely once ***
442 ***************************************************
443
444 A TvSubst is not idempotent, but, unlike the non-idempotent substitution
445 we use during unifications, it must not be repeatedly applied.
446
447 Note [Extending the TvSubst]
448 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
449 See #tvsubst_invariant# for the invariants that must hold.
450
451 This invariant allows a short-cut when the TvSubstEnv is empty:
452 if the TvSubstEnv is empty --- i.e. (isEmptyTvSubt subst) holds ---
453 then (substTy subst ty) does nothing.
454
455 For example, consider:
456 (/\a. /\b:(a~Int). ...b..) Int
457 We substitute Int for 'a'. The Unique of 'b' does not change, but
458 nevertheless we add 'b' to the TvSubstEnv, because b's kind does change
459
460 This invariant has several crucial consequences:
461
462 * In substTyVarBndr, we need extend the TvSubstEnv
463 - if the unique has changed
464 - or if the kind has changed
465
466 * In substTyVar, we do not need to consult the in-scope set;
467 the TvSubstEnv is enough
468
469 * In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty
470
471
472
473 ************************************************************************
474 * *
475 Pretty-printing types
476
477 Defined very early because of debug printing in assertions
478 * *
479 ************************************************************************
480
481 @pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
482 defined to use this. @pprParendType@ is the same, except it puts
483 parens around the type, except for the atomic cases. @pprParendType@
484 works just by setting the initial context precedence very high.
485
486 Note [Precedence in types]
487 ~~~~~~~~~~~~~~~~~~~~~~~~~~
488 We don't keep the fixity of type operators in the operator. So the pretty printer
489 operates the following precedene structre:
490 Type constructor application binds more tightly than
491 Oerator applications which bind more tightly than
492 Function arrow
493
494 So we might see a :+: T b -> c
495 meaning (a :+: (T b)) -> c
496
497 Maybe operator applications should bind a bit less tightly?
498
499 Anyway, that's the current story, and it is used consistently for Type and HsType
500 -}
501
502 data TyPrec -- See Note [Prededence in types]
503
504 = TopPrec -- No parens
505 | FunPrec -- Function args; no parens for tycon apps
506 | TyOpPrec -- Infix operator
507 | TyConPrec -- Tycon args; no parens for atomic
508 deriving( Eq, Ord )
509
510 maybeParen :: TyPrec -> TyPrec -> SDoc -> SDoc
511 maybeParen ctxt_prec inner_prec pretty
512 | ctxt_prec < inner_prec = pretty
513 | otherwise = parens pretty
514
515 ------------------
516 pprType, pprParendType :: Type -> SDoc
517 pprType ty = ppr_type TopPrec ty
518 pprParendType ty = ppr_type TyConPrec ty
519
520 pprTyLit :: TyLit -> SDoc
521 pprTyLit = ppr_tylit TopPrec
522
523 pprKind, pprParendKind :: Kind -> SDoc
524 pprKind = pprType
525 pprParendKind = pprParendType
526
527 ------------
528 pprClassPred :: Class -> [Type] -> SDoc
529 pprClassPred clas tys = pprTypeApp (classTyCon clas) tys
530
531 ------------
532 pprTheta :: ThetaType -> SDoc
533 pprTheta [pred] = ppr_type TopPrec pred -- I'm in two minds about this
534 pprTheta theta = parens (sep (punctuate comma (map (ppr_type TopPrec) theta)))
535
536 pprThetaArrowTy :: ThetaType -> SDoc
537 pprThetaArrowTy [] = empty
538 pprThetaArrowTy [pred] = ppr_type TyOpPrec pred <+> darrow
539 -- TyOpPrec: Num a => a -> a does not need parens
540 -- bug (a :~: b) => a -> b currently does
541 -- Trac # 9658
542 pprThetaArrowTy preds = parens (fsep (punctuate comma (map (ppr_type TopPrec) preds)))
543 <+> darrow
544 -- Notice 'fsep' here rather that 'sep', so that
545 -- type contexts don't get displayed in a giant column
546 -- Rather than
547 -- instance (Eq a,
548 -- Eq b,
549 -- Eq c,
550 -- Eq d,
551 -- Eq e,
552 -- Eq f,
553 -- Eq g,
554 -- Eq h,
555 -- Eq i,
556 -- Eq j,
557 -- Eq k,
558 -- Eq l) =>
559 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
560 -- we get
561 --
562 -- instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
563 -- Eq j, Eq k, Eq l) =>
564 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
565
566 ------------------
567 instance Outputable Type where
568 ppr ty = pprType ty
569
570 instance Outputable TyLit where
571 ppr = pprTyLit
572
573 ------------------
574 -- OK, here's the main printer
575
576 ppr_type :: TyPrec -> Type -> SDoc
577 ppr_type _ (TyVarTy tv) = ppr_tvar tv
578 ppr_type p (TyConApp tc tys) = pprTyTcApp p tc tys
579 ppr_type p (LitTy l) = ppr_tylit p l
580 ppr_type p ty@(ForAllTy {}) = ppr_forall_type p ty
581
582 ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
583 ppr_type FunPrec t1 <+> ppr_type TyConPrec t2
584
585 ppr_type p fun_ty@(FunTy ty1 ty2)
586 | isPredTy ty1
587 = ppr_forall_type p fun_ty
588 | otherwise
589 = pprArrowChain p (ppr_type FunPrec ty1 : ppr_fun_tail ty2)
590 where
591 -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
592 ppr_fun_tail (FunTy ty1 ty2)
593 | not (isPredTy ty1) = ppr_type FunPrec ty1 : ppr_fun_tail ty2
594 ppr_fun_tail other_ty = [ppr_type TopPrec other_ty]
595
596
597 ppr_forall_type :: TyPrec -> Type -> SDoc
598 ppr_forall_type p ty
599 = maybeParen p FunPrec $ ppr_sigma_type True ty
600 -- True <=> we always print the foralls on *nested* quantifiers
601 -- Opt_PrintExplicitForalls only affects top-level quantifiers
602 -- False <=> we don't print an extra-constraints wildcard
603
604 ppr_tvar :: TyVar -> SDoc
605 ppr_tvar tv -- Note [Infix type variables]
606 = parenSymOcc (getOccName tv) (ppr tv)
607
608 ppr_tylit :: TyPrec -> TyLit -> SDoc
609 ppr_tylit _ tl =
610 case tl of
611 NumTyLit n -> integer n
612 StrTyLit s -> text (show s)
613
614 -------------------
615 ppr_sigma_type :: Bool -> Type -> SDoc
616 -- First Bool <=> Show the foralls unconditionally
617 -- Second Bool <=> Show an extra-constraints wildcard
618 ppr_sigma_type show_foralls_unconditionally ty
619 = sep [ if show_foralls_unconditionally
620 then pprForAll tvs
621 else pprUserForAll tvs
622 , pprThetaArrowTy ctxt
623 , pprType tau ]
624 where
625 (tvs, rho) = split1 [] ty
626 (ctxt, tau) = split2 [] rho
627
628 split1 tvs (ForAllTy tv ty) = split1 (tv:tvs) ty
629 split1 tvs ty = (reverse tvs, ty)
630
631 split2 ps (ty1 `FunTy` ty2) | isPredTy ty1 = split2 (ty1:ps) ty2
632 split2 ps ty = (reverse ps, ty)
633
634 pprSigmaType :: Type -> SDoc
635 pprSigmaType ty = ppr_sigma_type False ty
636
637 pprUserForAll :: [TyVar] -> SDoc
638 -- Print a user-level forall; see Note [When to print foralls]
639 pprUserForAll tvs
640 = sdocWithDynFlags $ \dflags ->
641 ppWhen (any tv_has_kind_var tvs || gopt Opt_PrintExplicitForalls dflags) $
642 pprForAll tvs
643 where
644 tv_has_kind_var tv = not (isEmptyVarSet (tyVarsOfType (tyVarKind tv)))
645
646 pprForAll :: [TyVar] -> SDoc
647 pprForAll [] = empty
648 pprForAll tvs = forAllLit <+> pprTvBndrs tvs <> dot
649
650 pprTvBndrs :: [TyVar] -> SDoc
651 pprTvBndrs tvs = sep (map pprTvBndr tvs)
652
653 pprTvBndr :: TyVar -> SDoc
654 pprTvBndr tv
655 | isLiftedTypeKind kind = ppr_tvar tv
656 | otherwise = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
657 where
658 kind = tyVarKind tv
659
660 {-
661 Note [When to print foralls]
662 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
663 Mostly we want to print top-level foralls when (and only when) the user specifies
664 -fprint-explicit-foralls. But when kind polymorphism is at work, that suppresses
665 too much information; see Trac #9018.
666
667 So I'm trying out this rule: print explicit foralls if
668 a) User specifies -fprint-explicit-foralls, or
669 b) Any of the quantified type variables has a kind
670 that mentions a kind variable
671
672 This catches common situations, such as a type siguature
673 f :: m a
674 which means
675 f :: forall k. forall (m :: k->*) (a :: k). m a
676 We really want to see both the "forall k" and the kind signatures
677 on m and a. The latter comes from pprTvBndr.
678
679 Note [Infix type variables]
680 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
681 With TypeOperators you can say
682
683 f :: (a ~> b) -> b
684
685 and the (~>) is considered a type variable. However, the type
686 pretty-printer in this module will just see (a ~> b) as
687
688 App (App (TyVarTy "~>") (TyVarTy "a")) (TyVarTy "b")
689
690 So it'll print the type in prefix form. To avoid confusion we must
691 remember to parenthesise the operator, thus
692
693 (~>) a b -> b
694
695 See Trac #2766.
696 -}
697
698 pprDataCons :: TyCon -> SDoc
699 pprDataCons = sepWithVBars . fmap pprDataConWithArgs . tyConDataCons
700 where
701 sepWithVBars [] = empty
702 sepWithVBars docs = sep (punctuate (space <> vbar) docs)
703
704 pprDataConWithArgs :: DataCon -> SDoc
705 pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc]
706 where
707 (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc
708 forAllDoc = pprUserForAll ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs)
709 thetaDoc = pprThetaArrowTy theta
710 argsDoc = hsep (fmap pprParendType arg_tys)
711
712 pprTypeApp :: TyCon -> [Type] -> SDoc
713 pprTypeApp tc tys = pprTyTcApp TopPrec tc tys
714 -- We have to use ppr on the TyCon (not its name)
715 -- so that we get promotion quotes in the right place
716
717 pprTyTcApp :: TyPrec -> TyCon -> [Type] -> SDoc
718 -- Used for types only; so that we can make a
719 -- special case for type-level lists
720 pprTyTcApp p tc tys
721 | tc `hasKey` ipTyConKey
722 , [LitTy (StrTyLit n),ty] <- tys
723 = maybeParen p FunPrec $
724 char '?' <> ftext n <> ptext (sLit "::") <> ppr_type TopPrec ty
725
726 | tc `hasKey` consDataConKey
727 , [_kind,ty1,ty2] <- tys
728 = sdocWithDynFlags $ \dflags ->
729 if gopt Opt_PrintExplicitKinds dflags then pprTcApp p ppr_type tc tys
730 else pprTyList p ty1 ty2
731
732 | tc `hasKey` errorMessageTypeErrorFamKey = text "(TypeError ...)"
733
734 | otherwise
735 = pprTcApp p ppr_type tc tys
736
737 pprTcApp :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> SDoc
738 -- Used for both types and coercions, hence polymorphism
739 pprTcApp _ pp tc [ty]
740 | tc `hasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp TopPrec ty)
741 | tc `hasKey` parrTyConKey = pprPromotionQuote tc <> paBrackets (pp TopPrec ty)
742
743
744 pprTcApp p pp tc tys
745 | Just sort <- tyConTuple_maybe tc
746 , tyConArity tc == length tys
747 = pprTupleApp p pp tc sort tys
748
749 | Just dc <- isPromotedDataCon_maybe tc
750 , let dc_tc = dataConTyCon dc
751 , Just tup_sort <- tyConTuple_maybe dc_tc
752 , let arity = tyConArity dc_tc -- E.g. 3 for (,,) k1 k2 k3 t1 t2 t3
753 ty_args = drop arity tys -- Drop the kind args
754 , ty_args `lengthIs` arity -- Result is saturated
755 = pprPromotionQuote tc <>
756 (tupleParens tup_sort $ pprWithCommas (pp TopPrec) ty_args)
757
758 | otherwise
759 = sdocWithDynFlags (pprTcApp_help p pp tc tys)
760
761 pprTupleApp :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> TupleSort -> [a] -> SDoc
762 -- Print a saturated tuple
763 pprTupleApp p pp tc sort tys
764 | null tys
765 , ConstraintTuple <- sort
766 = if opt_PprStyle_Debug then ptext (sLit "(%%)")
767 else maybeParen p FunPrec $
768 ptext (sLit "() :: Constraint")
769 | otherwise
770 = pprPromotionQuote tc <>
771 tupleParens sort (pprWithCommas (pp TopPrec) tys)
772
773 pprTcApp_help :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> DynFlags -> SDoc
774 -- This one has accss to the DynFlags
775 pprTcApp_help p pp tc tys dflags
776 | not (isSymOcc (nameOccName (tyConName tc)))
777 = pprPrefixApp p (ppr tc) (map (pp TyConPrec) tys_wo_kinds)
778
779 | [ty1,ty2] <- tys_wo_kinds -- Infix, two arguments;
780 -- we know nothing of precedence though
781 = pprInfixApp p pp (ppr tc) ty1 ty2
782
783 | tc `hasKey` liftedTypeKindTyConKey
784 || tc `hasKey` unliftedTypeKindTyConKey
785 = ASSERT( null tys ) ppr tc -- Do not wrap *, # in parens
786
787 | otherwise
788 = pprPrefixApp p (parens (ppr tc)) (map (pp TyConPrec) tys_wo_kinds)
789 where
790 tys_wo_kinds = suppressKinds dflags (tyConKind tc) tys
791
792 ------------------
793 suppressKinds :: DynFlags -> Kind -> [a] -> [a]
794 -- Given the kind of a TyCon, and the args to which it is applied,
795 -- suppress the args that are kind args
796 -- C.f. Note [Suppressing kinds] in IfaceType
797 suppressKinds dflags kind xs
798 | gopt Opt_PrintExplicitKinds dflags = xs
799 | otherwise = suppress kind xs
800 where
801 suppress (ForAllTy _ kind) (_ : xs) = suppress kind xs
802 suppress (FunTy _ res) (x:xs) = x : suppress res xs
803 suppress _ xs = xs
804
805 ----------------
806 pprTyList :: TyPrec -> Type -> Type -> SDoc
807 -- Given a type-level list (t1 ': t2), see if we can print
808 -- it in list notation [t1, ...].
809 pprTyList p ty1 ty2
810 = case gather ty2 of
811 (arg_tys, Nothing) -> char '\'' <> brackets (fsep (punctuate comma
812 (map (ppr_type TopPrec) (ty1:arg_tys))))
813 (arg_tys, Just tl) -> maybeParen p FunPrec $
814 hang (ppr_type FunPrec ty1)
815 2 (fsep [ colon <+> ppr_type FunPrec ty | ty <- arg_tys ++ [tl]])
816 where
817 gather :: Type -> ([Type], Maybe Type)
818 -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
819 -- = (tys, Just tl) means ty is of form t1:t2:...tn:tl
820 gather (TyConApp tc tys)
821 | tc `hasKey` consDataConKey
822 , [_kind, ty1,ty2] <- tys
823 , (args, tl) <- gather ty2
824 = (ty1:args, tl)
825 | tc `hasKey` nilDataConKey
826 = ([], Nothing)
827 gather ty = ([], Just ty)
828
829 ----------------
830 pprInfixApp :: TyPrec -> (TyPrec -> a -> SDoc) -> SDoc -> a -> a -> SDoc
831 pprInfixApp p pp pp_tc ty1 ty2
832 = maybeParen p TyOpPrec $
833 sep [pp TyOpPrec ty1, pprInfixVar True pp_tc <+> pp TyOpPrec ty2]
834
835 pprPrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
836 pprPrefixApp p pp_fun pp_tys
837 | null pp_tys = pp_fun
838 | otherwise = maybeParen p TyConPrec $
839 hang pp_fun 2 (sep pp_tys)
840
841 ----------------
842 pprArrowChain :: TyPrec -> [SDoc] -> SDoc
843 -- pprArrowChain p [a,b,c] generates a -> b -> c
844 pprArrowChain _ [] = empty
845 pprArrowChain p (arg:args) = maybeParen p FunPrec $
846 sep [arg, sep (map (arrow <+>) args)]
847
848 {-
849 ************************************************************************
850 * *
851 \subsection{TidyType}
852 * *
853 ************************************************************************
854
855 Tidying is here because it has a special case for FlatSkol
856 -}
857
858 -- | This tidies up a type for printing in an error message, or in
859 -- an interface file.
860 --
861 -- It doesn't change the uniques at all, just the print names.
862 tidyTyVarBndrs :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
863 tidyTyVarBndrs env tvs = mapAccumL tidyTyVarBndr env tvs
864
865 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
866 tidyTyVarBndr tidy_env@(occ_env, subst) tyvar
867 = case tidyOccName occ_env occ1 of
868 (tidy', occ') -> ((tidy', subst'), tyvar')
869 where
870 subst' = extendVarEnv subst tyvar tyvar'
871 tyvar' = setTyVarKind (setTyVarName tyvar name') kind'
872 name' = tidyNameOcc name occ'
873 kind' = tidyKind tidy_env (tyVarKind tyvar)
874 where
875 name = tyVarName tyvar
876 occ = getOccName name
877 -- System Names are for unification variables;
878 -- when we tidy them we give them a trailing "0" (or 1 etc)
879 -- so that they don't take precedence for the un-modified name
880 -- Plus, indicating a unification variable in this way is a
881 -- helpful clue for users
882 occ1 | isSystemName name = mkTyVarOcc (occNameString occ ++ "0")
883 | otherwise = occ
884
885
886 ---------------
887 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
888 -- ^ Add the free 'TyVar's to the env in tidy form,
889 -- so that we can tidy the type they are free in
890 tidyFreeTyVars (full_occ_env, var_env) tyvars
891 = fst (tidyOpenTyVars (full_occ_env, var_env) (varSetElems tyvars))
892
893 ---------------
894 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
895 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
896
897 ---------------
898 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
899 -- ^ Treat a new 'TyVar' as a binder, and give it a fresh tidy name
900 -- using the environment if one has not already been allocated. See
901 -- also 'tidyTyVarBndr'
902 tidyOpenTyVar env@(_, subst) tyvar
903 = case lookupVarEnv subst tyvar of
904 Just tyvar' -> (env, tyvar') -- Already substituted
905 Nothing -> tidyTyVarBndr env tyvar -- Treat it as a binder
906
907 ---------------
908 tidyTyVarOcc :: TidyEnv -> TyVar -> TyVar
909 tidyTyVarOcc (_, subst) tv
910 = case lookupVarEnv subst tv of
911 Nothing -> tv
912 Just tv' -> tv'
913
914 ---------------
915 tidyTypes :: TidyEnv -> [Type] -> [Type]
916 tidyTypes env tys = map (tidyType env) tys
917
918 ---------------
919 tidyType :: TidyEnv -> Type -> Type
920 tidyType _ (LitTy n) = LitTy n
921 tidyType env (TyVarTy tv) = TyVarTy (tidyTyVarOcc env tv)
922 tidyType env (TyConApp tycon tys) = let args = tidyTypes env tys
923 in args `seqList` TyConApp tycon args
924 tidyType env (AppTy fun arg) = (AppTy $! (tidyType env fun)) $! (tidyType env arg)
925 tidyType env (FunTy fun arg) = (FunTy $! (tidyType env fun)) $! (tidyType env arg)
926 tidyType env (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
927 where
928 (envp, tvp) = tidyTyVarBndr env tv
929
930 ---------------
931 -- | Grabs the free type variables, tidies them
932 -- and then uses 'tidyType' to work over the type itself
933 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
934 tidyOpenType env ty
935 = (env', tidyType (trimmed_occ_env, var_env) ty)
936 where
937 (env'@(_, var_env), tvs') = tidyOpenTyVars env (varSetElems (tyVarsOfType ty))
938 trimmed_occ_env = initTidyOccEnv (map getOccName tvs')
939 -- The idea here was that we restrict the new TidyEnv to the
940 -- _free_ vars of the type, so that we don't gratuitously rename
941 -- the _bound_ variables of the type.
942
943 ---------------
944 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
945 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
946
947 ---------------
948 -- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)
949 tidyTopType :: Type -> Type
950 tidyTopType ty = tidyType emptyTidyEnv ty
951
952 ---------------
953 tidyOpenKind :: TidyEnv -> Kind -> (TidyEnv, Kind)
954 tidyOpenKind = tidyOpenType
955
956 tidyKind :: TidyEnv -> Kind -> Kind
957 tidyKind = tidyType