IfaceType.hs 52.1 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, 1993-1998

5

Simon Marlow's avatar
Simon Marlow committed
6
This module defines interface types and binders
Austin Seipp's avatar
Austin Seipp committed
7
-}
8

Ben Gamari's avatar
Ben Gamari committed
9
{-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-}
Sylvain Henry's avatar
Sylvain Henry committed
10
{-# LANGUAGE MultiWayIf #-}
11 12
    -- FlexibleInstances for Binary (DefMethSpec IfaceType)

13
module IfaceType (
14
        IfExtName, IfLclName,
15

16
        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
17
        IfaceUnivCoProv(..),
Ben Gamari's avatar
Ben Gamari committed
18
        IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..), IsPromoted(..),
19
        IfaceTyLit(..), IfaceTcArgs(..),
20
        IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
21
        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
22
        IfaceForAllBndr, ArgFlag(..), ShowForAllFlag(..),
23

Ben Gamari's avatar
Ben Gamari committed
24
        ifTyConBinderTyVar, ifTyConBinderName,
25

26
        -- Equality testing
27
        isIfaceLiftedTypeKind,
28

Ben Gamari's avatar
Ben Gamari committed
29
        -- Conversion from IfaceTcArgs -> [IfaceType]
30
        tcArgsIfaceTypes,
31

32
        -- Printing
33
        pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
34
        pprIfaceContext, pprIfaceContextArr,
35
        pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
36
        pprIfaceBndrs, pprIfaceTcArgs, pprParendIfaceTcArgs,
37 38
        pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,
        pprIfaceSigmaType, pprIfaceTyLit,
39 40
        pprIfaceCoercion, pprParendIfaceCoercion,
        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
Ben Gamari's avatar
Ben Gamari committed
41
        pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
42

43 44 45
        suppressIfaceInvisibles,
        stripIfaceInvisVars,
        stripInvisArgs,
46 47

        mkIfaceTySubst, substIfaceTyVar, substIfaceTcArgs, inDomIfaceTySubst
48 49
    ) where

50 51
#include "HsVersions.h"

