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