IfaceType.hs 50 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

9 10 11
{-# LANGUAGE CPP, FlexibleInstances #-}
    -- FlexibleInstances for Binary (DefMethSpec IfaceType)

12
module IfaceType (
13
        IfExtName, IfLclName,
14

15
        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
16
        IfaceUnivCoProv(..),
17
        IfaceTyCon(..), IfaceTyConInfo(..),
18
        IfaceTyLit(..), IfaceTcArgs(..),
19
        IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
20
        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
21
        IfaceForAllBndr, ArgFlag(..),
22

23 24
        ifConstraintKind, ifTyConBinderTyVar, ifTyConBinderName,

25 26
        -- Equality testing
        IfRnEnv2, emptyIfRnEnv2, eqIfaceType, eqIfaceTypes,
27
        eqIfaceTcArgs, eqIfaceTvBndrs, isIfaceLiftedTypeKind,
28

29
        -- Conversion from Type -> IfaceType
30
        toIfaceType, toIfaceTypes, toIfaceKind, toIfaceTyVar,
31
        toIfaceContext, toIfaceBndr, toIfaceIdBndr,
32
        toIfaceTyCon, toIfaceTyCon_name,
33 34
        toIfaceTcArgs, toIfaceTvBndr, toIfaceTvBndrs,
        toIfaceForAllBndr,
35 36 37

        -- Conversion from IfaceTcArgs -> IfaceType
        tcArgsIfaceTypes,
38

39 40
        -- Conversion from Coercion -> IfaceCoercion
        toIfaceCoercion,
41

42
        -- Printing
43
        pprIfaceType, pprParendIfaceType,
44
        pprIfaceContext, pprIfaceContextArr,
45
        pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
46 47 48 49 50
        pprIfaceBndrs, pprIfaceTcArgs, pprParendIfaceTcArgs,
        pprIfaceForAllPart, pprIfaceForAll, pprIfaceSigmaType,
        pprIfaceCoercion, pprParendIfaceCoercion,
        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,

51 52 53 54 55
        suppressIfaceInvisibles,
        stripIfaceInvisVars,
        stripInvisArgs,
        substIfaceType, substIfaceTyVar, substIfaceTcArgs, mkIfaceTySubst,
        eqIfaceTvBndr
56 57
    ) where

58 59
#include "HsVersions.h"

60
import Coercion
61
import DataCon ( isTupleDataCon )
62 63
import TcType
import DynFlags
64
import TyCoRep  -- needs to convert core types to iface types
65
import TyCon hiding ( pprPromotionQuote )
66
import CoAxiom
67
import Id
Simon Marlow's avatar
Simon Marlow committed
68
import Var
69
-- import RnEnv( FastStringEnv, mkFsEnv, lookupFsEnv )
Simon Marlow's avatar
Simon Marlow committed
70
import TysWiredIn
71
import TysPrim
72
import PrelNames
Simon Marlow's avatar
Simon Marlow committed
73 74
import Name
import BasicTypes
75
import Binary
76 77
import Outputable
import FastString
78
import UniqSet
79
import VarEnv
80 81
import UniqFM
import Util
82

Austin Seipp's avatar
Austin Seipp committed
83 84 85
{-
************************************************************************
*                                                                      *
86
                Local (nested) binders
Austin Seipp's avatar
Austin Seipp committed
87 88 89
*                                                                      *
************************************************************************
-}
90

91
type IfLclName = FastString     -- A local name in iface syntax
92

93 94
type IfExtName = Name   -- An External or WiredIn Name can appear in IfaceSyn
                        -- (However Internal or System Names never should)
95

96
data IfaceBndr          -- Local (non-top-level) binders
97 98
  = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
  | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
99

100 101
type IfaceIdBndr  = (IfLclName, IfaceType)
type IfaceTvBndr  = (IfLclName, IfaceKind)
102

Simon Peyton Jones's avatar
Simon Peyton Jones committed
103 104 105 106
ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName (n,_) = n

type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
107

108 109
data IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy
  = IfaceNoOneShot   -- and Note [The oneShot function] in MkId
110 111 112
  | IfaceOneShot


113 114 115 116 117 118 119 120
{-
%************************************************************************
%*                                                                      *
                IfaceType
%*                                                                      *
%************************************************************************
-}

121
-------------------------------
122
type IfaceKind     = IfaceType
123

124
data IfaceType     -- A kind of universal type, used for types and kinds
125
  = IfaceTyVar    IfLclName               -- Type/coercion variable only, not tycon
126
  | IfaceLitTy    IfaceTyLit
127
  | IfaceAppTy    IfaceType IfaceType
128
  | IfaceFunTy    IfaceType IfaceType
129
  | IfaceDFunTy   IfaceType IfaceType
130
  | IfaceForAllTy IfaceForAllBndr IfaceType
131
  | IfaceTyConApp IfaceTyCon IfaceTcArgs  -- Not necessarily saturated
132 133 134
                                          -- Includes newtypes, synonyms, tuples
  | IfaceCastTy     IfaceType IfaceCoercion
  | IfaceCoercionTy IfaceCoercion
135 136 137 138
  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)
       TupleSort IfaceTyConInfo   -- A bit like IfaceTyCon
       IfaceTcArgs                -- arity = length args
          -- For promoted data cons, the kind args are omitted
