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