HsTypes.hs 35.8 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

5 6

HsTypes: Abstract syntax: user-defined types
Austin Seipp's avatar
Austin Seipp committed
7
-}
8

9
{-# LANGUAGE DeriveDataTypeable #-}
10 11 12 13 14 15 16
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
                                      -- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
17

18
module HsTypes (
Simon Peyton Jones's avatar
Simon Peyton Jones committed
19
        HsType(..), LHsType, HsKind, LHsKind,
20
        HsTyOp,LHsTyOp,
Austin Seipp's avatar
Austin Seipp committed
21
        HsTyVarBndr(..), LHsTyVarBndr,
22 23
        LHsTyVarBndrs(..),
        HsWithBndrs(..),
Simon Peyton Jones's avatar
Simon Peyton Jones committed
24 25
        HsTupleSort(..), HsExplicitFlag(..),
        HsContext, LHsContext,
dreixel's avatar
dreixel committed
26
        HsTyWrapper(..),
27
        HsTyLit(..),
28
        HsIPName(..), hsIPNameFS,
29

Simon Peyton Jones's avatar
Simon Peyton Jones committed
30
        LBangType, BangType, HsBang(..), HsSrcBang, HsImplBang,
Austin Seipp's avatar
Austin Seipp committed
31
        getBangType, getBangStrictness,
32

33
        ConDeclField(..), LConDeclField, pprConDeclFields,
Austin Seipp's avatar
Austin Seipp committed
34

35
        mkHsQTvs, hsQTvBndrs, isHsKindedTyVar, hsTvbAllKinded,
36 37
        mkExplicitHsForAllTy, mkImplicitHsForAllTy, mkQualifiedHsForAllTy,
        hsExplicitTvs,
38
        hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
39
        hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
40
        splitLHsInstDeclTy_maybe,
batterseapower's avatar
batterseapower committed
41 42
        splitHsClassTy_maybe, splitLHsClassTy_maybe,
        splitHsFunType,
43
        splitHsAppTys, hsTyGetAppHead_maybe, mkHsAppTys, mkHsOpTy,
thomasw's avatar
thomasw committed
44
        isWildcardTy, isNamedWildcardTy,
45

Simon Peyton Jones's avatar
Simon Peyton Jones committed
46
        -- Printing
thomasw's avatar
thomasw committed
47
        pprParendHsType, pprHsForAll, pprHsForAllExtra,
48
        pprHsContext, pprHsContextNoArrow, pprHsContextMaybe
49 50
    ) where

51
import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
52

53
import PlaceHolder ( PostTc,PostRn,DataId,PlaceHolder(..) )
dreixel's avatar
dreixel committed
54

55
import Name( Name )
56
import RdrName( RdrName )
Simon Peyton Jones's avatar
Simon Peyton Jones committed
57
import DataCon( HsBang(..), HsSrcBang, HsImplBang )
58
import TysPrim( funTyConName )
59 60 61 62 63
import Type
import HsDoc
import BasicTypes
import SrcLoc
import StaticFlags
64
import Outputable
65
import FastString
thomasw's avatar
thomasw committed
66
import Maybes( isJust )
67

68
import Data.Data hiding ( Fixity )
69
import Data.Maybe ( fromMaybe )
70

Austin Seipp's avatar
Austin Seipp committed
71 72 73
{-
************************************************************************
*                                                                      *
74
\subsection{Bang annotations}
Austin Seipp's avatar
Austin Seipp committed
75 76 77
*                                                                      *
************************************************************************
-}
78 79

type LBangType name = Located (BangType name)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
80
type BangType name  = HsType name       -- Bangs are in the HsType data type
81 82 83 84 85

getBangType :: LHsType a -> LHsType a
getBangType (L _ (HsBangTy _ ty)) = ty
getBangType ty                    = ty

Simon Peyton Jones's avatar
Simon Peyton Jones committed
86
getBangStrictness :: LHsType a -> HsSrcBang
87 88
getBangStrictness (L _ (HsBangTy s _)) = s
getBangStrictness _                    = HsNoBang
89

Austin Seipp's avatar
Austin Seipp committed
90 91 92
{-
************************************************************************
*                                                                      *
93
\subsection{Data types}
Austin Seipp's avatar
Austin Seipp committed
94 95
*                                                                      *
************************************************************************
96

97 98
This is the syntax for types as seen in type signatures.

99 100
Note [HsBSig binder lists]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
101
Consider a binder (or pattern) decoarated with a type or kind,
102 103 104 105 106 107 108
   \ (x :: a -> a). blah
   forall (a :: k -> *) (b :: k). blah
Then we use a LHsBndrSig on the binder, so that the
renamer can decorate it with the variables bound
by the pattern ('a' in the first example, 'k' in the second),
assuming that neither of them is in scope already
See also Note [Kind and type-variable binders] in RnTypes
Austin Seipp's avatar
Austin Seipp committed
109
-}
110

111
type LHsContext name = Located (HsContext name)
Alan Zimmerman's avatar
Alan Zimmerman committed
112
      -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnUnit'
113

114 115
      -- For details on above see note [Api annotations] in ApiAnnotation

batterseapower's avatar
batterseapower committed
116
type HsContext name = [LHsType name]
117

118
type LHsType name = Located (HsType name)
Alan Zimmerman's avatar
Alan Zimmerman committed
119 120
      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
      --   in a list
121 122

      -- For details on above see note [Api annotations] in ApiAnnotation
dreixel's avatar
dreixel committed
123 124
type HsKind name = HsType name
type LHsKind name = Located (HsKind name)
125 126 127
      -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'

      -- For details on above see note [Api annotations] in ApiAnnotation
128

129 130 131 132
--------------------------------------------------
--             LHsTyVarBndrs
--  The quantified binders in a HsForallTy

133 134
type LHsTyVarBndr name = Located (HsTyVarBndr name)

135
data LHsTyVarBndrs name
136 137 138 139
  = HsQTvs { hsq_kvs :: [Name]                  -- Kind variables
           , hsq_tvs :: [LHsTyVarBndr name]     -- Type variables
             -- See Note [HsForAllTy tyvar binders]
    }
140 141
  deriving( Typeable )
deriving instance (DataId name) => Data (LHsTyVarBndrs name)
142

143 144 145
mkHsQTvs :: [LHsTyVarBndr RdrName] -> LHsTyVarBndrs RdrName
-- Just at RdrName because in the Name variant we should know just
-- what the kind-variable binders are; and we don't
146
-- We put an empty list (rather than a panic) for the kind vars so
147 148
-- that the pretty printer works ok on them.
mkHsQTvs tvs = HsQTvs { hsq_kvs = [], hsq_tvs = tvs }
149

150 151 152
emptyHsQTvs :: LHsTyVarBndrs name   -- Use only when you know there are no kind binders
emptyHsQTvs =  HsQTvs { hsq_kvs = [], hsq_tvs = [] }

153 154 155
hsQTvBndrs :: LHsTyVarBndrs name -> [LHsTyVarBndr name]
hsQTvBndrs = hsq_tvs

156 157 158 159 160 161 162 163 164
------------------------------------------------
--            HsWithBndrs
-- Used to quantify the binders of a type in cases
-- when a HsForAll isn't appropriate:
--    * Patterns in a type/data family instance (HsTyPats)
--    * Type of a rule binder (RuleBndr)
--    * Pattern type signatures (SigPatIn)
-- In the last of these, wildcards can happen, so we must accommodate them

165 166 167 168
data HsWithBndrs name thing
  = HsWB { hswb_cts :: thing             -- Main payload (type or list of types)
         , hswb_kvs :: PostRn name [Name] -- Kind vars
         , hswb_tvs :: PostRn name [Name] -- Type vars
thomasw's avatar
thomasw committed
169
         , hswb_wcs :: PostRn name [Name] -- Wildcards
170 171 172 173
    }
  deriving (Typeable)
deriving instance (Data name, Data thing, Data (PostRn name [Name]))
  => Data (HsWithBndrs name thing)
174

175 176
mkHsWithBndrs :: thing -> HsWithBndrs RdrName thing
mkHsWithBndrs x = HsWB { hswb_cts = x, hswb_kvs = PlaceHolder
thomasw's avatar
thomasw committed
177 178
                                     , hswb_tvs = PlaceHolder
                                     , hswb_wcs = PlaceHolder }
179

180

181
--------------------------------------------------
Mateusz Kowalczyk's avatar
Typo  
Mateusz Kowalczyk committed
182
-- | These names are used early on to store the names of implicit
183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
-- parameters.  They completely disappear after type-checking.
newtype HsIPName = HsIPName FastString-- ?x
  deriving( Eq, Data, Typeable )

hsIPNameFS :: HsIPName -> FastString
hsIPNameFS (HsIPName n) = n

instance Outputable HsIPName where
    ppr (HsIPName n) = char '?' <> ftext n -- Ordinary implicit parameters

instance OutputableBndr HsIPName where
    pprBndr _ n   = ppr n         -- Simple for now
    pprInfixOcc  n = ppr n
    pprPrefixOcc n = ppr n

198
--------------------------------------------------
199
data HsTyVarBndr name
200 201 202 203
  = UserTyVar        -- no explicit kinding
         name

  | KindedTyVar
Alan Zimmerman's avatar
Alan Zimmerman committed
204
         (Located name)
205
         (LHsKind name)  -- The user-supplied kind signature
Alan Zimmerman's avatar
Alan Zimmerman committed
206 207 208
        -- ^
        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
        --          'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnClose'
209 210

        -- For details on above see note [Api annotations] in ApiAnnotation
211 212
  deriving (Typeable)
deriving instance (DataId name) => Data (HsTyVarBndr name)
213

214 215 216 217 218
-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
isHsKindedTyVar :: HsTyVarBndr name -> Bool
isHsKindedTyVar (UserTyVar {})   = False
isHsKindedTyVar (KindedTyVar {}) = True

219 220 221 222
-- | Do all type variables in this 'LHsTyVarBndr' come with kind annotations?
hsTvbAllKinded :: LHsTyVarBndrs name -> Bool
hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvBndrs

223
data HsType name
Simon Peyton Jones's avatar
Simon Peyton Jones committed
224 225 226
  = HsForAllTy  HsExplicitFlag          -- Renamer leaves this flag unchanged, to record the way
                                        -- the user wrote it originally, so that the printer can
                                        -- print it as the user wrote it
thomasw's avatar
thomasw committed
227 228 229 230 231 232 233
                (Maybe SrcSpan)         -- Indicates whether extra constraints may be inferred.
                                        -- When Nothing, no, otherwise the location of the extra-
                                        -- constraints wildcard is stored. For instance, for the
                                        -- signature (Eq a, _) => a -> a -> Bool, this field would
                                        -- be something like (Just 1:8), with 1:8 being line 1,
                                        -- column 8.
                (LHsTyVarBndrs name)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
234 235
                (LHsContext name)
                (LHsType name)
Alan Zimmerman's avatar
Alan Zimmerman committed
236 237
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForall',
      --         'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
Alan Zimmerman's avatar
Alan Zimmerman committed
238

239 240
      -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
241
  | HsTyVar             name            -- Type variable, type constructor, or data constructor
dreixel's avatar
dreixel committed
242
                                        -- see Note [Promotions (HsTyVar)]
Alan Zimmerman's avatar
Alan Zimmerman committed
243
      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
244

245 246
      -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
247 248
  | HsAppTy             (LHsType name)
                        (LHsType name)
Alan Zimmerman's avatar
Alan Zimmerman committed
249
      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
250

251 252
      -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
253 254
  | HsFunTy             (LHsType name)   -- function type
                        (LHsType name)
255
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow',
256

257 258
      -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
259
  | HsListTy            (LHsType name)  -- Element type
Alan Zimmerman's avatar
Alan Zimmerman committed
260 261
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
      --         'ApiAnnotation.AnnClose' @']'@
262

263 264
      -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
265
  | HsPArrTy            (LHsType name)  -- Elem. type of parallel array: [:t:]
Alan Zimmerman's avatar
Alan Zimmerman committed
266 267
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
      --         'ApiAnnotation.AnnClose' @':]'@
chak's avatar
chak committed
268

269 270
      -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
271 272
  | HsTupleTy           HsTupleSort
                        [LHsType name]  -- Element types (length gives arity)
Alan Zimmerman's avatar
Alan Zimmerman committed
273 274
    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(' or '(#'@,
    --         'ApiAnnotation.AnnClose' @')' or '#)'@
275

276 277
    -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
278
  | HsOpTy              (LHsType name) (LHsTyOp name) (LHsType name)
Alan Zimmerman's avatar
Alan Zimmerman committed
279
      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
chak's avatar
chak committed
280

281 282
      -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
283 284 285
  | HsParTy             (LHsType name)   -- See Note [Parens in HsSyn] in HsExpr
        -- Parenthesis preserved for the precedence re-arrangement in RnTypes
        -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
Alan Zimmerman's avatar
Alan Zimmerman committed
286 287
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
      --         'ApiAnnotation.AnnClose' @')'@
chak's avatar
chak committed
288

289 290
      -- For details on above see note [Api annotations] in ApiAnnotation

291
  | HsIParamTy          HsIPName         -- (?x :: ty)
batterseapower's avatar
batterseapower committed
292
                        (LHsType name)   -- Implicit parameters as they occur in contexts
Alan Zimmerman's avatar
Alan Zimmerman committed
293 294 295 296
      -- ^
      -- > (?x :: ty)
      --
      -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
batterseapower's avatar
batterseapower committed
297

298 299
      -- For details on above see note [Api annotations] in ApiAnnotation

batterseapower's avatar
batterseapower committed
300 301
  | HsEqTy              (LHsType name)   -- ty1 ~ ty2
                        (LHsType name)   -- Always allowed even without TypeOperators, and has special kinding rule
Alan Zimmerman's avatar
Alan Zimmerman committed
302 303 304 305
      -- ^
      -- > ty1 ~ ty2
      --
      -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
306

307 308
      -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
309 310
  | HsKindSig           (LHsType name)  -- (ty :: kind)
                        (LHsKind name)  -- A type with a kind signature
Alan Zimmerman's avatar
Alan Zimmerman committed
311 312 313 314 315
      -- ^
      -- > (ty :: kind)
      --
      -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
      --         'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' @')'@
316

317 318
      -- For details on above see note [Api annotations] in ApiAnnotation

319
  | HsSpliceTy          (HsSplice name)   -- Includes quasi-quotes
320
                        (PostTc name Kind)
Alan Zimmerman's avatar
Alan Zimmerman committed
321 322
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,
      --         'ApiAnnotation.AnnClose' @')'@
323

324 325
      -- For details on above see note [Api annotations] in ApiAnnotation

326
  | HsDocTy             (LHsType name) LHsDocString -- A documented type
Alan Zimmerman's avatar
Alan Zimmerman committed
327
      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
328

329 330
      -- For details on above see note [Api annotations] in ApiAnnotation

Simon Peyton Jones's avatar
Simon Peyton Jones committed
331
  | HsBangTy    HsSrcBang (LHsType name)   -- Bang-style type annotations
Alan Zimmerman's avatar
Alan Zimmerman committed
332 333 334 335 336
      -- ^ - 'ApiAnnotation.AnnKeywordId' :
      --         'ApiAnnotation.AnnOpen' @'{-\# UNPACK' or '{-\# NOUNPACK'@,
      --         'ApiAnnotation.AnnClose' @'#-}'@
      --         'ApiAnnotation.AnnBang' @\'!\'@

337 338
      -- For details on above see note [Api annotations] in ApiAnnotation

Alan Zimmerman's avatar
Alan Zimmerman committed
339 340 341
  | HsRecTy     [LConDeclField name]    -- Only in data type declarations
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
      --         'ApiAnnotation.AnnClose' @'}'@
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
342

343 344
      -- For details on above see note [Api annotations] in ApiAnnotation

Austin Seipp's avatar
Austin Seipp committed
345 346
  | HsCoreTy Type       -- An escape hatch for tunnelling a *closed*
                        -- Core Type through HsSyn.
Alan Zimmerman's avatar
Alan Zimmerman committed
347
      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
dreixel's avatar
dreixel committed
348

349 350
      -- For details on above see note [Api annotations] in ApiAnnotation

351 352
  | HsExplicitListTy       -- A promoted explicit list
        (PostTc name Kind) -- See Note [Promoted lists and tuples]
353
        [LHsType name]
Alan Zimmerman's avatar
Alan Zimmerman committed
354 355
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'["@,
      --         'ApiAnnotation.AnnClose' @']'@
356

357 358
      -- For details on above see note [Api annotations] in ApiAnnotation

359 360
  | HsExplicitTupleTy      -- A promoted explicit tuple
        [PostTc name Kind] -- See Note [Promoted lists and tuples]
361
        [LHsType name]
Alan Zimmerman's avatar
Alan Zimmerman committed
362 363
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'("@,
      --         'ApiAnnotation.AnnClose' @')'@
dreixel's avatar
dreixel committed
364

365 366
      -- For details on above see note [Api annotations] in ApiAnnotation

367
  | HsTyLit HsTyLit      -- A promoted numeric literal.
Alan Zimmerman's avatar
Alan Zimmerman committed
368
      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
369

370 371
      -- For details on above see note [Api annotations] in ApiAnnotation

dreixel's avatar
dreixel committed
372
  | HsWrapTy HsTyWrapper (HsType name)  -- only in typechecker output
Alan Zimmerman's avatar
Alan Zimmerman committed
373
      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
thomasw's avatar
thomasw committed
374

375 376
      -- For details on above see note [Api annotations] in ApiAnnotation

thomasw's avatar
thomasw committed
377
  | HsWildcardTy           -- A type wildcard
Alan Zimmerman's avatar
Alan Zimmerman committed
378
      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
thomasw's avatar
thomasw committed
379

380 381
      -- For details on above see note [Api annotations] in ApiAnnotation

thomasw's avatar
thomasw committed
382
  | HsNamedWildcardTy name -- A named wildcard
Alan Zimmerman's avatar
Alan Zimmerman committed
383
      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
384 385

      -- For details on above see note [Api annotations] in ApiAnnotation
386 387
  deriving (Typeable)
deriving instance (DataId name) => Data (HsType name)
dreixel's avatar
dreixel committed
388

389
-- Note [Literal source text] in BasicTypes for SourceText fields in
Alan Zimmerman's avatar
Alan Zimmerman committed
390
-- the following
391
data HsTyLit
Alan Zimmerman's avatar
Alan Zimmerman committed
392 393
  = HsNumTy SourceText Integer
  | HsStrTy SourceText FastString
394 395
    deriving (Data, Typeable)

dreixel's avatar
dreixel committed
396 397
data HsTyWrapper
  = WpKiApps [Kind]  -- kind instantiation: [] k1 k2 .. kn
398
  deriving (Data, Typeable)
399

dreixel's avatar
dreixel committed
400 401 402 403 404 405
type LHsTyOp name = HsTyOp (Located name)
type HsTyOp name = (HsTyWrapper, name)

mkHsOpTy :: LHsType name -> Located name -> LHsType name -> HsType name
mkHsOpTy ty1 op ty2 = HsOpTy ty1 (WpKiApps [], op) ty2

Austin Seipp's avatar
Austin Seipp committed
406
{-
407 408 409 410
Note [HsForAllTy tyvar binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
After parsing:
  * Implicit => empty
411
    Explicit => the variables the user wrote
412 413 414 415 416

After renaming
  * Implicit => the *type* variables free in the type
    Explicit => the variables the user wrote (renamed)

417 418 419
Qualified currently behaves exactly as Implicit,
but it is deprecated to use it for implicit quantification.
In this case, GHC 7.10 gives a warning; see
Simon Peyton Jones's avatar
Simon Peyton Jones committed
420
Note [Context quantification] in RnTypes, and Trac #4426.
421 422 423
In GHC 7.12, Qualified will no longer bind variables
and this will become an error.

424 425 426 427 428
The kind variables bound in the hsq_kvs field come both
  a) from the kind signatures on the kind vars (eg k1)
  b) from the scope of the forall (eg k2)
Example:   f :: forall (a::k1) b. T a (b::k2)

429

430 431 432 433
Note [Unit tuples]
~~~~~~~~~~~~~~~~~~
Consider the type
    type instance F Int = ()
Austin Seipp's avatar
Austin Seipp committed
434 435
We want to parse that "()"
    as HsTupleTy HsBoxedOrConstraintTuple [],
436 437 438 439 440 441 442
NOT as HsTyVar unitTyCon

Why? Because F might have kind (* -> Constraint), so we when parsing we
don't know if that tuple is going to be a constraint tuple or an ordinary
unit tuple.  The HsTupleSort flag is specifically designed to deal with
that, but it has to work for unit tuples too.

dreixel's avatar
dreixel committed
443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464
Note [Promotions (HsTyVar)]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
HsTyVar: A name in a type or kind.
  Here are the allowed namespaces for the name.
    In a type:
      Var: not allowed
      Data: promoted data constructor
      Tv: type variable
      TcCls before renamer: type constructor, class constructor, or promoted data constructor
      TcCls after renamer: type constructor or class constructor
    In a kind:
      Var, Data: not allowed
      Tv: kind variable
      TcCls: kind constructor or promoted type constructor


Note [Promoted lists and tuples]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Notice the difference between
   HsListTy    HsExplicitListTy
   HsTupleTy   HsExplicitListTupleTy

Austin Seipp's avatar
Austin Seipp committed
465
E.g.    f :: [Int]                      HsListTy
dreixel's avatar
dreixel committed
466

Austin Seipp's avatar
Austin Seipp committed
467 468 469
        g3  :: T '[]                   All these use
        g2  :: T '[True]                  HsExplicitListTy
        g1  :: T '[True,False]
dreixel's avatar
dreixel committed
470 471 472 473
        g1a :: T [True,False]             (can omit ' where unambiguous)

  kind of T :: [Bool] -> *        This kind uses HsListTy!

Austin Seipp's avatar
Austin Seipp committed
474 475 476
E.g.    h :: (Int,Bool)                 HsTupleTy; f is a pair
        k :: S '(True,False)            HsExplicitTypleTy; S is indexed by
                                           a type-level pair of booleans
dreixel's avatar
dreixel committed
477 478
        kind of S :: (Bool,Bool) -> *   This kind uses HsExplicitTupleTy

dreixel's avatar
dreixel committed
479 480 481 482 483 484 485 486 487 488 489 490 491 492 493
Note [Distinguishing tuple kinds]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Apart from promotion, tuples can have one of three different kinds:

        x :: (Int, Bool)                -- Regular boxed tuples
        f :: Int# -> (# Int#, Int# #)   -- Unboxed tuples
        g :: (Eq a, Ord a) => a         -- Constraint tuples

For convenience, internally we use a single constructor for all of these,
namely HsTupleTy, but keep track of the tuple kind (in the first argument to
HsTupleTy, a HsTupleSort). We can tell if a tuple is unboxed while parsing,
because of the #. However, with -XConstraintKinds we can only distinguish
between constraint and boxed tuples during type checking, in general. Hence the
four constructors of HsTupleSort:
Austin Seipp's avatar
Austin Seipp committed
494

dreixel's avatar
dreixel committed
495 496 497
        HsUnboxedTuple                  -> Produced by the parser
        HsBoxedTuple                    -> Certainly a boxed tuple
        HsConstraintTuple               -> Certainly a constraint tuple
Austin Seipp's avatar
Austin Seipp committed
498
        HsBoxedOrConstraintTuple        -> Could be a boxed or a constraint
dreixel's avatar
dreixel committed
499 500
                                        tuple. Produced by the parser only,
                                        disappears after type checking
Austin Seipp's avatar
Austin Seipp committed
501
-}
dreixel's avatar
dreixel committed
502

batterseapower's avatar
batterseapower committed
503
data HsTupleSort = HsUnboxedTuple
dreixel's avatar
dreixel committed
504 505 506
                 | HsBoxedTuple
                 | HsConstraintTuple
                 | HsBoxedOrConstraintTuple
batterseapower's avatar
batterseapower committed
507 508
                 deriving (Data, Typeable)

Simon Peyton Jones's avatar
Simon Peyton Jones committed
509 510 511 512 513 514
data HsExplicitFlag
  = Explicit     -- An explicit forall, eg  f :: forall a. a-> a
  | Implicit     -- No explicit forall, eg  f :: a -> a, or f :: Eq a => a -> a
  | Qualified    -- A *nested* occurrences of (ctxt => ty), with no explicit forall
                 -- e.g.  f :: (Eq a => a -> a) -> Int
 deriving (Data, Typeable)
515

516
type LConDeclField name = Located (ConDeclField name)
Alan Zimmerman's avatar
Alan Zimmerman committed
517 518
      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
      --   in a list
519 520

      -- For details on above see note [Api annotations] in ApiAnnotation
Simon Peyton Jones's avatar
Simon Peyton Jones committed
521
data ConDeclField name  -- Record fields have Haddoc docs on them
522 523 524
  = ConDeclField { cd_fld_names :: [Located name],
                   cd_fld_type  :: LBangType name,
                   cd_fld_doc   :: Maybe LHsDocString }
Alan Zimmerman's avatar
Alan Zimmerman committed
525
      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
526 527

      -- For details on above see note [Api annotations] in ApiAnnotation
528 529
  deriving (Typeable)
deriving instance (DataId name) => Data (ConDeclField name)
530

531
-----------------------
Austin Seipp's avatar
Austin Seipp committed
532
-- Combine adjacent for-alls.
533
-- The following awkward situation can happen otherwise:
Simon Peyton Jones's avatar
Simon Peyton Jones committed
534
--      f :: forall a. ((Num a) => Int)
535 536 537 538 539 540
-- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
-- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
-- but the export list abstracts f wrt [a].  Disaster.
--
-- A valid type must have one for-all at the top of the type, or of the fn arg types

541 542 543 544 545 546
mkImplicitHsForAllTy  ::                           LHsContext RdrName -> LHsType RdrName -> HsType RdrName
mkExplicitHsForAllTy  :: [LHsTyVarBndr RdrName] -> LHsContext RdrName -> LHsType RdrName -> HsType RdrName
mkQualifiedHsForAllTy ::                           LHsContext RdrName -> LHsType RdrName -> HsType RdrName
mkImplicitHsForAllTy      ctxt ty = mkHsForAllTy Implicit  []  ctxt ty
mkExplicitHsForAllTy  tvs ctxt ty = mkHsForAllTy Explicit  tvs ctxt ty
mkQualifiedHsForAllTy     ctxt ty = mkHsForAllTy Qualified []  ctxt ty
547

548
mkHsForAllTy :: HsExplicitFlag -> [LHsTyVarBndr RdrName] -> LHsContext RdrName -> LHsType RdrName -> HsType RdrName
549
-- Smart constructor for HsForAllTy
550
mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
thomasw's avatar
thomasw committed
551 552 553 554 555 556 557 558
mkHsForAllTy exp tvs ctxt     ty = HsForAllTy exp extra (mkHsQTvs tvs) cleanCtxt ty
  where -- Separate the extra-constraints wildcard when present
        (cleanCtxt, extra)
          | (L l HsWildcardTy) <- ignoreParens (last (unLoc ctxt)) = (init `fmap` ctxt, Just l)
          | otherwise = (ctxt, Nothing)
        ignoreParens (L _ (HsParTy ty)) = ty
        ignoreParens ty                 = ty

559 560

-- mk_forall_ty makes a pure for-all type (no context)
561
mk_forall_ty :: HsExplicitFlag -> [LHsTyVarBndr RdrName] -> LHsType RdrName -> HsType RdrName
thomasw's avatar
thomasw committed
562 563 564 565 566 567
mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 extra qtvs2 ctxt ty))
  = addExtra $ mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ hsq_tvs qtvs2) ctxt ty
  where addExtra (HsForAllTy exp _ qtvs ctxt ty) = HsForAllTy exp extra qtvs ctxt ty
        addExtra ty = ty -- Impossible, as mkHsForAllTy always returns a HsForAllTy
