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