Richard Eisenberg's avatar
Richard Eisenberg committed
52
import {-# SOURCE #-} TysWiredIn ( liftedRepDataConTyCon )
Ben Gamari's avatar
Ben Gamari committed
53

54
import DynFlags
55
import TyCon hiding ( pprPromotionQuote )
56
import CoAxiom
Simon Marlow's avatar
Simon Marlow committed
57
import Var
58
import PrelNames
Simon Marlow's avatar
Simon Marlow committed
59 60
import Name
import BasicTypes
61
import Binary
62 63
import Outputable
import FastString
Ben Gamari's avatar
Ben Gamari committed
64
import FastStringEnv
65
import Util
66

67
import Data.Maybe( isJust )
Ben Gamari's avatar
Ben Gamari committed
68
import Data.List (foldl')
69
import qualified Data.Semigroup as Semi
Ben Gamari's avatar
Ben Gamari committed
70

Austin Seipp's avatar
Austin Seipp committed
71 72 73
{-
************************************************************************
*                                                                      *
74
                Local (nested) binders
Austin Seipp's avatar
Austin Seipp committed
75 76 77
*                                                                      *
************************************************************************
-}
78

79
type IfLclName = FastString     -- A local name in iface syntax
80

81 82
type IfExtName = Name   -- An External or WiredIn Name can appear in IfaceSyn
                        -- (However Internal or System Names never should)
83

84
data IfaceBndr          -- Local (non-top-level) binders
85 86
  = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
  | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
87

88 89
type IfaceIdBndr  = (IfLclName, IfaceType)
type IfaceTvBndr  = (IfLclName, IfaceKind)
90

Simon Peyton Jones's avatar
Simon Peyton Jones committed
91 92 93 94
ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName (n,_) = n

type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
95

96 97
data IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy
  = IfaceNoOneShot   -- and Note [The oneShot function] in MkId
98 99 100
  | IfaceOneShot


101 102 103 104 105 106 107 108
{-
%************************************************************************
%*                                                                      *
                IfaceType
%*                                                                      *
%************************************************************************
-}

109
-------------------------------
110
type IfaceKind     = IfaceType
111

112
data IfaceType     -- A kind of universal type, used for types and kinds
113
  = IfaceFreeTyVar TyVar                -- See Note [Free tyvars in IfaceType]
114 115 116 117 118 119 120 121
  | IfaceTyVar     IfLclName            -- Type/coercion variable only, not tycon
  | IfaceLitTy     IfaceTyLit
  | IfaceAppTy     IfaceType IfaceType
  | IfaceFunTy     IfaceType IfaceType
  | IfaceDFunTy    IfaceType IfaceType
  | IfaceForAllTy  IfaceForAllBndr IfaceType
  | IfaceTyConApp  IfaceTyCon IfaceTcArgs  -- Not necessarily saturated
                                           -- Includes newtypes, synonyms, tuples
122 123
  | IfaceCastTy     IfaceType IfaceCoercion
  | IfaceCoercionTy IfaceCoercion
Ben Gamari's avatar
Ben Gamari committed
124

125
  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)
Ben Gamari's avatar
Ben Gamari committed
126 127
       TupleSort                  -- What sort of tuple?
       IsPromoted                 -- A bit like IfaceTyCon
128 129
       IfaceTcArgs                -- arity = length args
          -- For promoted data cons, the kind args are omitted
130

batterseapower's avatar
batterseapower committed
131
type IfacePredType = IfaceType
132 133
type IfaceContext = [IfacePredType]

134
data IfaceTyLit
135 136
  = IfaceNumTyLit Integer
  | IfaceStrTyLit FastString
137
  deriving (Eq)
138

139
type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
140
type IfaceForAllBndr  = TyVarBndr IfaceTvBndr ArgFlag
141

142
-- See Note [Suppressing invisible arguments]
143 144 145 146 147 148
-- We use a new list type (rather than [(IfaceType,Bool)], because
-- it'll be more compact and faster to parse in interface
-- files. Rather than two bytes and two decisions (nil/cons, and
-- type/kind) there'll just be one.
data IfaceTcArgs
  = ITC_Nil
Simon Peyton Jones's avatar
Simon Peyton Jones committed
149
  | ITC_Vis   IfaceType IfaceTcArgs   -- "Vis" means show when pretty-printing
150
  | ITC_Invis IfaceKind IfaceTcArgs   -- "Invis" means don't show when pretty-printing
Simon Peyton Jones's avatar
Simon Peyton Jones committed
151
                                      --         except with -fprint-explicit-kinds
152

153 154 155 156 157
instance Semi.Semigroup IfaceTcArgs where
  ITC_Nil <> xs           = xs
  ITC_Vis ty rest <> xs   = ITC_Vis ty (rest Semi.<> xs)
  ITC_Invis ki rest <> xs = ITC_Invis ki (rest Semi.<> xs)

Ben Gamari's avatar
Ben Gamari committed
158 159
instance Monoid IfaceTcArgs where
  mempty = ITC_Nil
160
  mappend = (Semi.<>)
Ben Gamari's avatar
Ben Gamari committed
161

162 163 164 165
-- Encodes type constructors, kind constructors,
-- coercion constructors, the lot.
-- We have to tag them in order to pretty print them
-- properly.
166 167
data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName
                             , ifaceTyConInfo :: IfaceTyConInfo }
168
    deriving (Eq)
169

Ben Gamari's avatar
Ben Gamari committed
170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
-- | Is a TyCon a promoted data constructor or just a normal type constructor?
data IsPromoted = IsNotPromoted | IsPromoted
    deriving (Eq)

-- | The various types of TyCons which have special, built-in syntax.
data IfaceTyConSort = IfaceNormalTyCon          -- ^ a regular tycon

                    | IfaceTupleTyCon !Arity !TupleSort
                      -- ^ e.g. @(a, b, c)@ or @(#a, b, c#)@.
                      -- The arity is the tuple width, not the tycon arity
                      -- (which is twice the width in the case of unboxed
                      -- tuples).

                    | IfaceSumTyCon !Arity
                      -- ^ e.g. @(a | b | c)@

                    | IfaceEqualityTyCon !Bool
                      -- ^ a type equality. 'True' indicates kind-homogeneous.
                      -- See Note [Equality predicates in IfaceType] for
                      -- details.
                    deriving (Eq)

192
{- Note [Free tyvars in IfaceType]
193
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
194
Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to an
195 196 197 198 199 200 201 202 203
IfaceType and pretty printing that.  This eliminates a lot of
pretty-print duplication, and it matches what we do with
pretty-printing TyThings.

It works fine for closed types, but when printing debug traces (e.g.
when using -ddump-tc-trace) we print a lot of /open/ types.  These
types are full of TcTyVars, and it's absolutely crucial to print them
in their full glory, with their unique, TcTyVarDetails etc.

204
So we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor.
205 206
Note that:

207 208
* We never expect to serialise an IfaceFreeTyVar into an interface file, nor
  to deserialise one.  IfaceFreeTyVar is used only in the "convert to IfaceType
209 210
  and then pretty-print" pipeline.

211
We do the same for covars, naturally.
212

Ben Gamari's avatar
Ben Gamari committed
213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
Note [Equality predicates in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has several varieties of type equality (see Note [The equality types story]
in TysPrim for details) which all must be rendered with different surface syntax
during pretty-printing. Which syntax we use depends upon,

 1. Which predicate tycon was used
 2. Whether the types being compared are of the same kind.

Unfortunately, determining (2) from an IfaceType isn't possible since we can't
see through type synonyms. Consequently, we need to record whether the equality
is homogeneous or not in IfaceTyConSort for the purposes of pretty-printing.

Namely we handle these cases,

    Predicate               Homogeneous        Heterogeneous
    ----------------        -----------        -------------
    eqTyCon                 ~                  N/A
    heqTyCon                ~                  ~~
    eqPrimTyCon             ~#                 ~~
    eqReprPrimTyCon         Coercible          Coercible

235
See Note [The equality types story] in TysPrim.
Ben Gamari's avatar
Ben Gamari committed
236 237
-}

238 239
data IfaceTyConInfo   -- Used to guide pretty-printing
                      -- and to disambiguate D from 'D (they share a name)
Ben Gamari's avatar
Ben Gamari committed
240 241
  = IfaceTyConInfo { ifaceTyConIsPromoted :: IsPromoted
                   , ifaceTyConSort       :: IfaceTyConSort }
242
    deriving (Eq)
243

244
data IfaceCoercion
245 246 247 248 249
  = IfaceReflCo       Role IfaceType
  | IfaceFunCo        Role IfaceCoercion IfaceCoercion
  | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]
  | IfaceAppCo        IfaceCoercion IfaceCoercion
  | IfaceForAllCo     IfaceTvBndr IfaceCoercion IfaceCoercion
250
  | IfaceFreeCoVar    CoVar       -- See Note [Free tyvars in IfaceType]
251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268
  | IfaceCoVarCo      IfLclName
  | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]
  | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType
  | IfaceSymCo        IfaceCoercion
  | IfaceTransCo      IfaceCoercion IfaceCoercion
  | IfaceNthCo        Int IfaceCoercion
  | IfaceLRCo         LeftOrRight IfaceCoercion
  | IfaceInstCo       IfaceCoercion IfaceCoercion
  | IfaceCoherenceCo  IfaceCoercion IfaceCoercion
  | IfaceKindCo       IfaceCoercion
  | IfaceSubCo        IfaceCoercion
  | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]