mk_forall_ty exp  tvs  (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
mk_forall_ty exp  tvs  ty                 = HsForAllTy exp Nothing (mkHsQTvs tvs) (noLoc []) ty
Simon Peyton Jones's avatar
Simon Peyton Jones committed
568 569
        -- Even if tvs is empty, we still make a HsForAll!
        -- In the Implicit case, this signals the place to do implicit quantification
Austin Seipp's avatar
Austin Seipp committed
570
        -- In the Explicit case, it prevents implicit quantification
thomie's avatar
thomie committed
571
        --      (see the sigtype production in Parser.y)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
572
        --      so that (forall. ty) isn't implicitly quantified
573

574
plus :: HsExplicitFlag -> HsExplicitFlag -> HsExplicitFlag
575 576 577 578
Qualified `plus` Qualified = Qualified
Explicit  `plus` _         = Explicit
_         `plus` Explicit  = Explicit
_         `plus` _         = Implicit
Simon Peyton Jones's avatar
Simon Peyton Jones committed
579 580
  -- NB: Implicit `plus` Qualified = Implicit
  --     so that  f :: Eq a => a -> a  ends up Implicit
581

582
hsExplicitTvs :: LHsType Name -> [Name]
583
-- The explicitly-given forall'd type variables of a HsType
thomasw's avatar
thomasw committed
584 585
hsExplicitTvs (L _ (HsForAllTy Explicit _ tvs _ _)) = hsLKiTyVarNames tvs
hsExplicitTvs _                                     = []
586 587

---------------------
588
hsTyVarName :: HsTyVarBndr name -> name
Alan Zimmerman's avatar
Alan Zimmerman committed
589 590
hsTyVarName (UserTyVar n)           = n
hsTyVarName (KindedTyVar (L _ n) _) = n
591

592 593 594
hsLTyVarName :: LHsTyVarBndr name -> name
hsLTyVarName = hsTyVarName . unLoc

595
hsLTyVarNames :: LHsTyVarBndrs name -> [name]
596
-- Type variables only
597
hsLTyVarNames qtvs = map hsLTyVarName (hsQTvBndrs qtvs)
598

599 600 601 602 603
hsLKiTyVarNames :: LHsTyVarBndrs Name -> [Name]
-- Kind and type variables
hsLKiTyVarNames (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs })
  = kvs ++ map hsLTyVarName tvs

