Merge branch 'master' of darcs.haskell.org:/home/darcs/ghc
[ghc.git] / compiler / hsSyn / HsTypes.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 HsTypes: Abstract syntax: user-defined types
7
8 \begin{code}
9 {-# LANGUAGE DeriveDataTypeable #-}
10
11 module HsTypes (
12         HsType(..), LHsType, HsKind, LHsKind,
13         HsTyVarBndr(..), LHsTyVarBndr, 
14         LHsTyVarBndrs(..),
15         HsWithBndrs(..),
16         HsTupleSort(..), HsExplicitFlag(..),
17         HsContext, LHsContext,
18         HsQuasiQuote(..),
19         HsTyWrapper(..),
20         HsTyLit(..),
21         HsIPName(..), hsIPNameFS,
22
23         LBangType, BangType, HsBang(..), 
24         getBangType, getBangStrictness, 
25
26         ConDeclField(..), pprConDeclFields,
27         
28         mkHsQTvs, hsQTvBndrs,
29         mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
30         hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames,
31         hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
32         splitLHsInstDeclTy_maybe,
33         splitHsClassTy_maybe, splitLHsClassTy_maybe,
34         splitHsFunType,
35         splitHsAppTys, mkHsAppTys, mkHsOpTy,
36
37         -- Printing
38         pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context,
39     ) where
40
41 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
42
43 import HsLit
44
45 import NameSet( FreeVars )
46 import Name( Name )
47 import RdrName( RdrName )
48 import DataCon( HsBang(..) )
49 import Type
50 import HsDoc
51 import BasicTypes
52 import SrcLoc
53 import StaticFlags
54 import Outputable
55 import FastString
56
57 import Data.Data
58 \end{code}
59
60
61 %************************************************************************
62 %*                                                                      *
63         Quasi quotes; used in types and elsewhere
64 %*                                                                      *
65 %************************************************************************
66
67 \begin{code}
68 data HsQuasiQuote id = HsQuasiQuote 
69                            id           -- The quasi-quoter
70                            SrcSpan      -- The span of the enclosed string
71                            FastString   -- The enclosed string
72   deriving (Data, Typeable)
73
74 instance OutputableBndr id => Outputable (HsQuasiQuote id) where
75     ppr = ppr_qq
76
77 ppr_qq :: OutputableBndr id => HsQuasiQuote id -> SDoc
78 ppr_qq (HsQuasiQuote quoter _ quote) =
79     char '[' <> ppr quoter <> ptext (sLit "|") <>
80     ppr quote <> ptext (sLit "|]")
81 \end{code}
82
83
84 %************************************************************************
85 %*                                                                      *
86 \subsection{Bang annotations}
87 %*                                                                      *
88 %************************************************************************
89
90 \begin{code}
91 type LBangType name = Located (BangType name)
92 type BangType name  = HsType name       -- Bangs are in the HsType data type
93
94 getBangType :: LHsType a -> LHsType a
95 getBangType (L _ (HsBangTy _ ty)) = ty
96 getBangType ty                    = ty
97
98 getBangStrictness :: LHsType a -> HsBang
99 getBangStrictness (L _ (HsBangTy s _)) = s
100 getBangStrictness _                    = HsNoBang
101 \end{code}
102
103
104 %************************************************************************
105 %*                                                                      *
106 \subsection{Data types}
107 %*                                                                      *
108 %************************************************************************
109
110 This is the syntax for types as seen in type signatures.
111
112 Note [HsBSig binder lists]
113 ~~~~~~~~~~~~~~~~~~~~~~~~~~
114 Consider a binder (or pattern) decoarated with a type or kind, 
115    \ (x :: a -> a). blah
116    forall (a :: k -> *) (b :: k). blah
117 Then we use a LHsBndrSig on the binder, so that the
118 renamer can decorate it with the variables bound
119 by the pattern ('a' in the first example, 'k' in the second),
120 assuming that neither of them is in scope already
121 See also Note [Kind and type-variable binders] in RnTypes
122
123 \begin{code}
124 type LHsContext name = Located (HsContext name)
125
126 type HsContext name = [LHsType name]
127
128 type LHsType name = Located (HsType name)
129 type HsKind name = HsType name
130 type LHsKind name = Located (HsKind name)
131
132 type LHsTyVarBndr name = Located (HsTyVarBndr name)
133
134 data LHsTyVarBndrs name 
135   = HsQTvs { hsq_kvs :: [Name]                  -- Kind variables
136            , hsq_tvs :: [LHsTyVarBndr name]     -- Type variables
137              -- See Note [HsForAllTy tyvar binders]
138     }
139   deriving( Data, Typeable )
140
141 mkHsQTvs :: [LHsTyVarBndr RdrName] -> LHsTyVarBndrs RdrName
142 -- Just at RdrName because in the Name variant we should know just
143 -- what the kind-variable binders are; and we don't
144 -- We put an empty list (rather than a panic) for the kind vars so 
145 -- that the pretty printer works ok on them.
146 mkHsQTvs tvs = HsQTvs { hsq_kvs = [], hsq_tvs = tvs }
147
148 emptyHsQTvs :: LHsTyVarBndrs name   -- Use only when you know there are no kind binders
149 emptyHsQTvs =  HsQTvs { hsq_kvs = [], hsq_tvs = [] }
150
151 hsQTvBndrs :: LHsTyVarBndrs name -> [LHsTyVarBndr name]
152 hsQTvBndrs = hsq_tvs
153
154 data HsWithBndrs thing
155   = HsWB { hswb_cts :: thing           -- Main payload (type or list of types)
156          , hswb_kvs :: [Name]         -- Kind vars
157          , hswb_tvs :: [Name]        -- Type vars
158     }                  
159   deriving (Data, Typeable)
160
161 mkHsWithBndrs :: thing -> HsWithBndrs thing
162 mkHsWithBndrs x = HsWB { hswb_cts = x, hswb_kvs = panic "mkHsTyWithBndrs:kvs"
163                                      , hswb_tvs = panic "mkHsTyWithBndrs:tvs" }
164
165
166 -- | These names are used eary on to store the names of implicit
167 -- parameters.  They completely disappear after type-checking.
168 newtype HsIPName = HsIPName FastString-- ?x
169   deriving( Eq, Data, Typeable )
170
171 hsIPNameFS :: HsIPName -> FastString
172 hsIPNameFS (HsIPName n) = n
173
174 instance Outputable HsIPName where
175     ppr (HsIPName n) = char '?' <> ftext n -- Ordinary implicit parameters
176
177 instance OutputableBndr HsIPName where
178     pprBndr _ n   = ppr n         -- Simple for now
179     pprInfixOcc  n = ppr n
180     pprPrefixOcc n = ppr n
181
182
183 data HsTyVarBndr name
184   = UserTyVar           -- No explicit kinding
185          name           -- See Note [Printing KindedTyVars]
186
187   | KindedTyVar
188          name
189          (LHsKind name)   -- The user-supplied kind signature
190       --  *** NOTA BENE *** A "monotype" in a pragma can have
191       -- for-alls in it, (mostly to do with dictionaries).  These
192       -- must be explicitly Kinded.
193   deriving (Data, Typeable)
194
195
196 data HsType name
197   = HsForAllTy  HsExplicitFlag          -- Renamer leaves this flag unchanged, to record the way
198                                         -- the user wrote it originally, so that the printer can
199                                         -- print it as the user wrote it
200                 (LHsTyVarBndrs name) 
201                 (LHsContext name)
202                 (LHsType name)
203
204   | HsTyVar             name            -- Type variable, type constructor, or data constructor
205                                         -- see Note [Promotions (HsTyVar)]
206
207   | HsAppTy             (LHsType name)
208                         (LHsType name)
209
210   | HsFunTy             (LHsType name)   -- function type
211                         (LHsType name)
212
213   | HsListTy            (LHsType name)  -- Element type
214
215   | HsPArrTy            (LHsType name)  -- Elem. type of parallel array: [:t:]
216
217   | HsTupleTy           HsTupleSort
218                         [LHsType name]  -- Element types (length gives arity)
219
220   | HsOpTy              (LHsType name) (LHsTyOp name) (LHsType name)
221
222   | HsParTy             (LHsType name)   -- See Note [Parens in HsSyn] in HsExpr
223         -- Parenthesis preserved for the precedence re-arrangement in RnTypes
224         -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
225
226   | HsIParamTy          HsIPName         -- (?x :: ty)
227                         (LHsType name)   -- Implicit parameters as they occur in contexts
228
229   | HsEqTy              (LHsType name)   -- ty1 ~ ty2
230                         (LHsType name)   -- Always allowed even without TypeOperators, and has special kinding rule
231
232   | HsKindSig           (LHsType name)  -- (ty :: kind)
233                         (LHsKind name)  -- A type with a kind signature
234
235   | HsQuasiQuoteTy      (HsQuasiQuote name)
236
237   | HsSpliceTy          (HsSplice name) 
238                         FreeVars        -- Variables free in the splice (filled in by renamer)
239                         PostTcKind
240
241   | HsDocTy             (LHsType name) LHsDocString -- A documented type
242
243   | HsBangTy    HsBang (LHsType name)   -- Bang-style type annotations 
244   | HsRecTy [ConDeclField name]         -- Only in data type declarations
245
246   | HsCoreTy Type       -- An escape hatch for tunnelling a *closed* 
247                         -- Core Type through HsSyn.  
248
249   | HsExplicitListTy     -- A promoted explicit list
250         PostTcKind       -- See Note [Promoted lists and tuples]
251         [LHsType name]   
252                          
253   | HsExplicitTupleTy    -- A promoted explicit tuple
254         [PostTcKind]     -- See Note [Promoted lists and tuples]
255         [LHsType name]   
256
257   | HsTyLit HsTyLit      -- A promoted numeric literal.
258
259   | HsWrapTy HsTyWrapper (HsType name)  -- only in typechecker output
260   deriving (Data, Typeable)
261
262
263 data HsTyLit
264   = HsNumTy Integer
265   | HsStrTy FastString
266     deriving (Data, Typeable)
267
268 data HsTyWrapper
269   = WpKiApps [Kind]  -- kind instantiation: [] k1 k2 .. kn
270   deriving (Data, Typeable)
271
272 type LHsTyOp name = HsTyOp (Located name)
273 type HsTyOp name = (HsTyWrapper, name)
274
275 mkHsOpTy :: LHsType name -> Located name -> LHsType name -> HsType name
276 mkHsOpTy ty1 op ty2 = HsOpTy ty1 (WpKiApps [], op) ty2
277 \end{code}
278
279 Note [HsForAllTy tyvar binders]
280 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
281 After parsing:
282   * Implicit => empty
283     Explicit => the varibles the user wrote
284
285 After renaming
286   * Implicit => the *type* variables free in the type
287     Explicit => the variables the user wrote (renamed)
288
289 The kind variables bound in the hsq_kvs field come both
290   a) from the kind signatures on the kind vars (eg k1)
291   b) from the scope of the forall (eg k2)
292 Example:   f :: forall (a::k1) b. T a (b::k2)
293
294
295 Note [Unit tuples]
296 ~~~~~~~~~~~~~~~~~~
297 Consider the type
298     type instance F Int = ()
299 We want to parse that "()" 
300     as HsTupleTy HsBoxedOrConstraintTuple [], 
301 NOT as HsTyVar unitTyCon
302
303 Why? Because F might have kind (* -> Constraint), so we when parsing we
304 don't know if that tuple is going to be a constraint tuple or an ordinary
305 unit tuple.  The HsTupleSort flag is specifically designed to deal with
306 that, but it has to work for unit tuples too.
307
308 Note [Promotions (HsTyVar)]
309 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
310 HsTyVar: A name in a type or kind.
311   Here are the allowed namespaces for the name.
312     In a type:
313       Var: not allowed
314       Data: promoted data constructor
315       Tv: type variable
316       TcCls before renamer: type constructor, class constructor, or promoted data constructor
317       TcCls after renamer: type constructor or class constructor
318     In a kind:
319       Var, Data: not allowed
320       Tv: kind variable
321       TcCls: kind constructor or promoted type constructor
322
323
324 Note [Promoted lists and tuples]
325 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
326 Notice the difference between
327    HsListTy    HsExplicitListTy
328    HsTupleTy   HsExplicitListTupleTy
329
330 E.g.    f :: [Int]                      HsListTy                
331
332         g3  :: T '[]                   All these use  
333         g2  :: T '[True]                  HsExplicitListTy        
334         g1  :: T '[True,False]          
335         g1a :: T [True,False]             (can omit ' where unambiguous)
336
337   kind of T :: [Bool] -> *        This kind uses HsListTy!
338
339 E.g.    h :: (Int,Bool)                 HsTupleTy; f is a pair               
340         k :: S '(True,False)            HsExplicitTypleTy; S is indexed by   
341                                            a type-level pair of booleans 
342         kind of S :: (Bool,Bool) -> *   This kind uses HsExplicitTupleTy
343
344 Note [Distinguishing tuple kinds]
345 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
346
347 Apart from promotion, tuples can have one of three different kinds:
348
349         x :: (Int, Bool)                -- Regular boxed tuples
350         f :: Int# -> (# Int#, Int# #)   -- Unboxed tuples
351         g :: (Eq a, Ord a) => a         -- Constraint tuples
352
353 For convenience, internally we use a single constructor for all of these,
354 namely HsTupleTy, but keep track of the tuple kind (in the first argument to
355 HsTupleTy, a HsTupleSort). We can tell if a tuple is unboxed while parsing,
356 because of the #. However, with -XConstraintKinds we can only distinguish
357 between constraint and boxed tuples during type checking, in general. Hence the
358 four constructors of HsTupleSort:
359         
360         HsUnboxedTuple                  -> Produced by the parser
361         HsBoxedTuple                    -> Certainly a boxed tuple
362         HsConstraintTuple               -> Certainly a constraint tuple
363         HsBoxedOrConstraintTuple        -> Could be a boxed or a constraint 
364                                         tuple. Produced by the parser only,
365                                         disappears after type checking
366
367 \begin{code}
368 data HsTupleSort = HsUnboxedTuple
369                  | HsBoxedTuple
370                  | HsConstraintTuple
371                  | HsBoxedOrConstraintTuple
372                  deriving (Data, Typeable)
373
374 data HsExplicitFlag = Explicit | Implicit deriving (Data, Typeable)
375
376 data ConDeclField name  -- Record fields have Haddoc docs on them
377   = ConDeclField { cd_fld_name :: Located name,
378                    cd_fld_type :: LBangType name, 
379                    cd_fld_doc  :: Maybe LHsDocString }
380   deriving (Data, Typeable)
381
382 -----------------------
383 -- Combine adjacent for-alls. 
384 -- The following awkward situation can happen otherwise:
385 --      f :: forall a. ((Num a) => Int)
386 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
387 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
388 -- but the export list abstracts f wrt [a].  Disaster.
389 --
390 -- A valid type must have one for-all at the top of the type, or of the fn arg types
391
392 mkImplicitHsForAllTy ::                           LHsContext RdrName -> LHsType RdrName -> HsType RdrName
393 mkExplicitHsForAllTy :: [LHsTyVarBndr RdrName] -> LHsContext RdrName -> LHsType RdrName -> HsType RdrName
394 mkImplicitHsForAllTy     ctxt ty = mkHsForAllTy Implicit []  ctxt ty
395 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
396
397 mkHsForAllTy :: HsExplicitFlag -> [LHsTyVarBndr RdrName] -> LHsContext RdrName -> LHsType RdrName -> HsType RdrName
398 -- Smart constructor for HsForAllTy
399 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
400 mkHsForAllTy exp tvs ctxt     ty = HsForAllTy exp (mkHsQTvs tvs) ctxt ty
401
402 -- mk_forall_ty makes a pure for-all type (no context)
403 mk_forall_ty :: HsExplicitFlag -> [LHsTyVarBndr RdrName] -> LHsType RdrName -> HsType RdrName
404 mk_forall_ty exp  tvs  (L _ (HsParTy ty))                    = mk_forall_ty exp tvs ty
405 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 qtvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ hsq_tvs qtvs2) ctxt ty
406 mk_forall_ty exp  tvs  ty                                    = HsForAllTy exp (mkHsQTvs tvs) (noLoc []) ty
407         -- Even if tvs is empty, we still make a HsForAll!
408         -- In the Implicit case, this signals the place to do implicit quantification
409         -- In the Explicit case, it prevents implicit quantification    
410         --      (see the sigtype production in Parser.y.pp)
411         --      so that (forall. ty) isn't implicitly quantified
412
413 plus :: HsExplicitFlag -> HsExplicitFlag -> HsExplicitFlag
414 Implicit `plus` Implicit = Implicit
415 _        `plus` _        = Explicit
416
417 hsExplicitTvs :: LHsType name -> [name]
418 -- The explicitly-given forall'd type variables of a HsType
419 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
420 hsExplicitTvs _                                   = []
421
422 ---------------------
423 hsTyVarName :: HsTyVarBndr name -> name
424 hsTyVarName (UserTyVar n)     = n
425 hsTyVarName (KindedTyVar n _) = n
426
427 hsLTyVarName :: LHsTyVarBndr name -> name
428 hsLTyVarName = hsTyVarName . unLoc
429
430 hsLTyVarNames :: LHsTyVarBndrs name -> [name]
431 -- Type variables only
432 hsLTyVarNames qtvs = map hsLTyVarName (hsQTvBndrs qtvs)
433
434 hsLKiTyVarNames :: LHsTyVarBndrs Name -> [Name]
435 -- Kind and type variables
436 hsLKiTyVarNames (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs })
437   = kvs ++ map hsLTyVarName tvs
438
439 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
440 hsLTyVarLocName = fmap hsTyVarName
441
442 hsLTyVarLocNames :: LHsTyVarBndrs name -> [Located name]
443 hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvBndrs qtvs)
444 \end{code}
445
446
447 \begin{code}
448 splitHsAppTys :: LHsType n -> [LHsType n] -> (LHsType n, [LHsType n])
449 splitHsAppTys (L _ (HsAppTy f a)) as = splitHsAppTys f (a:as)
450 splitHsAppTys f                   as = (f,as)
451
452 mkHsAppTys :: OutputableBndr n => LHsType n -> [LHsType n] -> HsType n
453 mkHsAppTys fun_ty [] = pprPanic "mkHsAppTys" (ppr fun_ty)
454 mkHsAppTys fun_ty (arg_ty:arg_tys)
455   = foldl mk_app (HsAppTy fun_ty arg_ty) arg_tys
456   where
457     mk_app fun arg = HsAppTy (noLoc fun) arg    
458        -- Add noLocs for inner nodes of the application; 
459        -- they are never used 
460
461 splitLHsInstDeclTy_maybe
462     :: LHsType name 
463     -> Maybe (LHsTyVarBndrs name, HsContext name, Located name, [LHsType name])
464         -- Split up an instance decl type, returning the pieces
465 splitLHsInstDeclTy_maybe inst_ty = do
466     let (tvs, cxt, ty) = splitLHsForAllTy inst_ty
467     (cls, tys) <- splitLHsClassTy_maybe ty
468     return (tvs, cxt, cls, tys)
469
470 splitLHsForAllTy
471     :: LHsType name 
472     -> (LHsTyVarBndrs name, HsContext name, LHsType name)
473 splitLHsForAllTy poly_ty
474   = case unLoc poly_ty of
475         HsParTy ty              -> splitLHsForAllTy ty
476         HsForAllTy _ tvs cxt ty -> (tvs, unLoc cxt, ty)
477         _                       -> (emptyHsQTvs, [], poly_ty)
478         -- The type vars should have been computed by now, even if they were implicit
479
480 splitHsClassTy_maybe :: HsType name -> Maybe (name, [LHsType name])
481 splitHsClassTy_maybe ty = fmap (\(L _ n, tys) -> (n, tys)) $ splitLHsClassTy_maybe (noLoc ty)
482
483 splitLHsClassTy_maybe :: LHsType name -> Maybe (Located name, [LHsType name])
484 --- Watch out.. in ...deriving( Show )... we use this on 
485 --- the list of partially applied predicates in the deriving,
486 --- so there can be zero args.
487
488 -- In TcDeriv we also use this to figure out what data type is being
489 -- mentioned in a deriving (Generic (Foo bar baz)) declaration (i.e. "Foo").
490 splitLHsClassTy_maybe ty
491   = checkl ty []
492   where
493     checkl (L l ty) args = case ty of
494         HsTyVar t          -> Just (L l t, args)
495         HsAppTy l r        -> checkl l (r:args)
496         HsOpTy l (_, tc) r -> checkl (fmap HsTyVar tc) (l:r:args)
497         HsParTy t          -> checkl t args
498         HsKindSig ty _     -> checkl ty args
499         _                  -> Nothing
500
501 -- Splits HsType into the (init, last) parts
502 -- Breaks up any parens in the result type: 
503 --      splitHsFunType (a -> (b -> c)) = ([a,b], c)
504 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
505 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
506   where
507   (args, res) = splitHsFunType y
508 splitHsFunType (L _ (HsParTy ty))  = splitHsFunType ty
509 splitHsFunType other               = ([], other)
510 \end{code}
511
512
513 %************************************************************************
514 %*                                                                      *
515 \subsection{Pretty printing}
516 %*                                                                      *
517 %************************************************************************
518
519 \begin{code}
520 instance (OutputableBndr name) => Outputable (HsType name) where
521     ppr ty = pprHsType ty
522
523 instance Outputable HsTyLit where
524     ppr = ppr_tylit
525
526 instance (OutputableBndr name) => Outputable (LHsTyVarBndrs name) where
527     ppr (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs }) 
528       = sep [ ifPprDebug $ braces (interppSP kvs), interppSP tvs ]
529
530 instance (OutputableBndr name) => Outputable (HsTyVarBndr name) where
531     ppr (UserTyVar name)        = ppr name
532     ppr (KindedTyVar name kind) = parens $ hsep [ppr name, dcolon, ppr kind]
533
534 instance (Outputable thing) => Outputable (HsWithBndrs thing) where
535     ppr (HsWB { hswb_cts = ty }) = ppr ty
536
537 pprHsForAll :: OutputableBndr name => HsExplicitFlag -> LHsTyVarBndrs name ->  LHsContext name -> SDoc
538 pprHsForAll exp qtvs cxt 
539   | show_forall = forall_part <+> pprHsContext (unLoc cxt)
540   | otherwise   = pprHsContext (unLoc cxt)
541   where
542     show_forall =  opt_PprStyle_Debug
543                 || (not (null (hsQTvBndrs qtvs)) && is_explicit)
544     is_explicit = case exp of {Explicit -> True; Implicit -> False}
545     forall_part = ptext (sLit "forall") <+> ppr qtvs <> dot
546
547 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
548 pprHsContext []         = empty
549 pprHsContext [L _ pred] = ppr pred <+> darrow
550 pprHsContext cxt        = ppr_hs_context cxt <+> darrow
551
552 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
553 ppr_hs_context []  = empty
554 ppr_hs_context cxt = parens (interpp'SP cxt)
555
556 pprConDeclFields :: OutputableBndr name => [ConDeclField name] -> SDoc
557 pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
558   where
559     ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty, 
560                             cd_fld_doc = doc })
561         = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
562 \end{code}
563
564 Note [Printing KindedTyVars]
565 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
566 Trac #3830 reminded me that we should really only print the kind
567 signature on a KindedTyVar if the kind signature was put there by the
568 programmer.  During kind inference GHC now adds a PostTcKind to UserTyVars,
569 rather than converting to KindedTyVars as before.
570
571 (As it happens, the message in #3830 comes out a different way now,
572 and the problem doesn't show up; but having the flag on a KindedTyVar
573 seems like the Right Thing anyway.)
574
575 \begin{code}
576 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
577 pREC_TOP = 0  -- type   in ParseIface.y
578 pREC_FUN = 1  -- btype  in ParseIface.y
579               -- Used for LH arg of (->)
580 pREC_OP  = 2  -- Used for arg of any infix operator
581               -- (we don't keep their fixities around)
582 pREC_CON = 3  -- Used for arg of type applicn:
583               -- always parenthesise unless atomic
584
585 maybeParen :: Int       -- Precedence of context
586            -> Int       -- Precedence of top-level operator
587            -> SDoc -> SDoc      -- Wrap in parens if (ctxt >= op)
588 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
589                                | otherwise            = p
590         
591 -- printing works more-or-less as for Types
592
593 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
594
595 pprHsType ty       = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
596 pprParendHsType ty = ppr_mono_ty pREC_CON ty
597
598 -- Before printing a type
599 -- (a) Remove outermost HsParTy parens
600 -- (b) Drop top-level for-all type variables in user style
601 --     since they are implicit in Haskell
602 prepare :: PprStyle -> HsType name -> HsType name
603 prepare sty (HsParTy ty)          = prepare sty (unLoc ty)
604 prepare _   ty                    = ty
605
606 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
607 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
608
609 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
610 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
611   = maybeParen ctxt_prec pREC_FUN $
612     sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
613
614 ppr_mono_ty _    (HsBangTy b ty)     = ppr b <> ppr_mono_lty pREC_CON ty
615 ppr_mono_ty _    (HsQuasiQuoteTy qq) = ppr qq
616 ppr_mono_ty _    (HsRecTy flds)      = pprConDeclFields flds
617 ppr_mono_ty _    (HsTyVar name)      = ppr name
618 ppr_mono_ty prec (HsFunTy ty1 ty2)   = ppr_fun_ty prec ty1 ty2
619 ppr_mono_ty _    (HsTupleTy con tys) = tupleParens std_con (interpp'SP tys)
620   where std_con = case con of
621                     HsUnboxedTuple -> UnboxedTuple
622                     _              -> BoxedTuple
623 ppr_mono_ty _    (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> ppr kind)
624 ppr_mono_ty _    (HsListTy ty)       = brackets (ppr_mono_lty pREC_TOP ty)
625 ppr_mono_ty _    (HsPArrTy ty)       = paBrackets (ppr_mono_lty pREC_TOP ty)
626 ppr_mono_ty prec (HsIParamTy n ty)   = maybeParen prec pREC_FUN (ppr n <+> dcolon <+> ppr_mono_lty pREC_TOP ty)
627 ppr_mono_ty _    (HsSpliceTy s _ _)  = pprSplice s
628 ppr_mono_ty _    (HsCoreTy ty)       = ppr ty
629 ppr_mono_ty _    (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
630 ppr_mono_ty _    (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys)
631 ppr_mono_ty _    (HsTyLit t)         = ppr_tylit t
632
633 ppr_mono_ty ctxt_prec (HsWrapTy (WpKiApps _kis) ty)
634   = ppr_mono_ty ctxt_prec ty
635 -- We are not printing kind applications. If we wanted to do so, we should do
636 -- something like this:
637 {-
638   = go ctxt_prec kis ty
639   where
640     go ctxt_prec [] ty = ppr_mono_ty ctxt_prec ty
641     go ctxt_prec (ki:kis) ty
642       = maybeParen ctxt_prec pREC_CON $
643         hsep [ go pREC_FUN kis ty
644              , ptext (sLit "@") <> pprParendKind ki ]
645 -}
646
647 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2)
648   = maybeParen ctxt_prec pREC_OP $
649     ppr_mono_lty pREC_OP ty1 <+> char '~' <+> ppr_mono_lty pREC_OP ty2
650
651 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
652   = maybeParen ctxt_prec pREC_CON $
653     hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
654
655 ppr_mono_ty ctxt_prec (HsOpTy ty1 (_wrapper, L _ op) ty2)
656   = maybeParen ctxt_prec pREC_OP $
657     sep [ ppr_mono_lty pREC_OP ty1
658         , sep [pprInfixOcc op, ppr_mono_lty pREC_OP ty2 ] ]
659     -- Don't print the wrapper (= kind applications)
660     -- c.f. HsWrapTy
661
662 ppr_mono_ty _         (HsParTy ty)
663   = parens (ppr_mono_lty pREC_TOP ty)
664   -- Put the parens in where the user did
665   -- But we still use the precedence stuff to add parens because
666   --    toHsType doesn't put in any HsParTys, so we may still need them
667
668 ppr_mono_ty ctxt_prec (HsDocTy ty doc) 
669   = maybeParen ctxt_prec pREC_OP $
670     ppr_mono_lty pREC_OP ty <+> ppr (unLoc doc)
671   -- we pretty print Haddock comments on types as if they were
672   -- postfix operators
673
674 --------------------------
675 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
676 ppr_fun_ty ctxt_prec ty1 ty2
677   = let p1 = ppr_mono_lty pREC_FUN ty1
678         p2 = ppr_mono_lty pREC_TOP ty2
679     in
680     maybeParen ctxt_prec pREC_FUN $
681     sep [p1, ptext (sLit "->") <+> p2]
682
683 --------------------------
684 ppr_tylit :: HsTyLit -> SDoc
685 ppr_tylit (HsNumTy i) = integer i
686 ppr_tylit (HsStrTy s) = text (show s)
687 \end{code}
688
689