139

batterseapower's avatar
batterseapower committed
140
type IfacePredType = IfaceType
141 142
type IfaceContext = [IfacePredType]

143
data IfaceTyLit
144 145
  = IfaceNumTyLit Integer
  | IfaceStrTyLit FastString
146
  deriving (Eq)
147

148
type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
149
type IfaceForAllBndr  = TyVarBndr IfaceTvBndr ArgFlag
150

151
-- See Note [Suppressing invisible arguments]
152 153 154 155 156 157
-- 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
158
  | ITC_Vis   IfaceType IfaceTcArgs   -- "Vis" means show when pretty-printing
159
  | ITC_Invis IfaceKind IfaceTcArgs   -- "Invis" means don't show when pretty-printing
Simon Peyton Jones's avatar
Simon Peyton Jones committed
160
                                      --         except with -fprint-explicit-kinds
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 170 171 172 173

data IfaceTyConInfo   -- Used to guide pretty-printing
                      -- and to disambiguate D from 'D (they share a name)
  = NoIfaceTyConInfo
  | IfacePromotedDataCon
174
    deriving (Eq)
175

176
data IfaceCoercion
177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199
  = IfaceReflCo       Role IfaceType
  | IfaceFunCo        Role IfaceCoercion IfaceCoercion
  | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]
  | IfaceAppCo        IfaceCoercion IfaceCoercion
  | IfaceForAllCo     IfaceTvBndr IfaceCoercion IfaceCoercion
  | 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
200

201 202 203 204 205 206
-- this constant is needed for dealing with pretty-printing classes
ifConstraintKind :: IfaceKind
ifConstraintKind = IfaceTyConApp (IfaceTyCon { ifaceTyConName = getName constraintKindTyCon
                                             , ifaceTyConInfo = NoIfaceTyConInfo })
                                 ITC_Nil

Austin Seipp's avatar
Austin Seipp committed
207
{-
208 209
%************************************************************************
%*                                                                      *
210
                Functions over IFaceTypes
Austin Seipp's avatar
Austin Seipp committed
211 212 213
*                                                                      *
************************************************************************
-}
214

215 216 217
eqIfaceTvBndr :: IfaceTvBndr -> IfaceTvBndr -> Bool
eqIfaceTvBndr (occ1, _) (occ2, _) = occ1 == occ2

218 219 220 221 222 223 224 225 226
isIfaceLiftedTypeKind :: IfaceKind -> Bool
isIfaceLiftedTypeKind (IfaceTyConApp tc ITC_Nil)
  = isLiftedTypeKindTyConName (ifaceTyConName tc)
isIfaceLiftedTypeKind (IfaceTyConApp tc
                       (ITC_Vis (IfaceTyConApp ptr_rep_lifted ITC_Nil) ITC_Nil))
  =  ifaceTyConName tc      == tYPETyConName
  && ifaceTyConName ptr_rep_lifted `hasKey` ptrRepLiftedDataConKey
isIfaceLiftedTypeKind _ = False

227
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
228 229
-- Mainly for printing purposes
splitIfaceSigmaTy ty
230
  = (bndrs, theta, tau)
231
  where
232
    (bndrs, rho)   = split_foralls ty
batterseapower's avatar
batterseapower committed
233
    (theta, tau)   = split_rho rho
234

235 236
    split_foralls (IfaceForAllTy bndr ty)
        = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
237 238
    split_foralls rho = ([], rho)

239 240
    split_rho (IfaceDFunTy ty1 ty2)
        = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
241
    split_rho tau = ([], tau)
242

243
suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
244
suppressIfaceInvisibles dflags tys xs
245 246 247 248 249 250
  | gopt Opt_PrintExplicitKinds dflags = xs
  | otherwise = suppress tys xs
    where
      suppress _       []      = []
      suppress []      a       = a
      suppress (k:ks) a@(_:xs)
251 252
        | isInvisibleTyConBinder k = suppress ks xs
        | otherwise                = a
253

254
stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
255
stripIfaceInvisVars dflags tyvars
256
  | gopt Opt_PrintExplicitKinds dflags = tyvars
257
  | otherwise = filterOut isInvisibleTyConBinder tyvars