604 605 606
hsLTyVarLocName :: LHsTyVarBndr name -> Located name
hsLTyVarLocName = fmap hsTyVarName

607 608
hsLTyVarLocNames :: LHsTyVarBndrs name -> [Located name]
hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvBndrs qtvs)
thomasw's avatar
thomasw committed
609 610 611 612 613 614 615 616 617

---------------------
isWildcardTy :: HsType a -> Bool
isWildcardTy HsWildcardTy = True
isWildcardTy _ = False

isNamedWildcardTy :: HsType a -> Bool
isNamedWildcardTy (HsNamedWildcardTy _) = True
isNamedWildcardTy _ = False
618

619 620
splitHsAppTys :: LHsType n -> [LHsType n] -> (LHsType n, [LHsType n])
splitHsAppTys (L _ (HsAppTy f a)) as = splitHsAppTys f (a:as)
621
splitHsAppTys (L _ (HsParTy f))   as = splitHsAppTys f as
Simon Peyton Jones's avatar
Simon Peyton Jones committed
622
splitHsAppTys f                   as = (f,as)
623

624 625 626 627 628 629 630 631 632 633 634 635 636 637
-- retrieve the name of the "head" of a nested type application
-- somewhat like splitHsAppTys, but a little more thorough
-- used to examine the result of a GADT-like datacon, so it doesn't handle
-- *all* cases (like lists, tuples, (~), etc.)
hsTyGetAppHead_maybe :: LHsType n -> Maybe (n, [LHsType n])
hsTyGetAppHead_maybe = go []
  where
    go tys (L _ (HsTyVar n))             = Just (n, tys)
    go tys (L _ (HsAppTy l r))           = go (r : tys) l
    go tys (L _ (HsOpTy l (_, L _ n) r)) = Just (n, l : r : tys)
    go tys (L _ (HsParTy t))             = go tys t
    go tys (L _ (HsKindSig t _))         = go tys t
    go _   _                             = Nothing