data IfaceUnivCoProv
  = IfaceUnsafeCoerceProv
  | IfacePhantomProv IfaceCoercion
  | IfaceProofIrrelProv IfaceCoercion
  | IfacePluginProv String
Ben Gamari's avatar
Ben Gamari committed
269 270
  | IfaceHoleProv Unique
    -- ^ See Note [Holes in IfaceUnivCoProv]
271

Ben Gamari's avatar
Ben Gamari committed
272 273 274 275 276 277 278 279 280 281 282 283
{-
Note [Holes in IfaceUnivCoProv]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When typechecking fails the typechecker will produce a HoleProv UnivCoProv to
stand in place of the unproven assertion. While we generally don't want to let
these unproven assertions leak into interface files, we still need to be able to
pretty-print them as we use IfaceType's pretty-printer to render Types. For this
reason IfaceUnivCoProv has a IfaceHoleProv constructor; however, we fails when
asked to serialize to a IfaceHoleProv to ensure that they don't end up in an
interface file. To avoid an import loop between IfaceType and TyCoRep we only
keep the hole's Unique, since that is all we need to print.
-}
284

Austin Seipp's avatar
Austin Seipp committed
285
{-
286 287
%************************************************************************
%*                                                                      *
288
                Functions over IFaceTypes
Austin Seipp's avatar
Austin Seipp committed
289 290 291
*                                                                      *
************************************************************************
-}
292

Ben Gamari's avatar
Ben Gamari committed
293 294 295
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key

296 297 298 299 300
isIfaceLiftedTypeKind :: IfaceKind -> Bool
isIfaceLiftedTypeKind (IfaceTyConApp tc ITC_Nil)
  = isLiftedTypeKindTyConName (ifaceTyConName tc)
isIfaceLiftedTypeKind (IfaceTyConApp tc
                       (ITC_Vis (IfaceTyConApp ptr_rep_lifted ITC_Nil) ITC_Nil))
Ben Gamari's avatar
Ben Gamari committed
301
  =  tc `ifaceTyConHasKey` tYPETyConKey
Richard Eisenberg's avatar
Richard Eisenberg committed
302
  && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey
303 304
isIfaceLiftedTypeKind _ = False

305
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
306 307
-- Mainly for printing purposes
splitIfaceSigmaTy ty
308
  = (bndrs, theta, tau)
309
  where
310
    (bndrs, rho)   = split_foralls ty
batterseapower's avatar
batterseapower committed
311
    (theta, tau)   = split_rho rho
312

313 314
    split_foralls (IfaceForAllTy bndr ty)
        = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
315 316
    split_foralls rho = ([], rho)

317 318
    split_rho (IfaceDFunTy ty1 ty2)
        = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
319
    split_rho tau = ([], tau)
320

321
suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
322
suppressIfaceInvisibles dflags tys xs
323 324 325 326 327 328
  | gopt Opt_PrintExplicitKinds dflags = xs
  | otherwise = suppress tys xs
    where
      suppress _       []      = []
      suppress []      a       = a
      suppress (k:ks) a@(_:xs)
329 330
        | isInvisibleTyConBinder k = suppress ks xs
        | otherwise                = a
331

332
stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
333
stripIfaceInvisVars dflags tyvars
334
  | gopt Opt_PrintExplicitKinds dflags = tyvars
335
  | otherwise = filterOut isInvisibleTyConBinder tyvars
336 337 338

-- | Extract a IfaceTvBndr from a IfaceTyConBinder
ifTyConBinderTyVar :: IfaceTyConBinder -> IfaceTvBndr
339
ifTyConBinderTyVar = binderVar
340 341 342

-- | Extract the variable name from a IfaceTyConBinder
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
Simon Peyton Jones's avatar
Simon Peyton Jones committed
343
ifTyConBinderName tcb = ifaceTvBndrName (ifTyConBinderTyVar tcb)
344

345 346 347 348
ifTypeIsVarFree :: IfaceType -> Bool
-- Returns True if the type definitely has no variables at all
-- Just used to control pretty printing
ifTypeIsVarFree ty = go ty
349
  where
350
    go (IfaceTyVar {})         = False
351
    go (IfaceFreeTyVar {})     = False
352 353 354 355 356 357 358 359 360 361 362 363 364
    go (IfaceAppTy fun arg)    = go fun && go arg
    go (IfaceFunTy arg res)    = go arg && go res
    go (IfaceDFunTy arg res)   = go arg && go res
    go (IfaceForAllTy {})      = False
    go (IfaceTyConApp _ args)  = go_args args
    go (IfaceTupleTy _ _ args) = go_args args
    go (IfaceLitTy _)          = True
    go (IfaceCastTy {})        = False -- Safe
    go (IfaceCoercionTy {})    = False -- Safe

    go_args ITC_Nil = True
    go_args (ITC_Vis   arg args) = go arg && go_args args
    go_args (ITC_Invis arg args) = go arg && go_args args