258 259 260

-- | Extract a IfaceTvBndr from a IfaceTyConBinder
ifTyConBinderTyVar :: IfaceTyConBinder -> IfaceTvBndr
261
ifTyConBinderTyVar = binderVar
262 263 264

-- | Extract the variable name from a IfaceTyConBinder
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
Simon Peyton Jones's avatar
Simon Peyton Jones committed
265
ifTyConBinderName tcb = ifaceTvBndrName (ifTyConBinderTyVar tcb)
266 267 268 269 270 271 272 273 274 275 276

ifTyVarsOfType :: IfaceType -> UniqSet IfLclName
ifTyVarsOfType ty
  = case ty of
      IfaceTyVar v -> unitUniqSet v
      IfaceAppTy fun arg
        -> ifTyVarsOfType fun `unionUniqSets` ifTyVarsOfType arg
      IfaceFunTy arg res
        -> ifTyVarsOfType arg `unionUniqSets` ifTyVarsOfType res
      IfaceDFunTy arg res
        -> ifTyVarsOfType arg `unionUniqSets` ifTyVarsOfType res
277 278 279 280 281 282 283 284
      IfaceForAllTy bndr ty
        -> let (free, bound) = ifTyVarsOfForAllBndr bndr in
           delListFromUniqSet (ifTyVarsOfType ty) bound `unionUniqSets` free
      IfaceTyConApp _ args -> ifTyVarsOfArgs args
      IfaceLitTy    _      -> emptyUniqSet
      IfaceCastTy ty co
        -> ifTyVarsOfType ty `unionUniqSets` ifTyVarsOfCoercion co
      IfaceCoercionTy co    -> ifTyVarsOfCoercion co
285
      IfaceTupleTy _ _ args -> ifTyVarsOfArgs args
286 287 288 289

ifTyVarsOfForAllBndr :: IfaceForAllBndr
                     -> ( UniqSet IfLclName   -- names used free in the binder
                        , [IfLclName] )       -- names bound by this binder
290
ifTyVarsOfForAllBndr (TvBndr (name, kind) _) = (ifTyVarsOfType kind, [name])
291 292 293 294

ifTyVarsOfArgs :: IfaceTcArgs -> UniqSet IfLclName
ifTyVarsOfArgs args = argv emptyUniqSet args
   where
295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332
     argv vs (ITC_Vis   t ts) = argv (vs `unionUniqSets` (ifTyVarsOfType t)) ts
     argv vs (ITC_Invis k ks) = argv (vs `unionUniqSets` (ifTyVarsOfType k)) ks
     argv vs ITC_Nil          = vs

ifTyVarsOfCoercion :: IfaceCoercion -> UniqSet IfLclName
ifTyVarsOfCoercion = go
  where
    go (IfaceReflCo _ ty)         = ifTyVarsOfType ty
    go (IfaceFunCo _ c1 c2)       = go c1 `unionUniqSets` go c2
    go (IfaceTyConAppCo _ _ cos)  = ifTyVarsOfCoercions cos
    go (IfaceAppCo c1 c2)         = go c1 `unionUniqSets` go c2
    go (IfaceForAllCo (bound, _) kind_co co)
     = go co `delOneFromUniqSet` bound `unionUniqSets` go kind_co
    go (IfaceCoVarCo cv)          = unitUniqSet cv
    go (IfaceAxiomInstCo _ _ cos) = ifTyVarsOfCoercions cos
    go (IfaceUnivCo p _ ty1 ty2)  = go_prov p `unionUniqSets`
                                    ifTyVarsOfType ty1 `unionUniqSets`
                                    ifTyVarsOfType ty2
    go (IfaceSymCo co)            = go co
    go (IfaceTransCo c1 c2)       = go c1 `unionUniqSets` go c2
    go (IfaceNthCo _ co)          = go co
    go (IfaceLRCo _ co)           = go co
    go (IfaceInstCo c1 c2)        = go c1 `unionUniqSets` go c2
    go (IfaceCoherenceCo c1 c2)   = go c1 `unionUniqSets` go c2
    go (IfaceKindCo co)           = go co
    go (IfaceSubCo co)            = go co
    go (IfaceAxiomRuleCo rule cos)
      = unionManyUniqSets
          [ unitUniqSet rule
          , ifTyVarsOfCoercions cos ]

    go_prov IfaceUnsafeCoerceProv    = emptyUniqSet
    go_prov (IfacePhantomProv co)    = go co
    go_prov (IfaceProofIrrelProv co) = go co
    go_prov (IfacePluginProv _)      = emptyUniqSet

ifTyVarsOfCoercions :: [IfaceCoercion] -> UniqSet IfLclName
ifTyVarsOfCoercions = foldr (unionUniqSets . ifTyVarsOfCoercion) emptyUniqSet
333

