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