365

366 367 368 369 370
{- Note [Substitution on IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Substitutions on IfaceType are done only during pretty-printing to
construct the result type of a GADT, and does not deal with binders
(eg IfaceForAll), so it doesn't need fancy capture stuff.  -}
371

372
type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType]
373

374 375 376 377 378 379 380
mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst
-- See Note [Substitution on IfaceType]
mkIfaceTySubst eq_spec = mkFsEnv eq_spec

inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
-- See Note [Substitution on IfaceType]
inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst fs)
381 382

substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
383
-- See Note [Substitution on IfaceType]
384 385 386
substIfaceType env ty
  = go ty
  where
387
    go (IfaceFreeTyVar tv)    = IfaceFreeTyVar tv
388 389 390 391 392 393
    go (IfaceTyVar tv)        = substIfaceTyVar env tv
    go (IfaceAppTy  t1 t2)    = IfaceAppTy  (go t1) (go t2)
    go (IfaceFunTy  t1 t2)    = IfaceFunTy  (go t1) (go t2)
    go (IfaceDFunTy t1 t2)    = IfaceDFunTy (go t1) (go t2)
    go ty@(IfaceLitTy {})     = ty
    go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceTcArgs env tys)
394
    go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceTcArgs env tys)
395
    go (IfaceForAllTy {})     = pprPanic "substIfaceType" (ppr ty)
396 397 398 399 400 401 402 403
    go (IfaceCastTy ty co)    = IfaceCastTy (go ty) (go_co co)
    go (IfaceCoercionTy co)   = IfaceCoercionTy (go_co co)

    go_co (IfaceReflCo r ty)     = IfaceReflCo r (go ty)
    go_co (IfaceFunCo r c1 c2)   = IfaceFunCo r (go_co c1) (go_co c2)
    go_co (IfaceTyConAppCo r tc cos) = IfaceTyConAppCo r tc (go_cos cos)
    go_co (IfaceAppCo c1 c2)         = IfaceAppCo (go_co c1) (go_co c2)
    go_co (IfaceForAllCo {})         = pprPanic "substIfaceCoercion" (ppr ty)
404
    go_co (IfaceFreeCoVar cv)        = IfaceFreeCoVar cv
405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423
    go_co (IfaceCoVarCo cv)          = IfaceCoVarCo cv
    go_co (IfaceAxiomInstCo a i cos) = IfaceAxiomInstCo a i (go_cos cos)
    go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2)
    go_co (IfaceSymCo co)            = IfaceSymCo (go_co co)
    go_co (IfaceTransCo co1 co2)     = IfaceTransCo (go_co co1) (go_co co2)
    go_co (IfaceNthCo n co)          = IfaceNthCo n (go_co co)
    go_co (IfaceLRCo lr co)          = IfaceLRCo lr (go_co co)
    go_co (IfaceInstCo c1 c2)        = IfaceInstCo (go_co c1) (go_co c2)
    go_co (IfaceCoherenceCo c1 c2)   = IfaceCoherenceCo (go_co c1) (go_co c2)
    go_co (IfaceKindCo co)           = IfaceKindCo (go_co co)
    go_co (IfaceSubCo co)            = IfaceSubCo (go_co co)
    go_co (IfaceAxiomRuleCo n cos)   = IfaceAxiomRuleCo n (go_cos cos)

    go_cos = map go_co

    go_prov IfaceUnsafeCoerceProv    = IfaceUnsafeCoerceProv
    go_prov (IfacePhantomProv co)    = IfacePhantomProv (go_co co)
    go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co)
    go_prov (IfacePluginProv str)    = IfacePluginProv str
Ben Gamari's avatar
Ben Gamari committed
424
    go_prov (IfaceHoleProv h)        = IfaceHoleProv h
425 426 427 428 429

substIfaceTcArgs :: IfaceTySubst -> IfaceTcArgs -> IfaceTcArgs
substIfaceTcArgs env args
  = go args
  where
430 431 432
    go ITC_Nil            = ITC_Nil
    go (ITC_Vis ty tys)   = ITC_Vis   (substIfaceType env ty) (go tys)
    go (ITC_Invis ty tys) = ITC_Invis (substIfaceType env ty) (go tys)
433 434 435 436 437

substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
substIfaceTyVar env tv
  | Just ty <- lookupFsEnv env tv = ty
  | otherwise                     = IfaceTyVar tv
438

439

Austin Seipp's avatar
Austin Seipp committed
440 441 442
{-
************************************************************************
*                                                                      *
443
                Functions over IFaceTcArgs
Austin Seipp's avatar
Austin Seipp committed
444 445 446
*                                                                      *
************************************************************************
-}
447

448 449
stripInvisArgs :: DynFlags -> IfaceTcArgs -> IfaceTcArgs
stripInvisArgs dflags tys
450
  | gopt Opt_PrintExplicitKinds dflags = tys
451
  | otherwise = suppress_invis tys
452
    where
453
      suppress_invis c
454
        = case c of
455
            ITC_Invis _ ts -> suppress_invis ts
456 457 458 459
            _ -> c

tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
tcArgsIfaceTypes ITC_Nil = []
460 461
tcArgsIfaceTypes (ITC_Invis t ts) = t : tcArgsIfaceTypes ts
tcArgsIfaceTypes (ITC_Vis   t ts) = t : tcArgsIfaceTypes ts
462

Ben Gamari's avatar
Ben Gamari committed
463 464 465 466 467 468 469
ifaceVisTcArgsLength :: IfaceTcArgs -> Int
ifaceVisTcArgsLength = go 0
  where
    go !n ITC_Nil            = n
    go n  (ITC_Vis _ rest)   = go (n+1) rest
    go n  (ITC_Invis _ rest) = go n rest

Austin Seipp's avatar
Austin Seipp committed
470
{-
471 472
Note [Suppressing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
473
We use the IfaceTcArgs to specify which of the arguments to a type
Simon Peyton Jones's avatar
Simon Peyton Jones committed
474 475
constructor should be displayed when pretty-printing, under
the control of -fprint-explicit-kinds.
476
See also Type.filterOutInvisibleTypes.
477 478 479 480 481 482 483 484
For example, given
    T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism
    'Just :: forall k. k -> 'Maybe k   -- Promoted
we want
  T * Tree Int    prints as    T Tree Int
  'Just *         prints as    Just *


Austin Seipp's avatar
Austin Seipp committed
485 486
************************************************************************
*                                                                      *
487
                Pretty-printing
Austin Seipp's avatar
Austin Seipp committed
488 489 490
*                                                                      *
************************************************************************
-}
491

Ben Gamari's avatar
Ben Gamari committed
492 493 494 495 496 497 498 499 500 501 502
if_print_coercions :: SDoc  -- ^ if printing coercions
                   -> SDoc  -- ^ otherwise
                   -> SDoc
if_print_coercions yes no
  = sdocWithDynFlags $ \dflags ->
    getPprStyle $ \style ->
    if gopt Opt_PrintExplicitCoercions dflags
         || dumpStyle style || debugStyle style
    then yes
    else no

503 504 505 506
pprIfaceInfixApp :: TyPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp ctxt_prec pp_tc pp_ty1 pp_ty2
  = maybeParen ctxt_prec TyOpPrec $
    sep [pp_ty1, pp_tc <+> pp_ty2]
507 508

pprIfacePrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
509
pprIfacePrefixApp ctxt_prec pp_fun pp_tys
510
  | null pp_tys = pp_fun
511
  | otherwise   = maybeParen ctxt_prec TyConPrec $
512
                  hang pp_fun 2 (sep pp_tys)
513

Austin Seipp's avatar
Austin Seipp committed
514
-- ----------------------------- Printing binders ------------------------------------
515 516 517

instance Outputable IfaceBndr where
    ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
Ben Gamari's avatar
Ben Gamari committed
518
    ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr False bndr
519 520 521 522

pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs bs = sep (map ppr bs)

523 524 525 526
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b
pprIfaceLamBndr (b, IfaceOneShot)   = ppr b <> text "[OneShot]"

Ben Gamari's avatar
Ben Gamari committed
527
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
528
pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)
529

Ben Gamari's avatar
Ben Gamari committed
530 531
pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
pprIfaceTvBndr use_parens (tv, ki)
532
  | isIfaceLiftedTypeKind ki = ppr tv
Ben Gamari's avatar
Ben Gamari committed
533 534 535 536
  | otherwise                = maybe_parens (ppr tv <+> dcolon <+> ppr ki)
  where
    maybe_parens | use_parens = parens
                 | otherwise  = id
537

538 539 540
pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders = sep . map go
  where
Ben Gamari's avatar
Ben Gamari committed
541
    go tcb = pprIfaceTvBndr True (ifTyConBinderTyVar tcb)
542 543 544 545 546 547 548 549 550 551 552 553 554 555 556

instance Binary IfaceBndr where
    put_ bh (IfaceIdBndr aa) = do
            putByte bh 0
            put_ bh aa
    put_ bh (IfaceTvBndr ab) = do
            putByte bh 1
            put_ bh ab
    get bh = do
            h <- getByte bh
            case h of
              0 -> do aa <- get bh
                      return (IfaceIdBndr aa)
              _ -> do ab <- get bh
                      return (IfaceTvBndr ab)
557 558 559 560 561 562 563 564 565 566 567

instance Binary IfaceOneShot where
    put_ bh IfaceNoOneShot = do
            putByte bh 0
    put_ bh IfaceOneShot = do
            putByte bh 1
    get bh = do
            h <- getByte bh
            case h of
              0 -> do return IfaceNoOneShot
              _ -> do return IfaceOneShot
568

Austin Seipp's avatar
Austin Seipp committed
569
-- ----------------------------- Printing IfaceType ------------------------------------
570 571 572

---------------------------------
instance Outputable IfaceType where
573
  ppr ty = pprIfaceType ty
574

Ben Gamari's avatar
Ben Gamari committed
575
pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
576 577 578 579 580
pprIfaceType       = pprPrecIfaceType TopPrec
pprParendIfaceType = pprPrecIfaceType TyConPrec

pprPrecIfaceType :: TyPrec -> IfaceType -> SDoc
pprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty
581