Austin Seipp's avatar
Austin Seipp committed
334
{-
335 336 337
Substitutions on IfaceType. This is only used 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.
Austin Seipp's avatar
Austin Seipp committed
338
-}
339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354

type IfaceTySubst = FastStringEnv IfaceType

mkIfaceTySubst :: [IfaceTvBndr] -> [IfaceType] -> IfaceTySubst
mkIfaceTySubst tvs tys = mkFsEnv $ zipWithEqual "mkIfaceTySubst" (\(fs,_) ty -> (fs,ty)) tvs tys

substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
substIfaceType env ty
  = go ty
  where
    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)
355
    go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceTcArgs env tys)
356
    go (IfaceForAllTy {})     = pprPanic "substIfaceType" (ppr ty)
357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
    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)
    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
384 385 386 387 388

substIfaceTcArgs :: IfaceTySubst -> IfaceTcArgs -> IfaceTcArgs
substIfaceTcArgs env args
  = go args
  where
389 390 391
    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)
392 393 394 395 396

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

398 399 400 401 402 403
{-
************************************************************************
*                                                                      *
                Equality over IfaceTypes
*                                                                      *
************************************************************************
404 405 406 407 408 409 410 411

Note [No kind check in ifaces]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We check iface types for equality only when checking the consistency
between two user-written signatures. In these cases, there is no possibility
for a kind mismatch. So we omit the kind check (which would be impossible to
write, anyway.)

412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442
-}

-- Like an RnEnv2, but mapping from FastString to deBruijn index
-- DeBruijn; see eqTypeX
type BoundVar = Int
data IfRnEnv2
  = IRV2 { ifenvL :: UniqFM BoundVar -- from FastString
         , ifenvR :: UniqFM BoundVar
         , ifenv_next :: BoundVar
         }

emptyIfRnEnv2 :: IfRnEnv2
emptyIfRnEnv2 = IRV2 { ifenvL = emptyUFM
                     , ifenvR = emptyUFM
                     , ifenv_next = 0 }

rnIfOccL :: IfRnEnv2 -> IfLclName -> Maybe BoundVar
rnIfOccL env = lookupUFM (ifenvL env)

rnIfOccR :: IfRnEnv2 -> IfLclName -> Maybe BoundVar
rnIfOccR env = lookupUFM (ifenvR env)

extendIfRnEnv2 :: IfRnEnv2 -> IfLclName -> IfLclName -> IfRnEnv2
extendIfRnEnv2 IRV2 { ifenvL = lenv
                    , ifenvR = renv
                    , ifenv_next = n } tv1 tv2
             = IRV2 { ifenvL = addToUFM lenv tv1 n
                    , ifenvR = addToUFM renv tv2 n
                    , ifenv_next = n + 1
                    }

443
-- See Note [No kind check in ifaces]
444 445 446 447 448 449 450 451 452 453 454 455 456
eqIfaceType :: IfRnEnv2 -> IfaceType -> IfaceType -> Bool
eqIfaceType env (IfaceTyVar tv1) (IfaceTyVar tv2) =
    case (rnIfOccL env tv1, rnIfOccR env tv2) of
        (Just v1, Just v2) -> v1 == v2
        (Nothing, Nothing) -> tv1 == tv2
        _ -> False
eqIfaceType _   (IfaceLitTy l1) (IfaceLitTy l2) = l1 == l2
eqIfaceType env (IfaceAppTy t11 t12) (IfaceAppTy t21 t22)
    = eqIfaceType env t11 t21 && eqIfaceType env t12 t22
eqIfaceType env (IfaceFunTy t11 t12) (IfaceFunTy t21 t22)
    = eqIfaceType env t11 t21 && eqIfaceType env t12 t22
eqIfaceType env (IfaceDFunTy t11 t12) (IfaceDFunTy t21 t22)
    = eqIfaceType env t11 t21 && eqIfaceType env t12 t22
457 458
eqIfaceType env (IfaceForAllTy bndr1 t1) (IfaceForAllTy bndr2 t2)
    = eqIfaceForAllBndr env bndr1 bndr2 (\env' -> eqIfaceType env' t1 t2)
459 460 461 462
eqIfaceType env (IfaceTyConApp tc1 tys1) (IfaceTyConApp tc2 tys2)
    = tc1 == tc2 && eqIfaceTcArgs env tys1 tys2
eqIfaceType env (IfaceTupleTy s1 tc1 tys1) (IfaceTupleTy s2 tc2 tys2)
    = s1 == s2 && tc1 == tc2 && eqIfaceTcArgs env tys1 tys2
