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