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