463 464 465 466
eqIfaceType env (IfaceCastTy t1 _) (IfaceCastTy t2 _)
    = eqIfaceType env t1 t2
eqIfaceType _   (IfaceCoercionTy {}) (IfaceCoercionTy {})
    = True
467 468 469 470 471
eqIfaceType _ _ _ = False

eqIfaceTypes :: IfRnEnv2 -> [IfaceType] -> [IfaceType] -> Bool
eqIfaceTypes env tys1 tys2 = and (zipWith (eqIfaceType env) tys1 tys2)

472 473 474
eqIfaceForAllBndr :: IfRnEnv2 -> IfaceForAllBndr -> IfaceForAllBndr
                  -> (IfRnEnv2 -> Bool)  -- continuation
                  -> Bool
475
eqIfaceForAllBndr env (TvBndr (tv1, k1) vis1) (TvBndr (tv2, k2) vis2) k
476 477 478
  = eqIfaceType env k1 k2 && vis1 == vis2 &&
    k (extendIfRnEnv2 env tv1 tv2)

479 480
eqIfaceTcArgs :: IfRnEnv2 -> IfaceTcArgs -> IfaceTcArgs -> Bool
eqIfaceTcArgs _ ITC_Nil ITC_Nil = True
481
eqIfaceTcArgs env (ITC_Vis ty1 tys1) (ITC_Vis ty2 tys2)
482
    = eqIfaceType env ty1 ty2 && eqIfaceTcArgs env tys1 tys2
483
eqIfaceTcArgs env (ITC_Invis ty1 tys1) (ITC_Invis ty2 tys2)
484 485 486 487 488 489 490 491 492 493 494 495 496
    = eqIfaceType env ty1 ty2 && eqIfaceTcArgs env tys1 tys2
eqIfaceTcArgs _ _ _ = False

-- | Similar to 'eqTyVarBndrs', checks that tyvar lists
-- are the same length and have matching kinds; if so, extend the
-- 'IfRnEnv2'.  Returns 'Nothing' if they don't match.
eqIfaceTvBndrs :: IfRnEnv2 -> [IfaceTvBndr] -> [IfaceTvBndr] -> Maybe IfRnEnv2
eqIfaceTvBndrs env [] [] = Just env
eqIfaceTvBndrs env ((tv1, k1):tvs1) ((tv2, k2):tvs2)
  | eqIfaceType env k1 k2
  = eqIfaceTvBndrs (extendIfRnEnv2 env tv1 tv2) tvs1 tvs2
eqIfaceTvBndrs _ _ _ = Nothing

Austin Seipp's avatar
Austin Seipp committed
497 498 499
{-
************************************************************************
*                                                                      *
500
                Functions over IFaceTcArgs
Austin Seipp's avatar
Austin Seipp committed
501 502 503
*                                                                      *
************************************************************************
-}
504

505 506
stripInvisArgs :: DynFlags -> IfaceTcArgs -> IfaceTcArgs
stripInvisArgs dflags tys
507
  | gopt Opt_PrintExplicitKinds dflags = tys
508
  | otherwise = suppress_invis tys
509
    where
510
      suppress_invis c
511
        = case c of
512
            ITC_Invis _ ts -> suppress_invis ts
513 514 515
            _ -> c

toIfaceTcArgs :: TyCon -> [Type] -> IfaceTcArgs
516
-- See Note [Suppressing invisible arguments]
517
toIfaceTcArgs tc ty_args
518
  = go (mkEmptyTCvSubst in_scope) (tyConKind tc) ty_args
519
  where
520 521 522 523 524 525
    in_scope = mkInScopeSet (tyCoVarsOfTypes ty_args)

    go _   _                   []     = ITC_Nil
    go env ty                  ts
      | Just ty' <- coreView ty
      = go env ty' ts
Simon Peyton Jones's avatar
Simon Peyton Jones committed
526
    go env (ForAllTy (TvBndr tv vis) res) (t:ts)
527 528
      | isVisibleArgFlag vis = ITC_Vis   t' ts'
      | otherwise            = ITC_Invis t' ts'
529 530
      where
        t'  = toIfaceType t
Simon Peyton Jones's avatar
Simon Peyton Jones committed
531 532 533 534
        ts' = go (extendTvSubst env tv t) res ts

    go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps
      = ITC_Vis (toIfaceType t) (go env res ts)
535 536 537 538 539

    go env (TyVarTy tv) ts
      | Just ki <- lookupTyVar env tv = go env ki ts
    go env kind (t:ts) = WARN( True, ppr tc $$ ppr (tyConKind tc) $$ ppr ty_args )
                         ITC_Vis (toIfaceType t) (go env kind ts) -- Ill-kinded
540 541 542

tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
tcArgsIfaceTypes ITC_Nil = []
543 544
tcArgsIfaceTypes (ITC_Invis t ts) = t : tcArgsIfaceTypes ts
tcArgsIfaceTypes (ITC_Vis   t ts) = t : tcArgsIfaceTypes ts
545

Austin Seipp's avatar
Austin Seipp committed
546
{-
547 548
Note [Suppressing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
549
We use the IfaceTcArgs to specify which of the arguments to a type
Simon Peyton Jones's avatar
Simon Peyton Jones committed
550 551
constructor should be displayed when pretty-printing, under
the control of -fprint-explicit-kinds.
552
See also Type.filterOutInvisibleTypes.
553 554 555 556 557 558 559 560
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
561 562
************************************************************************
*                                                                      *
563
                Pretty-printing
Austin Seipp's avatar
Austin Seipp committed
564 565 566
*                                                                      *
************************************************************************
-}
567

568 569 570 571 572 573 574 575 576 577
pprIfaceInfixApp :: (TyPrec -> a -> SDoc) -> TyPrec -> SDoc -> a -> a -> SDoc
pprIfaceInfixApp pp p pp_tc ty1 ty2
  = maybeParen p FunPrec $
    sep [pp FunPrec ty1, pprInfixVar True pp_tc <+> pp FunPrec ty2]

pprIfacePrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp p pp_fun pp_tys
  | null pp_tys = pp_fun
  | otherwise   = maybeParen p TyConPrec $
                  hang pp_fun 2 (sep pp_tys)
578

Austin Seipp's avatar
Austin Seipp committed
579
-- ----------------------------- Printing binders ------------------------------------
580 581 582 583 584 585 586 587

instance Outputable IfaceBndr where
    ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
    ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr

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

588 589 590 591
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b
pprIfaceLamBndr (b, IfaceOneShot)   = ppr b <> text "[OneShot]"

592
pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc
593
pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)
594 595

pprIfaceTvBndr :: IfaceTvBndr -> SDoc
596 597 598
pprIfaceTvBndr (tv, ki)
  | isIfaceLiftedTypeKind ki = ppr tv
  | otherwise                = parens (ppr tv <+> dcolon <+> ppr ki)
599

600 601 602
pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders = sep . map go
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
603
    go tcb = pprIfaceTvBndr (ifTyConBinderTyVar tcb)
604 605 606 607 608 609 610 611 612 613 614 615 616 617 618

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)
619 620 621 622 623 624 625 626 627 628 629

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
630

Austin Seipp's avatar
Austin Seipp committed
631
-- ----------------------------- Printing IfaceType ------------------------------------
632 633 634

---------------------------------
instance Outputable IfaceType where
635
  ppr ty = pprIfaceType ty
636

637
pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
638 639
pprIfaceType       = ppr_ty TopPrec
pprParendIfaceType = ppr_ty TyConPrec
640

641
ppr_ty :: TyPrec -> IfaceType -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
642
ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
643
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = sdocWithDynFlags (pprTyTcApp ctxt_prec tc tys)
644
ppr_ty _         (IfaceTupleTy s i tys) = pprTuple s i tys
645
ppr_ty _         (IfaceLitTy n)         = ppr_tylit n
646
        -- Function types
647
ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
648
  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
649 650
    maybeParen ctxt_prec FunPrec $
    sep [ppr_ty FunPrec ty1, sep (ppr_fun_tail ty2)]
651
  where
652
    ppr_fun_tail (IfaceFunTy ty1 ty2)
653
      = (arrow <+> ppr_ty FunPrec ty1) : ppr_fun_tail ty2
654
    ppr_fun_tail other_ty
655
      = [arrow <+> pprIfaceType other_ty]
656

657
ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
658 659
  = maybeParen ctxt_prec TyConPrec $
    ppr_ty FunPrec ty1 <+> pprParendIfaceType ty2
660

661 662
ppr_ty ctxt_prec (IfaceCastTy ty co)
  = maybeParen ctxt_prec FunPrec $
663
    sep [ppr_ty FunPrec ty, text "`cast`", ppr_co FunPrec co]
664 665 666 667

ppr_ty ctxt_prec (IfaceCoercionTy co)
  = ppr_co ctxt_prec co

668 669 670 671 672 673 674 675 676 677 678 679 680 681
ppr_ty ctxt_prec ty
  = maybeParen ctxt_prec FunPrec (ppr_iface_sigma_type True ty)

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
682 683 684
        ITC_Nil        -> empty
        ITC_Vis   t ts -> pprTys t ts
        ITC_Invis t ts -> pprTys t ts
685

686
-------------------
687 688 689
ppr_iface_sigma_type :: Bool -> IfaceType -> SDoc
ppr_iface_sigma_type show_foralls_unconditionally ty
  = ppr_iface_forall_part show_foralls_unconditionally tvs theta (ppr tau)