638 639 640 641 642
mkHsAppTys :: OutputableBndr n => LHsType n -> [LHsType n] -> HsType n
mkHsAppTys fun_ty [] = pprPanic "mkHsAppTys" (ppr fun_ty)
mkHsAppTys fun_ty (arg_ty:arg_tys)
  = foldl mk_app (HsAppTy fun_ty arg_ty) arg_tys
  where
Austin Seipp's avatar
Austin Seipp committed
643 644 645
    mk_app fun arg = HsAppTy (noLoc fun) arg
       -- Add noLocs for inner nodes of the application;
       -- they are never used
646

batterseapower's avatar
batterseapower committed
647
splitLHsInstDeclTy_maybe
Austin Seipp's avatar
Austin Seipp committed
648
    :: LHsType name
649
    -> Maybe (LHsTyVarBndrs name, HsContext name, Located name, [LHsType name])
Simon Peyton Jones's avatar
Simon Peyton Jones committed
650
        -- Split up an instance decl type, returning the pieces
batterseapower's avatar
batterseapower committed
651 652 653 654 655 656
splitLHsInstDeclTy_maybe inst_ty = do
    let (tvs, cxt, ty) = splitLHsForAllTy inst_ty
    (cls, tys) <- splitLHsClassTy_maybe ty
    return (tvs, cxt, cls, tys)