582
ppr_ty :: TyPrec -> IfaceType -> SDoc
583
ppr_ty _         (IfaceFreeTyVar tyvar) = ppr tyvar  -- This is the main reson for IfaceFreeTyVar!
584
ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar  -- See Note [TcTyVars in IfaceType]
Ben Gamari's avatar
Ben Gamari committed
585 586 587
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
ppr_ty _         (IfaceTupleTy i p tys) = pprTuple i p tys
ppr_ty _         (IfaceLitTy n)         = pprIfaceTyLit n
588
        -- Function types
589
ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
590
  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
591 592
    maybeParen ctxt_prec FunPrec $
    sep [ppr_ty FunPrec ty1, sep (ppr_fun_tail ty2)]
593
  where
594
    ppr_fun_tail (IfaceFunTy ty1 ty2)
595
      = (arrow <+> ppr_ty FunPrec ty1) : ppr_fun_tail ty2
596
    ppr_fun_tail other_ty
597
      = [arrow <+> pprIfaceType other_ty]
598

599
ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
Ben Gamari's avatar
Ben Gamari committed
600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622
  = if_print_coercions
      ppr_app_ty
      ppr_app_ty_no_casts
  where
    ppr_app_ty =
        maybeParen ctxt_prec TyConPrec
        $ ppr_ty FunPrec ty1 <+> ppr_ty TyConPrec ty2

    -- Strip any casts from the head of the application
    ppr_app_ty_no_casts =
        case split_app_tys ty1 (ITC_Vis ty2 ITC_Nil) of
          (IfaceCastTy head _, args) -> ppr_ty ctxt_prec (mk_app_tys head args)
          _                          -> ppr_app_ty

    split_app_tys :: IfaceType -> IfaceTcArgs -> (IfaceType, IfaceTcArgs)
    split_app_tys (IfaceAppTy t1 t2) args = split_app_tys t1 (t2 `ITC_Vis` args)
    split_app_tys head               args = (head, args)

    mk_app_tys :: IfaceType -> IfaceTcArgs -> IfaceType
    mk_app_tys (IfaceTyConApp tc tys1) tys2 =
        IfaceTyConApp tc (tys1 `mappend` tys2)
    mk_app_tys t1                      tys2 =
        foldl' IfaceAppTy t1 (tcArgsIfaceTypes tys2)
623

624
ppr_ty ctxt_prec (IfaceCastTy ty co)
Ben Gamari's avatar
Ben Gamari committed
625 626 627
  = if_print_coercions
      (parens (ppr_ty TopPrec ty <+> text "|>" <+> ppr co))
      (ppr_ty ctxt_prec ty)
628 629

ppr_ty ctxt_prec (IfaceCoercionTy co)
Ben Gamari's avatar
Ben Gamari committed
630 631 632
  = if_print_coercions
      (ppr_co ctxt_prec co)
      (text "<>")
633

634
ppr_ty ctxt_prec ty
635
  = maybeParen ctxt_prec FunPrec (pprIfaceSigmaType ShowForAllMust ty)
636