690
  where
691
    (tvs, theta, tau) = splitIfaceSigmaTy ty
692

693 694
-------------------
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
695 696
pprIfaceForAllPart tvs ctxt sdoc = ppr_iface_forall_part False tvs ctxt sdoc

697 698 699 700
pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart tvs sdoc = sep [ pprIfaceForAllCo tvs
                                    , sdoc ]

701
ppr_iface_forall_part :: Outputable a
702
                      => Bool -> [IfaceForAllBndr] -> [a] -> SDoc -> SDoc
703 704 705 706 707 708 709
ppr_iface_forall_part show_foralls_unconditionally tvs ctxt sdoc
  = sep [ if show_foralls_unconditionally
          then pprIfaceForAll tvs
          else pprUserIfaceForAll tvs
        , pprIfaceContextArr ctxt
        , sdoc]

710 711 712
-- | Render the "forall ... ." or "forall ... ->" bit of a type.
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll [] = empty
713
pprIfaceForAll bndrs@(TvBndr _ vis : _)
714 715 716 717 718
  = add_separator (text "forall" <+> doc) <+> pprIfaceForAll bndrs'
  where
    (bndrs', doc) = ppr_itv_bndrs bndrs vis

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

722 723 724 725 726

-- | 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]
727
             -> ArgFlag  -- ^ visibility of the first binder in the list
728
             -> ([IfaceForAllBndr], SDoc)
729
ppr_itv_bndrs all_bndrs@(bndr@(TvBndr _ vis) : bndrs) vis1
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
730 731
  | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
                         (bndrs', pprIfaceForAllBndr bndr <+> doc)
732 733 734 735 736 737 738 739 740 741 742
  | 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
743
pprIfaceForAllBndr (TvBndr tv Inferred) = sdocWithDynFlags $ \dflags ->
744 745 746
                                           if gopt Opt_PrintExplicitForalls dflags
                                           then braces $ pprIfaceTvBndr tv
                                           else pprIfaceTvBndr tv
747
pprIfaceForAllBndr (TvBndr tv _)        = pprIfaceTvBndr tv
748 749 750 751

pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (tv, kind_co)
  = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)
752 753 754 755

pprIfaceSigmaType :: IfaceType -> SDoc
pprIfaceSigmaType ty = ppr_iface_sigma_type False ty

756
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
757 758 759 760 761
pprUserIfaceForAll tvs
   = sdocWithDynFlags $ \dflags ->
     ppWhen (any tv_has_kind_var tvs || gopt Opt_PrintExplicitForalls dflags) $
     pprIfaceForAll tvs
   where
762 763 764
     tv_has_kind_var bndr
       = not (isEmptyUniqSet (fst (ifTyVarsOfForAllBndr bndr)))

765
-------------------
766

767
-- See equivalent function in TyCoRep.hs
768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785
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)
      | tcname == consDataConName
786
      , (ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil))) <- tys
787 788 789 790 791 792 793 794 795 796 797 798
      , (args, tl) <- gather ty2
      = (ty1:args, tl)
      | tcname == nilDataConName
      = ([], Nothing)
      where tcname = ifaceTyConName tc
    gather ty = ([], Just ty)

pprIfaceTypeApp :: IfaceTyCon -> IfaceTcArgs -> SDoc
pprIfaceTypeApp tc args = sdocWithDynFlags (pprTyTcApp TopPrec tc args)

pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> DynFlags -> SDoc
pprTyTcApp ctxt_prec tc tys dflags
799
  | ifaceTyConName tc `hasKey` ipClassKey
800
  , ITC_Vis (IfaceLitTy (IfaceStrTyLit n)) (ITC_Vis ty ITC_Nil) <- tys
801
  = char '?' <> ftext n <> text "::" <> ppr_ty TopPrec ty
802 803 804

  | ifaceTyConName tc == consDataConName
  , not (gopt Opt_PrintExplicitKinds dflags)
805
  , ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil)) <- tys
806 807
  = pprIfaceTyList ctxt_prec ty1 ty2

808
  | ifaceTyConName tc == tYPETyConName
809 810 811 812 813 814 815 816
  , ITC_Vis (IfaceTyConApp ptr_rep ITC_Nil) ITC_Nil <- tys
  , ifaceTyConName ptr_rep `hasKey` ptrRepLiftedDataConKey
  = char '*'

  | ifaceTyConName tc == tYPETyConName
  , ITC_Vis (IfaceTyConApp ptr_rep ITC_Nil) ITC_Nil <- tys
  , ifaceTyConName ptr_rep `hasKey` ptrRepUnliftedDataConKey
  = char '#'
817