splitLHsForAllTy
Austin Seipp's avatar
Austin Seipp committed
657
    :: LHsType name
658
    -> (LHsTyVarBndrs name, HsContext name, LHsType name)
batterseapower's avatar
batterseapower committed
659 660
splitLHsForAllTy poly_ty
  = case unLoc poly_ty of
thomasw's avatar
thomasw committed
661 662 663
        HsParTy ty                -> splitLHsForAllTy ty
        HsForAllTy _ _ tvs cxt ty -> (tvs, unLoc cxt, ty)
        _                         -> (emptyHsQTvs, [], poly_ty)
batterseapower's avatar
batterseapower committed
664 665 666 667 668 669
        -- The type vars should have been computed by now, even if they were implicit

splitHsClassTy_maybe :: HsType name -> Maybe (name, [LHsType name])
splitHsClassTy_maybe ty = fmap (\(L _ n, tys) -> (n, tys)) $ splitLHsClassTy_maybe (noLoc ty)

splitLHsClassTy_maybe :: LHsType name -> Maybe (Located name, [LHsType name])
Austin Seipp's avatar
Austin Seipp committed
670
--- Watch out.. in ...deriving( Show )... we use this on
batterseapower's avatar
batterseapower committed
671 672 673 674 675 676 677
--- the list of partially applied predicates in the deriving,
--- so there can be zero args.