Ben Gamari's avatar
Ben Gamari committed
637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694
{-
Note [Defaulting RuntimeRep variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

RuntimeRep variables are considered by many (most?) users to be little more than
syntactic noise. When the notion was introduced there was a signficant and
understandable push-back from those with pedagogy in mind, which argued that
RuntimeRep variables would throw a wrench into nearly any teach approach since
they appear in even the lowly ($) function's type,

    ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b

which is significantly less readable than its non RuntimeRep-polymorphic type of

    ($) :: (a -> b) -> a -> b

Moreover, unboxed types don't appear all that often in run-of-the-mill Haskell
programs, so it makes little sense to make all users pay this syntactic
overhead.

For this reason it was decided that we would hide RuntimeRep variables for now
(see #11549). We do this by defaulting all type variables of kind RuntimeRep to
PtrLiftedRep. This is done in a pass right before pretty-printing
(defaultRuntimeRepVars, controlled by -fprint-explicit-runtime-reps)
-}

-- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g.
--
-- @
-- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
--        (a -> b) -> a -> b
-- @
--
-- turns in to,
--
-- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @
--
-- We do this to prevent RuntimeRep variables from incurring a significant
-- syntactic overhead in otherwise simple type signatures (e.g. ($)). See
-- Note [Defaulting RuntimeRep variables] and #11549 for further discussion.
--
defaultRuntimeRepVars :: IfaceType -> IfaceType
defaultRuntimeRepVars = go emptyFsEnv
  where
    go :: FastStringEnv () -> IfaceType -> IfaceType
    go subs (IfaceForAllTy bndr ty)
      | isRuntimeRep var_kind
      = let subs' = extendFsEnv subs var ()
        in go subs' ty
      | otherwise
      = IfaceForAllTy (TvBndr (var, go subs var_kind) (binderArgFlag bndr))
        (go subs ty)
      where
        var :: IfLclName
        (var, var_kind) = binderVar bndr

    go subs (IfaceTyVar tv)
      | tv `elemFsEnv` subs
Richard Eisenberg's avatar
Richard Eisenberg committed
695
      = IfaceTyConApp liftedRep ITC_Nil
Ben Gamari's avatar
Ben Gamari committed
696 697 698 699 700 701 702 703 704 705 706 707 708 709 710

    go subs (IfaceFunTy kind ty)
      = IfaceFunTy (go subs kind) (go subs ty)

    go subs (IfaceAppTy x y)
      = IfaceAppTy (go subs x) (go subs y)

    go subs (IfaceDFunTy x y)
      = IfaceDFunTy (go subs x) (go subs y)

    go subs (IfaceCastTy x co)
      = IfaceCastTy (go subs x) co

    go _ other = other

Richard Eisenberg's avatar
Richard Eisenberg committed
711 712
    liftedRep :: IfaceTyCon
    liftedRep =
Ben Gamari's avatar
Ben Gamari committed
713
        IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
Richard Eisenberg's avatar
Richard Eisenberg committed
714
      where dc_name = getName liftedRepDataConTyCon
Ben Gamari's avatar
Ben Gamari committed
715 716 717 718 719 720 721 722 723 724 725 726

    isRuntimeRep :: IfaceType -> Bool
    isRuntimeRep (IfaceTyConApp tc _) =
        tc `ifaceTyConHasKey` runtimeRepTyConKey
    isRuntimeRep _ = False

eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
eliminateRuntimeRep f ty = sdocWithDynFlags $ \dflags ->
    if gopt Opt_PrintExplicitRuntimeReps dflags
      then f ty
      else f (defaultRuntimeRepVars ty)

727 728 729 730 731 732 733 734 735 736 737
instance Outputable IfaceTcArgs where
  ppr tca = pprIfaceTcArgs tca

pprIfaceTcArgs, pprParendIfaceTcArgs :: IfaceTcArgs -> SDoc
pprIfaceTcArgs  = ppr_tc_args TopPrec
pprParendIfaceTcArgs = ppr_tc_args TyConPrec

ppr_tc_args :: TyPrec -> IfaceTcArgs -> SDoc
ppr_tc_args ctx_prec args
 = let pprTys t ts = ppr_ty ctx_prec t <+> ppr_tc_args ctx_prec ts
   in case args of
738 739 740
        ITC_Nil        -> empty
        ITC_Vis   t ts -> pprTys t ts
        ITC_Invis t ts -> pprTys t ts
741

742
-------------------
Ben Gamari's avatar
Ben Gamari committed
743
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
744 745
pprIfaceForAllPart tvs ctxt sdoc
  = ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc
746

747 748 749 750 751
-- | Like 'pprIfaceForAllPart', but always uses an explicit @forall@.
pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPartMust tvs ctxt sdoc
  = ppr_iface_forall_part ShowForAllMust tvs ctxt sdoc

752
pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
753 754
pprIfaceForAllCoPart tvs sdoc
  = sep [ pprIfaceForAllCo tvs, sdoc ]
755

756
ppr_iface_forall_part :: ShowForAllFlag
Ben Gamari's avatar
Ben Gamari committed
757
                      -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
758 759 760 761
ppr_iface_forall_part show_forall tvs ctxt sdoc
  = sep [ case show_forall of
            ShowForAllMust -> pprIfaceForAll tvs
            ShowForAllWhen -> pprUserIfaceForAll tvs
762 763 764
        , pprIfaceContextArr ctxt
        , sdoc]

765 766 767
-- | Render the "forall ... ." or "forall ... ->" bit of a type.
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll [] = empty
768
pprIfaceForAll bndrs@(TvBndr _ vis : _)
Ben Gamari's avatar
Ben Gamari committed
769
  = add_separator (forAllLit <+> doc) <+> pprIfaceForAll bndrs'
770 771 772 773
  where
    (bndrs', doc) = ppr_itv_bndrs bndrs vis

    add_separator stuff = case vis of
774 775
                            Required -> stuff <+> arrow
                            _inv     -> stuff <>  dot
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
776

777 778 779 780 781

-- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
-- Returns both the list of not-yet-rendered binders and the doc.
-- No anonymous binders here!
ppr_itv_bndrs :: [IfaceForAllBndr]
782
             -> ArgFlag  -- ^ visibility of the first binder in the list
783
             -> ([IfaceForAllBndr], SDoc)
784
ppr_itv_bndrs all_bndrs@(bndr@(TvBndr _ vis) : bndrs) vis1
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
785 786
  | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
                         (bndrs', pprIfaceForAllBndr bndr <+> doc)
787 788 789 790 791 792 793 794 795 796 797
  | otherwise   = (all_bndrs, empty)
ppr_itv_bndrs [] _ = ([], empty)

pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCo []  = empty
pprIfaceForAllCo tvs = text "forall" <+> pprIfaceForAllCoBndrs tvs <> dot

pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs

pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
798
pprIfaceForAllBndr (TvBndr tv Inferred) = sdocWithDynFlags $ \dflags ->
799
                                           if gopt Opt_PrintExplicitForalls dflags
Ben Gamari's avatar
Ben Gamari committed
800 801 802
                                           then braces $ pprIfaceTvBndr False tv
                                           else pprIfaceTvBndr True tv
pprIfaceForAllBndr (TvBndr tv _)        = pprIfaceTvBndr True tv
803 804 805 806

pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (tv, kind_co)
  = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)
807

808 809 810 811 812 813 814 815 816 817 818 819
-- | Show forall flag
--
-- Unconditionally show the forall quantifier with ('ShowForAllMust')
-- or when ('ShowForAllWhen') the names used are free in the binder
-- or when compiling with -fprint-explicit-foralls.
data ShowForAllFlag = ShowForAllMust | ShowForAllWhen

pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType show_forall ty
  = ppr_iface_forall_part show_forall tvs theta (ppr tau)
  where
    (tvs, theta, tau) = splitIfaceSigmaTy ty
820

821
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
822 823 824 825 826
pprUserIfaceForAll tvs
   = sdocWithDynFlags $ \dflags ->
     ppWhen (any tv_has_kind_var tvs || gopt Opt_PrintExplicitForalls dflags) $
     pprIfaceForAll tvs
   where
827 828
     tv_has_kind_var (TvBndr (_,kind) _) = not (ifTypeIsVarFree kind)

829

830
-------------------
831

832
-- See equivalent function in TyCoRep.hs
833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849
pprIfaceTyList :: TyPrec -> IfaceType -> IfaceType -> SDoc
-- Given a type-level list (t1 ': t2), see if we can print
-- it in list notation [t1, ...].
-- Precondition: Opt_PrintExplicitKinds is off
pprIfaceTyList ctxt_prec ty1 ty2
  = case gather ty2 of
      (arg_tys, Nothing)
        -> char '\'' <> brackets (fsep (punctuate comma
                        (map (ppr_ty TopPrec) (ty1:arg_tys))))
      (arg_tys, Just tl)
        -> maybeParen ctxt_prec FunPrec $ hang (ppr_ty FunPrec ty1)
           2 (fsep [ colon <+> ppr_ty FunPrec ty | ty <- arg_tys ++ [tl]])
  where
    gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
     -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
     --             = (tys, Just tl) means ty is of form t1:t2:...tn:tl
    gather (IfaceTyConApp tc tys)
Ben Gamari's avatar
Ben Gamari committed
850
      | tc `ifaceTyConHasKey` consDataConKey
851
      , (ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil))) <- tys
852 853
      , (args, tl) <- gather ty2
      = (ty1:args, tl)
Ben Gamari's avatar
Ben Gamari committed
854
      | tc `ifaceTyConHasKey` nilDataConKey
855 856 857
      = ([], Nothing)
    gather ty = ([], Just ty)

Ben Gamari's avatar
Ben Gamari committed
858 859 860 861 862 863 864 865
pprIfaceTypeApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args

pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
pprTyTcApp ctxt_prec tc tys =
    sdocWithDynFlags $ \dflags ->
    getPprStyle $ \style ->
    pprTyTcApp' ctxt_prec tc tys dflags style
866

Ben Gamari's avatar
Ben Gamari committed
867 868 869
pprTyTcApp' :: TyPrec -> IfaceTyCon -> IfaceTcArgs
            -> DynFlags -> PprStyle -> SDoc
pprTyTcApp' ctxt_prec tc tys dflags style
870
  | ifaceTyConName tc `hasKey` ipClassKey
871
  , ITC_Vis (IfaceLitTy (IfaceStrTyLit n)) (ITC_Vis ty ITC_Nil) <- tys
Ben Gamari's avatar
Ben Gamari committed
872 873
  = maybeParen ctxt_prec FunPrec
    $ char '?' <> ftext n <> text "::" <> ppr_ty TopPrec ty
874

Ben Gamari's avatar
Ben Gamari committed
875 876 877 878 879 880 881 882 883
  | IfaceTupleTyCon arity sort <- ifaceTyConSort info
  , not (debugStyle style)
  , arity == ifaceVisTcArgsLength tys
  = pprTuple sort (ifaceTyConIsPromoted info) tys

  | IfaceSumTyCon arity <- ifaceTyConSort info
  = pprSum arity (ifaceTyConIsPromoted info) tys

  | tc `ifaceTyConHasKey` consDataConKey
884
  , not (gopt Opt_PrintExplicitKinds dflags)
885
  , ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil)) <- tys
