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