-- In TcDeriv we also use this to figure out what data type is being
-- mentioned in a deriving (Generic (Foo bar baz)) declaration (i.e. "Foo").
splitLHsClassTy_maybe ty
  = checkl ty []
678
  where
batterseapower's avatar
batterseapower committed
679
    checkl (L l ty) args = case ty of
dreixel's avatar
dreixel committed
680 681 682 683 684 685
        HsTyVar t          -> Just (L l t, args)
        HsAppTy l r        -> checkl l (r:args)
        HsOpTy l (_, tc) r -> checkl (fmap HsTyVar tc) (l:r:args)
        HsParTy t          -> checkl t args
        HsKindSig ty _     -> checkl ty args
        _                  -> Nothing
686

687
-- splitHsFunType decomposes a type (t1 -> t2 ... -> tn)
Austin Seipp's avatar
Austin Seipp committed
688
-- Breaks up any parens in the result type:
Simon Peyton Jones's avatar
Simon Peyton Jones committed
689
--      splitHsFunType (a -> (b -> c)) = ([a,b], c)
690 691 692
-- Also deals with (->) t1 t2; that is why it only works on LHsType Name
--   (see Trac #9096)
splitHsFunType :: LHsType Name -> ([LHsType Name], LHsType Name)
Austin Seipp's avatar
Austin Seipp committed
693
splitHsFunType (L _ (HsParTy ty))
694 695 696 697 698 699
  = splitHsFunType ty

splitHsFunType (L _ (HsFunTy x y))
  | (args, res) <- splitHsFunType y
  = (x:args, res)

Austin Seipp's avatar
Austin Seipp committed
700
splitHsFunType orig_ty@(L _ (HsAppTy t1 t2))
701 702 703 704 705 706 707 708 709 710 711
  = go t1 [t2]
  where  -- Look for (->) t1 t2, possibly with parenthesisation
    go (L _ (HsTyVar fn))    tys | fn == funTyConName
                                 , [t1,t2] <- tys
                                 , (args, res) <- splitHsFunType t2
                                 = (t1:args, res)
    go (L _ (HsAppTy t1 t2)) tys = go t1 (t2:tys)
    go (L _ (HsParTy ty))    tys = go ty tys
    go _                     _   = ([], orig_ty)  -- Failure to match

splitHsFunType other = ([], other)
712

Austin Seipp's avatar
Austin Seipp committed
713 714 715
{-
************************************************************************
*                                                                      *
716
\subsection{Pretty printing}
Austin Seipp's avatar
Austin Seipp committed
717 718 719
*                                                                      *
************************************************************************
-}
720

721
instance (OutputableBndr name) => Outputable (HsType name) where
722
    ppr ty = pprHsType ty
723

724 725 726
instance Outputable HsTyLit where
    ppr = ppr_tylit

727
instance (OutputableBndr name) => Outputable (LHsTyVarBndrs name) where
Austin Seipp's avatar
Austin Seipp committed
728
    ppr (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs })
