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