818 819 820
  | otherwise
  = ppr_iface_tc_app ppr_ty ctxt_prec tc tys_wo_kinds
  where
821
    tys_wo_kinds = tcArgsIfaceTypes $ stripInvisArgs dflags tys
822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840

pprIfaceCoTcApp :: TyPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp ctxt_prec tc tys = ppr_iface_tc_app ppr_co ctxt_prec tc tys

ppr_iface_tc_app :: (TyPrec -> a -> SDoc) -> TyPrec -> IfaceTyCon -> [a] -> SDoc
ppr_iface_tc_app pp _ tc [ty]
  | n == listTyConName = pprPromotionQuote tc <> brackets (pp TopPrec ty)
  | n == parrTyConName = pprPromotionQuote tc <> paBrackets (pp TopPrec ty)
  where
    n = ifaceTyConName tc

ppr_iface_tc_app pp ctxt_prec tc tys
  | not (isSymOcc (nameOccName tc_name))
  = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp TyConPrec) tys)

  | [ty1,ty2] <- tys  -- Infix, two arguments;
                      -- we know nothing of precedence though
  = pprIfaceInfixApp pp ctxt_prec (ppr tc) ty1 ty2

841 842
  |  tc_name == starKindTyConName || tc_name == unliftedTypeKindTyConName
  || tc_name == unicodeStarKindTyConName
843 844 845 846
  = ppr tc   -- Do not wrap *, # in parens

  | otherwise
  = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp TyConPrec) tys)
847
  where
848 849
    tc_name = ifaceTyConName tc

850 851
pprTuple :: TupleSort -> IfaceTyConInfo -> IfaceTcArgs -> SDoc
pprTuple sort info args
852 853
  =   -- drop the RuntimeRep vars.
      -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
854 855 856 857 858 859 860
    let tys   = tcArgsIfaceTypes args
        args' = case sort of
                  UnboxedTuple -> drop (length tys `div` 2) tys
                  _            -> tys
    in
    pprPromotionQuoteI info <>
    tupleParens sort (pprWithCommas pprIfaceType args')
861

862
ppr_tylit :: IfaceTyLit -> SDoc
863 864
ppr_tylit (IfaceNumTyLit n) = integer n
ppr_tylit (IfaceStrTyLit n) = text (show n)
865

866
pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
867 868
pprIfaceCoercion = ppr_co TopPrec
pprParendIfaceCoercion = ppr_co TyConPrec
869

870
ppr_co :: TyPrec -> IfaceCoercion -> SDoc
871 872
ppr_co _         (IfaceReflCo r ty) = angleBrackets (ppr ty) <> ppr_role r
ppr_co ctxt_prec (IfaceFunCo r co1 co2)
873 874
  = maybeParen ctxt_prec FunPrec $
    sep (ppr_co FunPrec co1 : ppr_fun_tail co2)
875 876
  where
    ppr_fun_tail (IfaceFunCo r co1 co2)
877
      = (arrow <> ppr_role r <+> ppr_co FunPrec co1) : ppr_fun_tail co2
878 879 880 881
    ppr_fun_tail other_co
      = [arrow <> ppr_role r <+> pprIfaceCoercion other_co]

ppr_co _         (IfaceTyConAppCo r tc cos)
882
  = parens (pprIfaceCoTcApp TopPrec tc cos) <> ppr_role r
883
ppr_co ctxt_prec (IfaceAppCo co1 co2)
884 885
  = maybeParen ctxt_prec TyConPrec $
    ppr_co FunPrec co1 <+> pprParendIfaceCoercion co2
886 887
ppr_co ctxt_prec co@(IfaceForAllCo {})
  = maybeParen ctxt_prec FunPrec (pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co))
888 889 890
  where
    (tvs, inner_co) = split_co co

891 892
    split_co (IfaceForAllCo (name, _) kind_co co')
      = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
893 894 895 896
    split_co co' = ([], co')

ppr_co _         (IfaceCoVarCo covar)       = ppr covar

897
ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)
898
  = maybeParen ctxt_prec TyConPrec $
899
    text "UnsafeCo" <+> ppr r <+>
900 901
    pprParendIfaceType ty1 <+> pprParendIfaceType ty2

902 903 904
ppr_co _         (IfaceUnivCo _ _ ty1 ty2)
  = angleBrackets ( ppr ty1 <> comma <+> ppr ty2 )

905
ppr_co ctxt_prec (IfaceInstCo co ty)
906
  = maybeParen ctxt_prec TyConPrec $
907
    text "Inst" <+> pprParendIfaceCoercion co
908
                        <+> pprParendIfaceCoercion ty
909

910 911
ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos)
  = maybeParen ctxt_prec TyConPrec $ ppr tc <+> parens (interpp'SP cos)