729
      = sep [ ifPprDebug $ braces (interppSP kvs), interppSP tvs ]
730

dreixel's avatar
dreixel committed
731
instance (OutputableBndr name) => Outputable (HsTyVarBndr name) where
732 733
    ppr (UserTyVar n)     = ppr n
    ppr (KindedTyVar n k) = parens $ hsep [ppr n, dcolon, ppr k]
734

735
instance (Outputable thing) => Outputable (HsWithBndrs name thing) where
736 737
    ppr (HsWB { hswb_cts = ty }) = ppr ty

thomasw's avatar
thomasw committed
738 739 740 741 742 743 744 745 746 747 748 749 750 751
pprHsForAll :: OutputableBndr name => HsExplicitFlag -> LHsTyVarBndrs name -> LHsContext name -> SDoc
pprHsForAll exp = pprHsForAllExtra exp Nothing

-- | Version of 'pprHsForAll' that can also print an extra-constraints
-- wildcard, e.g. @_ => a -> Bool@ or @(Show a, _) => a -> String@. This
-- underscore will be printed when the 'Maybe SrcSpan' argument is a 'Just'
-- containing the location of the extra-constraints wildcard. A special
-- function for this is needed, as the extra-constraints wildcard is removed
-- from the actual context and type, and stored in a separate field, thus just
-- printing the type will not print the extra-constraints wildcard.
pprHsForAllExtra :: OutputableBndr name => HsExplicitFlag -> Maybe SrcSpan -> LHsTyVarBndrs name -> LHsContext name -> SDoc
pprHsForAllExtra exp extra qtvs cxt
  | show_forall = forall_part <+> pprHsContextExtra show_extra (unLoc cxt)
  | otherwise   = pprHsContextExtra show_extra (unLoc cxt)
