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