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