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