886 887
  = pprIfaceTyList ctxt_prec ty1 ty2

Ben Gamari's avatar
Ben Gamari committed
888 889
  | tc `ifaceTyConHasKey` tYPETyConKey
  , ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
Richard Eisenberg's avatar
Richard Eisenberg committed
890
  , rep `ifaceTyConHasKey` liftedRepDataConKey
891
  = kindStar
892

Sylvain Henry's avatar
Sylvain Henry committed
893
  | otherwise
Simon Peyton Jones's avatar
Simon Peyton Jones committed
894
  = getPprDebug $ \dbg ->
Sylvain Henry's avatar
Sylvain Henry committed
895 896 897
    if | not dbg && tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey
         -- Suppress detail unles you _really_ want to see
         -> text "(TypeError ...)"
Ben Gamari's avatar
Ben Gamari committed
898

899 900
       | Just doc <- ppr_equality ctxt_prec tc (tcArgsIfaceTypes tys)
         -> doc
Ben Gamari's avatar
Ben Gamari committed
901

Sylvain Henry's avatar
Sylvain Henry committed
902 903
       | otherwise
         -> ppr_iface_tc_app ppr_ty ctxt_prec tc tys_wo_kinds
904
  where
Ben Gamari's avatar
Ben Gamari committed
905
    info = ifaceTyConInfo tc
906
    tys_wo_kinds = tcArgsIfaceTypes $ stripInvisArgs dflags tys
907

Ben Gamari's avatar
Ben Gamari committed
908 909
-- | Pretty-print a type-level equality.
--
910 911 912 913
-- See Note [Equality predicates in IfaceType]
-- and Note [The equality types story] in TysPrim
ppr_equality :: TyPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality ctxt_prec tc args
Ben Gamari's avatar
Ben Gamari committed
914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934
  | hetero_eq_tc
  , [k1, k2, t1, t2] <- args
  = Just $ print_equality (k1, k2, t1, t2)

  | hom_eq_