752
  where
thomasw's avatar
thomasw committed
753
    show_extra  = isJust extra
754
    show_forall =  opt_PprStyle_Debug
755
                || (not (null (hsQTvBndrs qtvs)) && is_explicit)
756
    is_explicit = case exp of {Explicit -> True; Implicit -> False; Qualified -> False}
757
    forall_part = forAllLit <+> ppr qtvs <> dot
758

759
pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
760
pprHsContext = maybe empty (<+> darrow) . pprHsContextMaybe
Gergő Érdi's avatar
Gergő Érdi committed
761 762

pprHsContextNoArrow :: (OutputableBndr name) => HsContext name -> SDoc
763 764 765 766 767 768
pprHsContextNoArrow = fromMaybe empty . pprHsContextMaybe

pprHsContextMaybe :: (OutputableBndr name) => HsContext name -> Maybe SDoc
pprHsContextMaybe []         = Nothing
pprHsContextMaybe [L _ pred] = Just $ ppr_mono_ty FunPrec pred
pprHsContextMaybe cxt        = Just $ parens (interpp'SP cxt)
769

thomasw's avatar
thomasw committed
770 771 772 773 774 775 776 777 778
-- True <=> print an extra-constraints wildcard, e.g. @(Show a, _) =>@
pprHsContextExtra :: (OutputableBndr name) => Bool -> HsContext name -> SDoc
pprHsContextExtra False = pprHsContext
pprHsContextExtra True
  = \ctxt -> case ctxt of
               [] -> char '_' <+> darrow
               _  -> parens (sep (punctuate comma ctxt')) <+> darrow
                 where ctxt' = map ppr ctxt ++ [char '_']

779
pprConDeclFields :: OutputableBndr name => [LConDeclField name] -> SDoc
780 781
pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
  where
782 783 784 785 786
    ppr_fld (L _ (ConDeclField { cd_fld_names = ns, cd_fld_type = ty,
                                 cd_fld_doc = doc }))
        = ppr_names ns <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
    ppr_names [n] = ppr n
    ppr_names ns = sep (punctuate comma (map ppr ns))
787

Austin Seipp's avatar
Austin Seipp committed
788
{-
789 790 791 792 793 794 795 796 797 798
Note [Printing KindedTyVars]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Trac #3830 reminded me that we should really only print the kind
signature on a KindedTyVar if the kind signature was put there by the
programmer.  During kind inference GHC now adds a PostTcKind to UserTyVars,
rather than converting to KindedTyVars as before.

(As it happens, the message in #3830 comes out a different way now,
and the problem doesn't show up; but having the flag on a KindedTyVar
seems like the Right Thing anyway.)
Austin Seipp's avatar
Austin Seipp committed
799
-}
800

801
-- Printing works more-or-less as for Types
802

803
pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
804

805 806
pprHsType ty       = getPprStyle $ \sty -> ppr_mono_ty TopPrec (prepare sty ty)
pprParendHsType ty = ppr_mono_ty TyConPrec ty
807

808 809 810 811
-- Before printing a type
-- (a) Remove outermost HsParTy parens
-- (b) Drop top-level for-all type variables in user style
--     since they are implicit in Haskell
twanvl's avatar
twanvl committed
812
prepare :: PprStyle -> HsType name -> HsType name
Simon Peyton Jones's avatar
Simon Peyton Jones committed
813
prepare sty (HsParTy ty)          = prepare sty (unLoc ty)
twanvl's avatar
twanvl committed
814
prepare _   ty                    = ty
815

816
ppr_mono_lty :: (OutputableBndr name) => TyPrec -> LHsType name -> SDoc
817 818
ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)

819
ppr_mono_ty :: (OutputableBndr name) => TyPrec -> HsType name -> SDoc
thomasw's avatar
thomasw committed
820
ppr_mono_ty ctxt_prec (HsForAllTy exp extra tvs ctxt ty)
821
  = maybeParen ctxt_prec FunPrec $
thomasw's avatar
thomasw committed
822
    sep [pprHsForAllExtra exp extra tvs ctxt, ppr_mono_lty TopPrec ty]
823

824
ppr_mono_ty _    (HsBangTy b ty)     = ppr b <> ppr_mono_lty TyConPrec ty
825
ppr_mono_ty _    (HsRecTy flds)      = pprConDeclFields flds
826
ppr_mono_ty _    (HsTyVar name)      = pprPrefixOcc name
827
ppr_mono_ty prec (HsFunTy ty1 ty2)   = ppr_fun_ty prec ty1 ty2
batterseapower's avatar
batterseapower committed
828 829 830
ppr_mono_ty _    (HsTupleTy con tys) = tupleParens std_con (interpp'SP tys)
  where std_con = case con of
                    HsUnboxedTuple -> UnboxedTuple
dreixel's avatar
dreixel committed
831
                    _              -> BoxedTuple