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