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