0b8a1bf2cc75e4a09543fd3359ef4c339332b385
[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 \begin{code}
8 {-# OPTIONS -fno-warn-tabs #-}
9 -- The above warning supression flag is a temporary kludge.
10 -- While working on this module you are encouraged to remove it and
11 -- detab the module (please do the detabbing in a separate patch). See
12 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
13 -- for details
14
15 -- We expose the relevant stuff from this module via the Type module
16 {-# OPTIONS_HADDOCK hide #-}
17 {-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
18 module TypeRep (
19         TyThing(..),
20         Type(..),
21         KindOrType, Kind, SuperKind,
22         PredType, ThetaType,      -- Synonyms
23
24         -- Functions over types
25         mkTyConApp, mkTyConTy, mkTyVarTy, mkTyVarTys,
26         isLiftedTypeKind,
27         
28         -- Pretty-printing
29         pprType, pprParendType, pprTypeApp,
30         pprTyThing, pprTyThingCategory, 
31         pprEqPred, pprTheta, pprForAll, pprThetaArrowTy, pprClassPred,
32         pprKind, pprParendKind,
33         Prec(..), maybeParen, pprTcApp, pprTypeNameApp, 
34         pprPrefixApp, pprArrowChain, ppr_type,
35
36         -- Free variables
37         tyVarsOfType, tyVarsOfTypes,
38
39         -- Substitutions
40         TvSubst(..), TvSubstEnv
41     ) where
42
43 #include "HsVersions.h"
44
45 import {-# SOURCE #-} DataCon( DataCon, dataConName )
46 import {-# SOURCE #-} Type( noParenPred, isPredTy ) -- Transitively pulls in a LOT of stuff, better to break the loop
47
48 -- friends:
49 import Var
50 import VarEnv
51 import VarSet
52 import Name
53 import BasicTypes
54 import TyCon
55 import Class
56
57 -- others
58 import PrelNames
59 import Outputable
60 import FastString
61 import Pair
62
63 -- libraries
64 import qualified Data.Data        as Data hiding ( TyCon )
65 \end{code}
66
67         ----------------------
68         A note about newtypes
69         ----------------------
70
71 Consider
72         newtype N = MkN Int
73
74 Then we want N to be represented as an Int, and that's what we arrange.
75 The front end of the compiler [TcType.lhs] treats N as opaque, 
76 the back end treats it as transparent [Type.lhs].
77
78 There's a bit of a problem with recursive newtypes
79         newtype P = MkP P
80         newtype Q = MkQ (Q->Q)
81
82 Here the 'implicit expansion' we get from treating P and Q as transparent
83 would give rise to infinite types, which in turn makes eqType diverge.
84 Similarly splitForAllTys and splitFunTys can get into a loop.  
85
86 Solution: 
87
88 * Newtypes are always represented using TyConApp.
89
90 * For non-recursive newtypes, P, treat P just like a type synonym after 
91   type-checking is done; i.e. it's opaque during type checking (functions
92   from TcType) but transparent afterwards (functions from Type).  
93   "Treat P as a type synonym" means "all functions expand NewTcApps 
94   on the fly".
95
96   Applications of the data constructor P simply vanish:
97         P x = x
98   
99
100 * For recursive newtypes Q, treat the Q and its representation as 
101   distinct right through the compiler.  Applications of the data consructor
102   use a coerce:
103         Q = \(x::Q->Q). coerce Q x
104   They are rare, so who cares if they are a tiny bit less efficient.
105
106 The typechecker (TcTyDecls) identifies enough type construtors as 'recursive'
107 to cut all loops.  The other members of the loop may be marked 'non-recursive'.
108
109
110 %************************************************************************
111 %*                                                                      *
112 \subsection{The data type}
113 %*                                                                      *
114 %************************************************************************
115
116
117 \begin{code}
118 -- | The key representation of types within the compiler
119 data Type
120   = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable)
121
122   | AppTy
123         Type
124         Type            -- ^ Type application to something other than a 'TyCon'. Parameters:
125                         --
126                         --  1) Function: must /not/ be a 'TyConApp',
127                         --     must be another 'AppTy', or 'TyVarTy'
128                         --
129                         --  2) Argument type
130
131   | TyConApp
132         TyCon
133         [KindOrType]    -- ^ Application of a 'TyCon', including newtypes /and/ synonyms.
134                         -- Invariant: saturated appliations of 'FunTyCon' must
135                         -- use 'FunTy' and saturated synonyms must use their own
136                         -- constructors. However, /unsaturated/ 'FunTyCon's
137                         -- do appear as 'TyConApp's.
138                         -- Parameters:
139                         --
140                         -- 1) Type constructor being applied to.
141                         --
142                         -- 2) Type arguments. Might not have enough type arguments
143                         --    here to saturate the constructor.
144                         --    Even type synonyms are not necessarily saturated;
145                         --    for example unsaturated type synonyms
146                         --    can appear as the right hand side of a type synonym.
147
148   | FunTy
149         Type            
150         Type            -- ^ Special case of 'TyConApp': @TyConApp FunTyCon [t1, t2]@
151                         -- See Note [Equality-constrained types]
152
153   | ForAllTy
154         Var         -- Type or kind variable
155         Type            -- ^ A polymorphic type
156
157   deriving (Data.Data, Data.Typeable)
158
159 type KindOrType = Type -- See Note [Arguments to type constructors]
160
161 -- | The key type representing kinds in the compiler.
162 -- Invariant: a kind is always in one of these forms:
163 --
164 -- > FunTy k1 k2
165 -- > TyConApp PrimTyCon [...]
166 -- > TyVar kv   -- (during inference only)
167 -- > ForAll ... -- (for top-level coercions)
168 type Kind = Type
169
170 -- | "Super kinds", used to help encode 'Kind's as types.
171 -- Invariant: a super kind is always of this form:
172 --
173 -- > TyConApp SuperKindTyCon ...
174 type SuperKind = Type
175 \end{code}
176
177
178 Note [Arguments to type constructors]
179 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
180 Because of kind polymorphism, in addition to type application we now
181 have kind instantiation. We reuse the same notations to do so.
182
183 For example:
184
185   Just (* -> *) Maybe
186   Right * Nat Zero
187
188 are represented by:
189
190   TyConApp (PromotedDataCon Just) [* -> *, Maybe]
191   TyConApp (PromotedDataCon Right) [*, Nat, (PromotedDataCon Zero)]
192
193 Important note: Nat is used as a *kind* and not as a type. This can be
194 confusing, since type-level Nat and kind-level Nat are identical. We
195 use the kind of (PromotedDataCon Right) to know if its arguments are
196 kinds or types.
197
198 This kind instantiation only happens in TyConApp currently.
199
200
201 Note [Equality-constrained types]
202 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
203 The type   forall ab. (a ~ [b]) => blah
204 is encoded like this:
205
206    ForAllTy (a:*) $ ForAllTy (b:*) $
207    FunTy (TyConApp (~) [a, [b]]) $
208    blah
209
210 -------------------------------------
211                 Note [PredTy]
212
213 \begin{code}
214 -- | A type of the form @p@ of kind @Constraint@ represents a value whose type is
215 -- the Haskell predicate @p@, where a predicate is what occurs before 
216 -- the @=>@ in a Haskell type.
217 --
218 -- We use 'PredType' as documentation to mark those types that we guarantee to have
219 -- this kind.
220 --
221 -- It can be expanded into its representation, but: 
222 --
223 -- * The type checker must treat it as opaque
224 --
225 -- * The rest of the compiler treats it as transparent
226 --
227 -- Consider these examples:
228 --
229 -- > f :: (Eq a) => a -> Int
230 -- > g :: (?x :: Int -> Int) => a -> Int
231 -- > h :: (r\l) => {r} => {l::Int | r}
232 --
233 -- Here the @Eq a@ and @?x :: Int -> Int@ and @r\l@ are all called \"predicates\"
234 type PredType = Type
235
236 -- | A collection of 'PredType's
237 type ThetaType = [PredType]
238 \end{code}
239
240 (We don't support TREX records yet, but the setup is designed
241 to expand to allow them.)
242
243 A Haskell qualified type, such as that for f,g,h above, is
244 represented using 
245         * a FunTy for the double arrow
246         * with a type of kind Constraint as the function argument
247
248 The predicate really does turn into a real extra argument to the
249 function.  If the argument has type (p :: Constraint) then the predicate p is
250 represented by evidence of type p.
251
252 %************************************************************************
253 %*                                                                      *
254             Simple constructors
255 %*                                                                      *
256 %************************************************************************
257
258 These functions are here so that they can be used by TysPrim,
259 which in turn is imported by Type
260
261 \begin{code}
262 mkTyVarTy  :: TyVar   -> Type
263 mkTyVarTy  = TyVarTy
264
265 mkTyVarTys :: [TyVar] -> [Type]
266 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
267
268 -- | A key function: builds a 'TyConApp' or 'FunTy' as apppropriate to its arguments.
269 -- Applies its arguments to the constructor from left to right
270 mkTyConApp :: TyCon -> [Type] -> Type
271 mkTyConApp tycon tys
272   | isFunTyCon tycon, [ty1,ty2] <- tys
273   = FunTy ty1 ty2
274
275   | otherwise
276   = TyConApp tycon tys
277
278 -- | Create the plain type constructor type which has been applied to no type arguments at all.
279 mkTyConTy :: TyCon -> Type
280 mkTyConTy tycon = mkTyConApp tycon []
281
282 isLiftedTypeKind :: Kind -> Bool
283 -- This function is here because it's used in the pretty printer
284 isLiftedTypeKind (TyConApp tc []) = tc `hasKey` liftedTypeKindTyConKey
285 isLiftedTypeKind _                = False
286 \end{code}
287
288
289 %************************************************************************
290 %*                                                                      *
291                         Free variables of types and coercions
292 %*                                                                      *
293 %************************************************************************
294
295 \begin{code}  
296 tyVarsOfType :: Type -> VarSet
297 -- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym
298 -- tyVarsOfType returns only the free *type* variables of a type
299 -- For example, tyVarsOfType (a::k) returns {a}, not including the
300 -- kind variable {k}
301 tyVarsOfType (TyVarTy v)         = unitVarSet v
302 tyVarsOfType (TyConApp _ tys)    = tyVarsOfTypes tys
303 tyVarsOfType (FunTy arg res)     = tyVarsOfType arg `unionVarSet` tyVarsOfType res
304 tyVarsOfType (AppTy fun arg)     = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
305 tyVarsOfType (ForAllTy tyvar ty) = delVarSet (tyVarsOfType ty) tyvar
306
307 tyVarsOfTypes :: [Type] -> TyVarSet
308 tyVarsOfTypes tys = foldr (unionVarSet . tyVarsOfType) emptyVarSet tys
309 \end{code}
310
311 %************************************************************************
312 %*                                                                      *
313                         TyThing
314 %*                                                                      *
315 %************************************************************************
316
317 Despite the fact that DataCon has to be imported via a hi-boot route, 
318 this module seems the right place for TyThing, because it's needed for
319 funTyCon and all the types in TysPrim.
320
321 Note [ATyCon for classes]
322 ~~~~~~~~~~~~~~~~~~~~~~~~~
323 Both classes and type constructors are represented in the type environment
324 as ATyCon.  You can tell the difference, and get to the class, with
325    isClassTyCon :: TyCon -> Bool
326    tyConClass_maybe :: TyCon -> Maybe Class
327 The Class and its associated TyCon have the same Name.
328
329 \begin{code}
330 -- | A typecheckable-thing, essentially anything that has a name
331 data TyThing 
332   = AnId     Id
333   | ADataCon DataCon
334   | ATyCon   TyCon       -- TyCons and classes; see Note [ATyCon for classes]
335   | ACoAxiom CoAxiom
336   deriving (Eq, Ord)
337
338 instance Outputable TyThing where 
339   ppr = pprTyThing
340
341 pprTyThing :: TyThing -> SDoc
342 pprTyThing thing = pprTyThingCategory thing <+> quotes (ppr (getName thing))
343
344 pprTyThingCategory :: TyThing -> SDoc
345 pprTyThingCategory (ATyCon tc)
346   | isClassTyCon tc = ptext (sLit "Class")
347   | otherwise       = ptext (sLit "Type constructor")
348 pprTyThingCategory (ACoAxiom _) = ptext (sLit "Coercion axiom")
349 pprTyThingCategory (AnId   _)   = ptext (sLit "Identifier")
350 pprTyThingCategory (ADataCon _) = ptext (sLit "Data constructor")
351
352
353 instance NamedThing TyThing where       -- Can't put this with the type
354   getName (AnId id)     = getName id    -- decl, because the DataCon instance
355   getName (ATyCon tc)   = getName tc    -- isn't visible there
356   getName (ACoAxiom cc) = getName cc
357   getName (ADataCon dc) = dataConName dc
358
359 \end{code}
360
361
362 %************************************************************************
363 %*                                                                      *
364                         Substitutions
365       Data type defined here to avoid unnecessary mutual recursion
366 %*                                                                      *
367 %************************************************************************
368
369 \begin{code}
370 -- | Type substitution
371 --
372 -- #tvsubst_invariant#
373 -- The following invariants must hold of a 'TvSubst':
374 -- 
375 -- 1. The in-scope set is needed /only/ to
376 -- guide the generation of fresh uniques
377 --
378 -- 2. In particular, the /kind/ of the type variables in 
379 -- the in-scope set is not relevant
380 --
381 -- 3. The substition is only applied ONCE! This is because
382 -- in general such application will not reached a fixed point.
383 data TvSubst            
384   = TvSubst InScopeSet  -- The in-scope type and kind variables
385             TvSubstEnv  -- Substitutes both type and kind variables
386         -- See Note [Apply Once]
387         -- and Note [Extending the TvSubstEnv]
388
389 -- | A substitition of 'Type's for 'TyVar's
390 --                 and 'Kind's for 'KindVar's
391 type TvSubstEnv = TyVarEnv Type
392         -- A TvSubstEnv is used both inside a TvSubst (with the apply-once
393         -- invariant discussed in Note [Apply Once]), and also independently
394         -- in the middle of matching, and unification (see Types.Unify)
395         -- So you have to look at the context to know if it's idempotent or
396         -- apply-once or whatever
397 \end{code}
398
399 Note [Apply Once]
400 ~~~~~~~~~~~~~~~~~
401 We use TvSubsts to instantiate things, and we might instantiate
402         forall a b. ty
403 \with the types
404         [a, b], or [b, a].
405 So the substition might go [a->b, b->a].  A similar situation arises in Core
406 when we find a beta redex like
407         (/\ a /\ b -> e) b a
408 Then we also end up with a substition that permutes type variables. Other
409 variations happen to; for example [a -> (a, b)].  
410
411         ***************************************************
412         *** So a TvSubst must be applied precisely once ***
413         ***************************************************
414
415 A TvSubst is not idempotent, but, unlike the non-idempotent substitution
416 we use during unifications, it must not be repeatedly applied.
417
418 Note [Extending the TvSubst]
419 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
420 See #tvsubst_invariant# for the invariants that must hold.
421
422 This invariant allows a short-cut when the TvSubstEnv is empty:
423 if the TvSubstEnv is empty --- i.e. (isEmptyTvSubt subst) holds ---
424 then (substTy subst ty) does nothing.
425
426 For example, consider:
427         (/\a. /\b:(a~Int). ...b..) Int
428 We substitute Int for 'a'.  The Unique of 'b' does not change, but
429 nevertheless we add 'b' to the TvSubstEnv, because b's kind does change
430
431 This invariant has several crucial consequences:
432
433 * In substTyVarBndr, we need extend the TvSubstEnv 
434         - if the unique has changed
435         - or if the kind has changed
436
437 * In substTyVar, we do not need to consult the in-scope set;
438   the TvSubstEnv is enough
439
440 * In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty
441 \end{code}
442
443
444
445 %************************************************************************
446 %*                                                                      *
447                    Pretty-printing types
448
449        Defined very early because of debug printing in assertions
450 %*                                                                      *
451 %************************************************************************
452
453 @pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
454 defined to use this.  @pprParendType@ is the same, except it puts
455 parens around the type, except for the atomic cases.  @pprParendType@
456 works just by setting the initial context precedence very high.
457
458 \begin{code}
459 data Prec = TopPrec     -- No parens
460           | FunPrec     -- Function args; no parens for tycon apps
461           | TyConPrec   -- Tycon args; no parens for atomic
462           deriving( Eq, Ord )
463
464 maybeParen :: Prec -> Prec -> SDoc -> SDoc
465 maybeParen ctxt_prec inner_prec pretty
466   | ctxt_prec < inner_prec = pretty
467   | otherwise              = parens pretty
468
469 ------------------
470 pprType, pprParendType :: Type -> SDoc
471 pprType       ty = ppr_type TopPrec ty
472 pprParendType ty = ppr_type TyConPrec ty
473
474 pprKind, pprParendKind :: Kind -> SDoc
475 pprKind       = pprType
476 pprParendKind = pprParendType
477
478 ------------------
479 pprEqPred :: Pair Type -> SDoc
480 -- NB: Maybe move to Coercion? It's only called after coercionKind anyway. 
481 pprEqPred (Pair ty1 ty2) 
482   = sep [ ppr_type FunPrec ty1
483         , nest 2 (ptext (sLit "~#"))
484         , ppr_type FunPrec ty2]
485     -- Precedence looks like (->) so that we get
486     --    Maybe a ~ Bool
487     --    (a->a) ~ Bool
488     -- Note parens on the latter!
489
490 ------------
491 pprClassPred :: Class -> [Type] -> SDoc
492 pprClassPred = ppr_class_pred ppr_type
493
494 ppr_class_pred :: (Prec -> a -> SDoc) -> Class -> [a] -> SDoc
495 ppr_class_pred pp clas tys = pprTypeNameApp TopPrec pp (getName clas) tys
496
497 ------------
498 pprTheta :: ThetaType -> SDoc
499 -- pprTheta [pred] = pprPred pred        -- I'm in two minds about this
500 pprTheta theta  = parens (sep (punctuate comma (map (ppr_type TopPrec) theta)))
501
502 pprThetaArrowTy :: ThetaType -> SDoc
503 pprThetaArrowTy []      = empty
504 pprThetaArrowTy [pred]
505       | noParenPred pred = ppr_type TopPrec pred <+> darrow
506 pprThetaArrowTy preds   = parens (fsep (punctuate comma (map (ppr_type TopPrec) preds)))
507                             <+> darrow
508     -- Notice 'fsep' here rather that 'sep', so that
509     -- type contexts don't get displayed in a giant column
510     -- Rather than
511     --  instance (Eq a,
512     --            Eq b,
513     --            Eq c,
514     --            Eq d,
515     --            Eq e,
516     --            Eq f,
517     --            Eq g,
518     --            Eq h,
519     --            Eq i,
520     --            Eq j,
521     --            Eq k,
522     --            Eq l) =>
523     --           Eq (a, b, c, d, e, f, g, h, i, j, k, l)
524     -- we get
525     --
526     --  instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
527     --            Eq j, Eq k, Eq l) =>
528     --           Eq (a, b, c, d, e, f, g, h, i, j, k, l)
529
530 ------------------
531 instance Outputable Type where
532     ppr ty = pprType ty
533
534 instance Outputable name => OutputableBndr (IPName name) where
535     pprBndr _ n = ppr n -- Simple for now
536
537 ------------------
538         -- OK, here's the main printer
539
540 ppr_type :: Prec -> Type -> SDoc
541 ppr_type _ (TyVarTy tv)       = ppr_tvar tv
542 ppr_type p (TyConApp tc tys)  = pprTcApp p ppr_type tc tys
543
544 ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
545                            pprType t1 <+> ppr_type TyConPrec t2
546
547 ppr_type p ty@(ForAllTy {})        = ppr_forall_type p ty
548 ppr_type p fun_ty@(FunTy ty1 ty2)
549   | isPredTy ty1
550   = ppr_forall_type p fun_ty
551   | otherwise
552   = pprArrowChain p (ppr_type FunPrec ty1 : ppr_fun_tail ty2)
553   where
554     -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
555     ppr_fun_tail (FunTy ty1 ty2)
556       | not (isPredTy ty1) = ppr_type FunPrec ty1 : ppr_fun_tail ty2
557     ppr_fun_tail other_ty = [ppr_type TopPrec other_ty]
558
559 ppr_forall_type :: Prec -> Type -> SDoc
560 ppr_forall_type p ty
561   = maybeParen p FunPrec $
562     sep [pprForAll tvs, pprThetaArrowTy ctxt, pprType tau]
563   where
564     (tvs,  rho) = split1 [] ty
565     (ctxt, tau) = split2 [] rho
566
567     split1 tvs (ForAllTy tv ty) = split1 (tv:tvs) ty
568     split1 tvs ty          = (reverse tvs, ty)
569  
570     split2 ps (ty1 `FunTy` ty2) | isPredTy ty1 = split2 (ty1:ps) ty2
571     split2 ps ty                               = (reverse ps, ty)
572
573 ppr_tvar :: TyVar -> SDoc
574 ppr_tvar tv  -- Note [Infix type variables]
575   = parenSymOcc (getOccName tv) (ppr tv)
576
577 -------------------
578 pprForAll :: [TyVar] -> SDoc
579 pprForAll []  = empty
580 pprForAll tvs = ptext (sLit "forall") <+> sep (map pprTvBndr tvs) <> dot
581
582 pprTvBndr :: TyVar -> SDoc
583 pprTvBndr tv 
584   | isLiftedTypeKind kind = ppr_tvar tv
585   | otherwise             = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
586              where
587                kind = tyVarKind tv
588 \end{code}
589
590 Note [Infix type variables]
591 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
592 With TypeOperators you can say
593
594    f :: (a ~> b) -> b
595
596 and the (~>) is considered a type variable.  However, the type
597 pretty-printer in this module will just see (a ~> b) as
598
599    App (App (TyVarTy "~>") (TyVarTy "a")) (TyVarTy "b")
600
601 So it'll print the type in prefix form.  To avoid confusion we must
602 remember to parenthesise the operator, thus
603
604    (~>) a b -> b
605
606 See Trac #2766.
607
608 \begin{code}
609 pprTcApp :: Prec -> (Prec -> a -> SDoc) -> TyCon -> [a] -> SDoc
610 pprTcApp _ _ tc []      -- No brackets for SymOcc
611   = pp_nt_debug <> ppr tc
612   where
613    pp_nt_debug | isNewTyCon tc = ifPprDebug (if isRecursiveTyCon tc 
614                                              then ptext (sLit "<recnt>")
615                                              else ptext (sLit "<nt>"))
616                | otherwise     = empty
617
618 pprTcApp _ pp tc [ty]
619   | tc `hasKey` listTyConKey = brackets (pp TopPrec ty)
620   | tc `hasKey` parrTyConKey = ptext (sLit "[:") <> pp TopPrec ty <> ptext (sLit ":]")
621   | tc `hasKey` liftedTypeKindTyConKey   = ptext (sLit "*")
622   | tc `hasKey` unliftedTypeKindTyConKey = ptext (sLit "#")
623   | tc `hasKey` openTypeKindTyConKey     = ptext (sLit "OpenKind")
624   | tc `hasKey` ubxTupleKindTyConKey     = ptext (sLit "(#)")
625   | tc `hasKey` argTypeKindTyConKey      = ptext (sLit "ArgKind")
626   | Just n <- tyConIP_maybe tc           = ppr n <> ptext (sLit "::") <> pp TopPrec ty
627
628 pprTcApp p pp tc tys
629   | isTupleTyCon tc && tyConArity tc == length tys
630   = tupleParens (tupleTyConSort tc) (sep (punctuate comma (map (pp TopPrec) tys)))
631   | tc `hasKey` eqTyConKey -- We need to special case the type equality TyCon because
632                            -- its not a SymOcc so won't get printed infix
633   , [_, ty1,ty2] <- tys
634   = pprInfixApp p pp (getName tc) ty1 ty2
635   | otherwise
636   = pprTypeNameApp p pp (getName tc) tys
637
638 ----------------
639 pprTypeApp :: NamedThing a => a -> [Type] -> SDoc
640 -- The first arg is the tycon, or sometimes class
641 -- Print infix if the tycon/class looks like an operator
642 pprTypeApp tc tys = pprTypeNameApp TopPrec ppr_type (getName tc) tys
643
644 pprTypeNameApp :: Prec -> (Prec -> a -> SDoc) -> Name -> [a] -> SDoc
645 -- Used for classes and coercions as well as types; that's why it's separate from pprTcApp
646 pprTypeNameApp p pp tc tys
647   | is_sym_occ           -- Print infix if possible
648   , [ty1,ty2] <- tys  -- We know nothing of precedence though
649   = pprInfixApp p pp tc ty1 ty2
650   | otherwise
651   = pprPrefixApp p (pprPrefixVar is_sym_occ (ppr tc)) (map (pp TyConPrec) tys)
652   where
653     is_sym_occ = isSymOcc (getOccName tc)
654
655 ----------------
656 pprInfixApp :: Prec -> (Prec -> a -> SDoc) -> Name -> a -> a -> SDoc
657 pprInfixApp p pp tc ty1 ty2
658   = maybeParen p FunPrec $
659     sep [pp FunPrec ty1, pprInfixVar True (ppr tc) <+> pp FunPrec ty2]
660
661 pprPrefixApp :: Prec -> SDoc -> [SDoc] -> SDoc
662 pprPrefixApp p pp_fun pp_tys = maybeParen p TyConPrec $
663                                hang pp_fun 2 (sep pp_tys)
664
665 ----------------
666 pprArrowChain :: Prec -> [SDoc] -> SDoc
667 -- pprArrowChain p [a,b,c]  generates   a -> b -> c
668 pprArrowChain _ []         = empty
669 pprArrowChain p (arg:args) = maybeParen p FunPrec $
670                              sep [arg, sep (map (arrow <+>) args)]
671 \end{code}
672