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