Type.hs 74.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, 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
{-# LANGUAGE TupleSections #-}
12
{-# LANGUAGE LambdaCase #-}
13 14
    -- FlexibleInstances for Binary (DefMethSpec IfaceType)

15
module GHC.Iface.Type (
16
        IfExtName, IfLclName,
17

18
        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
Ningning Xie's avatar
Ningning Xie committed
19
        IfaceMCoercion(..),
20
        IfaceUnivCoProv(..),
21
        IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..),
22
        IfaceTyLit(..), IfaceAppArgs(..),
23
        IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
24
        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
25 26
        IfaceForAllBndr, ArgFlag(..), AnonArgFlag(..),
        ForallVisFlag(..), ShowForAllFlag(..),
27
        mkIfaceForAllTvBndr,
28
        mkIfaceTyConKind,
29

30
        ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
Ningning Xie's avatar
Ningning Xie committed
31
        ifTyConBinderVar, ifTyConBinderName,
32

33
        -- Equality testing
34
        isIfaceLiftedTypeKind,
35

36 37
        -- Conversion from IfaceAppArgs to IfaceTypes/ArgFlags
        appArgsIfaceTypes, appArgsIfaceTypesArgFlags,
38

39
        -- Printing
40 41
        SuppressBndrSig(..),
        UseBndrParens(..),
42
        pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
43
        pprIfaceContext, pprIfaceContextArr,
44
        pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
45
        pprIfaceBndrs, pprIfaceAppArgs, pprParendIfaceAppArgs,
46 47
        pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,
        pprIfaceSigmaType, pprIfaceTyLit,
48 49
        pprIfaceCoercion, pprParendIfaceCoercion,
        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
Ben Gamari's avatar
Ben Gamari committed
50
        pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
51
        isIfaceTauType,
52

53 54 55
        suppressIfaceInvisibles,
        stripIfaceInvisVars,
        stripInvisArgs,
56

57
        mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst
58 59
    ) where

60 61
#include "HsVersions.h"

62 63
import GhcPrelude

64
import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon
65
                                 , liftedRepDataConTyCon, tupleTyConName )
66
import {-# SOURCE #-} Type       ( isRuntimeRepTy )
Ben Gamari's avatar
Ben Gamari committed
67

68
import DynFlags
69
import TyCon hiding ( pprPromotionQuote )
70
import CoAxiom
Simon Marlow's avatar
Simon Marlow committed
71
import Var
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
Ben Gamari's avatar
Ben Gamari committed
78
import FastStringEnv
79
import Util
80

81
import Data.Maybe( isJust )
82
import qualified Data.Semigroup as Semi
83
import Control.DeepSeq
Ben Gamari's avatar
Ben Gamari committed
84

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

93
type IfLclName = FastString     -- A local name in iface syntax
94

95
type IfExtName = Name   -- An External or WiredIn Name can appear in Iface syntax
96
                        -- (However Internal or System Names never should)
97

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

102 103
type IfaceIdBndr  = (IfLclName, IfaceType)
type IfaceTvBndr  = (IfLclName, IfaceKind)
104

105 106 107
ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName (n,_) = n

Ningning Xie's avatar
Ningning Xie committed
108 109 110 111 112 113 114
ifaceIdBndrName :: IfaceIdBndr -> IfLclName
ifaceIdBndrName (n,_) = n

ifaceBndrName :: IfaceBndr -> IfLclName
ifaceBndrName (IfaceTvBndr bndr) = ifaceTvBndrName bndr
ifaceBndrName (IfaceIdBndr bndr) = ifaceIdBndrName bndr

115 116 117 118
ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType (IfaceIdBndr (_, t)) = t
ifaceBndrType (IfaceTvBndr (_, t)) = t

119
type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
120

121 122
data IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy
  = IfaceNoOneShot   -- and Note [The oneShot function] in MkId
123 124 125
  | IfaceOneShot


126 127 128 129 130 131 132 133
{-
%************************************************************************
%*                                                                      *
                IfaceType
%*                                                                      *
%************************************************************************
-}

134
-------------------------------
135
type IfaceKind     = IfaceType
136

137 138 139
-- | A kind of universal type, used for types and kinds.
--
-- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType'
140
-- before being printed. See Note [Pretty printing via Iface syntax] in PprTyThing
141
data IfaceType
142
  = IfaceFreeTyVar TyVar                -- See Note [Free tyvars in IfaceType]
143 144
  | IfaceTyVar     IfLclName            -- Type/coercion variable only, not tycon
  | IfaceLitTy     IfaceTyLit
145 146 147 148
  | IfaceAppTy     IfaceType IfaceAppArgs
                             -- See Note [Suppressing invisible arguments] for
                             -- an explanation of why the second field isn't
                             -- IfaceType, analogous to AppTy.
149
  | IfaceFunTy     AnonArgFlag IfaceType IfaceType
150
  | IfaceForAllTy  IfaceForAllBndr IfaceType
151 152
  | IfaceTyConApp  IfaceTyCon IfaceAppArgs  -- Not necessarily saturated
                                            -- Includes newtypes, synonyms, tuples
153 154
  | IfaceCastTy     IfaceType IfaceCoercion
  | IfaceCoercionTy IfaceCoercion
Ben Gamari's avatar
Ben Gamari committed
155

156
  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)
Ben Gamari's avatar
Ben Gamari committed
157
       TupleSort                  -- What sort of tuple?
158
       PromotionFlag                 -- A bit like IfaceTyCon
159
       IfaceAppArgs               -- arity = length args
160
          -- For promoted data cons, the kind args are omitted
161

batterseapower's avatar
batterseapower committed
162
type IfacePredType = IfaceType
163 164
type IfaceContext = [IfacePredType]

165
data IfaceTyLit
166 167
  = IfaceNumTyLit Integer
  | IfaceStrTyLit FastString
168
  deriving (Eq)
169

Ningning Xie's avatar
Ningning Xie committed
170 171
type IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis
type IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag
172

173 174 175 176
-- | Make an 'IfaceForAllBndr' from an 'IfaceTvBndr'.
mkIfaceForAllTvBndr :: ArgFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr vis var = Bndr (IfaceTvBndr var) vis

177 178 179 180 181 182 183 184 185
-- | Build the 'tyConKind' from the binders and the result kind.
-- Keep in sync with 'mkTyConKind' in types/TyCon.
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceKind -> IfaceKind
mkIfaceTyConKind bndrs res_kind = foldr mk res_kind bndrs
  where
    mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind
    mk (Bndr tv (AnonTCB af))   k = IfaceFunTy af (ifaceBndrType tv) k
    mk (Bndr tv (NamedTCB vis)) k = IfaceForAllTy (Bndr tv vis) k

186 187
-- | Stores the arguments in a type application as a list.
-- See @Note [Suppressing invisible arguments]@.
188 189
data IfaceAppArgs
  = IA_Nil
190 191 192 193 194 195 196 197 198 199 200 201 202
  | IA_Arg IfaceType    -- The type argument

           ArgFlag      -- The argument's visibility. We store this here so
                        -- that we can:
                        --
                        -- 1. Avoid pretty-printing invisible (i.e., specified
                        --    or inferred) arguments when
                        --    -fprint-explicit-kinds isn't enabled, or
                        -- 2. When -fprint-explicit-kinds *is*, enabled, print
                        --    specified arguments in @(...) and inferred
                        --    arguments in @{...}.

           IfaceAppArgs -- The rest of the arguments
203

204
instance Semi.Semigroup IfaceAppArgs where
205 206
  IA_Nil <> xs              = xs
  IA_Arg ty argf rest <> xs = IA_Arg ty argf (rest Semi.<> xs)
207

208 209
instance Monoid IfaceAppArgs where
  mempty = IA_Nil
210
  mappend = (Semi.<>)
Ben Gamari's avatar
Ben Gamari committed
211

212 213 214 215
-- Encodes type constructors, kind constructors,
-- coercion constructors, the lot.
-- We have to tag them in order to pretty print them
-- properly.
216 217
data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName
                             , ifaceTyConInfo :: IfaceTyConInfo }
218
    deriving (Eq)
219

Ben Gamari's avatar
Ben Gamari committed
220 221 222 223 224 225 226 227 228 229 230 231
-- | 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)@

232 233 234 235 236 237
                    | IfaceEqualityTyCon
                      -- ^ A heterogeneous equality TyCon
                      --   (i.e. eqPrimTyCon, eqReprPrimTyCon, heqTyCon)
                      -- that is actually being applied to two types
                      -- of the same kind.  This affects pretty-printing
                      -- only: see Note [Equality predicates in IfaceType]
Ben Gamari's avatar
Ben Gamari committed
238 239
                    deriving (Eq)

240 241 242 243 244 245
instance Outputable IfaceTyConSort where
  ppr IfaceNormalTyCon         = text "normal"
  ppr (IfaceTupleTyCon n sort) = ppr sort <> colon <> ppr n
  ppr (IfaceSumTyCon n)        = text "sum:" <> ppr n
  ppr IfaceEqualityTyCon       = text "equality"

246
{- Note [Free tyvars in IfaceType]
247
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Simon Peyton Jones's avatar
Simon Peyton Jones committed
248 249
Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to
an IfaceType and pretty printing that.  This eliminates a lot of
250
pretty-print duplication, and it matches what we do with pretty-
251
printing TyThings. See Note [Pretty printing via Iface syntax] in PprTyThing.
252 253 254 255 256 257

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.

258
So we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor.
259 260
Note that:

261 262
* We never expect to serialise an IfaceFreeTyVar into an interface file, nor
  to deserialise one.  IfaceFreeTyVar is used only in the "convert to IfaceType
263 264
  and then pretty-print" pipeline.

265
We do the same for covars, naturally.
266

Ben Gamari's avatar
Ben Gamari committed
267 268 269
Note [Equality predicates in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has several varieties of type equality (see Note [The equality types story]
270
in TysPrim for details).  In an effort to avoid confusing users, we suppress
271 272 273 274 275
the differences during pretty printing unless certain flags are enabled.
Here is how each equality predicate* is printed in homogeneous and
heterogeneous contexts, depending on which combination of the
-fprint-explicit-kinds and -fprint-equality-relations flags is used:

276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298
--------------------------------------------------------------------------------------------
|         Predicate             |        Neither flag        |    -fprint-explicit-kinds   |
|-------------------------------|----------------------------|-----------------------------|
| a ~ b         (homogeneous)   |        a ~ b               | (a :: Type) ~  (b :: Type)  |
| a ~~ b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |
| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |
| a ~# b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |
| a ~# b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |
| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |
| a ~R# b,      homogeneously   |        Coercible a b       | Coercible @Type a b         |
| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |
|-------------------------------|----------------------------|-----------------------------|
|         Predicate             | -fprint-equality-relations |          Both flags         |
|-------------------------------|----------------------------|-----------------------------|
| a ~ b         (homogeneous)   |        a ~  b              | (a :: Type) ~  (b :: Type)  |
| a ~~ b,       homogeneously   |        a ~~ b              | (a :: Type) ~~ (b :: Type)  |
| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |
| a ~# b,       homogeneously   |        a ~# b              | (a :: Type) ~# (b :: Type)  |
| a ~# b,       heterogeneously |        a ~# c              | (a :: Type) ~# (c :: k)     |
| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |
| a ~R# b,      homogeneously   |        a ~R# b             | (a :: Type) ~R# (b :: Type) |
| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |
--------------------------------------------------------------------------------------------
299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318

(* There is no heterogeneous, representational, lifted equality counterpart
to (~~). There could be, but there seems to be no use for it.)

This table adheres to the following rules:

A. With -fprint-equality-relations, print the true equality relation.
B. Without -fprint-equality-relations:
     i. If the equality is representational and homogeneous, use Coercible.
    ii. Otherwise, if the equality is representational, use ~R#.
   iii. If the equality is nominal and homogeneous, use ~.
    iv. Otherwise, if the equality is nominal, use ~~.
C. With -fprint-explicit-kinds, print kinds on both sides of an infix operator,
   as above; or print the kind with Coercible.
D. Without -fprint-explicit-kinds, don't print kinds.

A hetero-kinded equality is used homogeneously when it is applied to two
identical kinds. Unfortunately, determining this from an IfaceType isn't
possible since we can't see through type synonyms. Consequently, we need to
record whether this particular application is homogeneous in IfaceTyConSort
319 320
for the purposes of pretty-printing.

321
See Note [The equality types story] in TysPrim.
Ben Gamari's avatar
Ben Gamari committed
322 323
-}

324 325
data IfaceTyConInfo   -- Used to guide pretty-printing
                      -- and to disambiguate D from 'D (they share a name)
326
  = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag
Ben Gamari's avatar
Ben Gamari committed
327
                   , ifaceTyConSort       :: IfaceTyConSort }
328
    deriving (Eq)
329

Ningning Xie's avatar
Ningning Xie committed
330 331 332 333
data IfaceMCoercion
  = IfaceMRefl
  | IfaceMCo IfaceCoercion

334
data IfaceCoercion
Ningning Xie's avatar
Ningning Xie committed
335 336
  = IfaceReflCo       IfaceType
  | IfaceGReflCo      Role IfaceType (IfaceMCoercion)
337 338 339
  | IfaceFunCo        Role IfaceCoercion IfaceCoercion
  | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]
  | IfaceAppCo        IfaceCoercion IfaceCoercion
Ningning Xie's avatar
Ningning Xie committed
340
  | IfaceForAllCo     IfaceBndr IfaceCoercion IfaceCoercion
341 342
  | IfaceCoVarCo      IfLclName
  | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]
343 344 345 346
  | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]
       -- There are only a fixed number of CoAxiomRules, so it suffices
       -- to use an IfaceLclName to distinguish them.
       -- See Note [Adding built-in type families] in TcTypeNats
347 348 349 350 351 352 353 354
  | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType
  | IfaceSymCo        IfaceCoercion
  | IfaceTransCo      IfaceCoercion IfaceCoercion
  | IfaceNthCo        Int IfaceCoercion
  | IfaceLRCo         LeftOrRight IfaceCoercion
  | IfaceInstCo       IfaceCoercion IfaceCoercion
  | IfaceKindCo       IfaceCoercion
  | IfaceSubCo        IfaceCoercion
Simon Peyton Jones's avatar
Simon Peyton Jones committed
355 356
  | IfaceFreeCoVar    CoVar    -- See Note [Free tyvars in IfaceType]
  | IfaceHoleCo       CoVar    -- ^ See Note [Holes in IfaceCoercion]
357 358

data IfaceUnivCoProv
359
  = IfacePhantomProv IfaceCoercion
360 361
  | IfaceProofIrrelProv IfaceCoercion
  | IfacePluginProv String
362

Simon Peyton Jones's avatar
Simon Peyton Jones committed
363 364 365 366 367 368 369 370 371 372
{- Note [Holes in IfaceCoercion]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When typechecking fails the typechecker will produce a HoleCo 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 IfaceCoercion has a IfaceHoleCo
constructor; however, we fails when asked to serialize to a
IfaceHoleCo to ensure that they don't end up in an interface file.

373

374 375
%************************************************************************
%*                                                                      *
376
                Functions over IFaceTypes
Austin Seipp's avatar
Austin Seipp committed
377 378 379
*                                                                      *
************************************************************************
-}
380

Ben Gamari's avatar
Ben Gamari committed
381 382 383
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key

384
isIfaceLiftedTypeKind :: IfaceKind -> Bool
385
isIfaceLiftedTypeKind (IfaceTyConApp tc IA_Nil)
386 387
  = isLiftedTypeKindTyConName (ifaceTyConName tc)
isIfaceLiftedTypeKind (IfaceTyConApp tc
388 389
                       (IA_Arg (IfaceTyConApp ptr_rep_lifted IA_Nil)
                               Required IA_Nil))
Ben Gamari's avatar
Ben Gamari committed
390
  =  tc `ifaceTyConHasKey` tYPETyConKey
391
  && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey
392 393
isIfaceLiftedTypeKind _ = False

394
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
395
-- Mainly for printing purposes
396 397 398 399 400 401 402 403 404 405 406 407
--
-- Here we split nested IfaceSigmaTy properly.
--
-- @
-- forall t. T t => forall m a b. M m => (a -> m b) -> t a -> m (t b)
-- @
--
-- If you called @splitIfaceSigmaTy@ on this type:
--
-- @
-- ([t, m, a, b], [T t, M m], (a -> m b) -> t a -> m (t b))
-- @
408
splitIfaceSigmaTy ty
409 410 411 412
  = case (bndrs, theta) of
      ([], []) -> (bndrs, theta, tau)
      _        -> let (bndrs', theta', tau') = splitIfaceSigmaTy tau
                   in (bndrs ++ bndrs', theta ++ theta', tau')
413
  where
414
    (bndrs, rho)   = split_foralls ty
batterseapower's avatar
batterseapower committed
415
    (theta, tau)   = split_rho rho
416

417 418
    split_foralls (IfaceForAllTy bndr ty)
        = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
419 420
    split_foralls rho = ([], rho)

421
    split_rho (IfaceFunTy InvisArg ty1 ty2)
422
        = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
423
    split_rho tau = ([], tau)
424

425
suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
426
suppressIfaceInvisibles dflags tys xs
427 428 429 430 431
  | gopt Opt_PrintExplicitKinds dflags = xs
  | otherwise = suppress tys xs
    where
      suppress _       []      = []
      suppress []      a       = a
432 433 434
      suppress (k:ks) (x:xs)
        | isInvisibleTyConBinder k =     suppress ks xs
        | otherwise                = x : suppress ks xs
435

436
stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
437
stripIfaceInvisVars dflags tyvars
438
  | gopt Opt_PrintExplicitKinds dflags = tyvars
439
  | otherwise = filterOut isInvisibleTyConBinder tyvars
440

Ningning Xie's avatar
Ningning Xie committed
441 442 443
-- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'.
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar = binderVar
444 445 446

-- | Extract the variable name from an 'IfaceForAllBndr'.
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
Ningning Xie's avatar
Ningning Xie committed
447
ifForAllBndrName fab = ifaceBndrName (ifForAllBndrVar fab)
448

Ningning Xie's avatar
Ningning Xie committed
449 450 451
-- | Extract an 'IfaceBndr' from an 'IfaceTyConBinder'.
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar = binderVar
452

453
-- | Extract the variable name from an 'IfaceTyConBinder'.
454
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
Ningning Xie's avatar
Ningning Xie committed
455
ifTyConBinderName tcb = ifaceBndrName (ifTyConBinderVar tcb)
456

457 458 459 460
ifTypeIsVarFree :: IfaceType -> Bool
-- Returns True if the type definitely has no variables at all
-- Just used to control pretty printing
ifTypeIsVarFree ty = go ty
461
  where
462
    go (IfaceTyVar {})         = False
463
    go (IfaceFreeTyVar {})     = False
464
    go (IfaceAppTy fun args)   = go fun && go_args args
465
    go (IfaceFunTy _ arg res)  = go arg && go res
466 467 468 469 470 471 472
    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

473
    go_args IA_Nil = True
474
    go_args (IA_Arg arg _ args) = go arg && go_args args
475

476 477 478 479 480
{- 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.  -}
481

482
type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType]
483

484 485 486 487 488 489 490
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)
491 492

substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
493
-- See Note [Substitution on IfaceType]
494 495 496
substIfaceType env ty
  = go ty
  where
497
    go (IfaceFreeTyVar tv)    = IfaceFreeTyVar tv
498
    go (IfaceTyVar tv)        = substIfaceTyVar env tv
499
    go (IfaceAppTy  t ts)     = IfaceAppTy  (go t) (substIfaceAppArgs env ts)
500
    go (IfaceFunTy af t1 t2)  = IfaceFunTy af (go t1) (go t2)
501
    go ty@(IfaceLitTy {})     = ty
502 503
    go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceAppArgs env tys)
    go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceAppArgs env tys)
504
    go (IfaceForAllTy {})     = pprPanic "substIfaceType" (ppr ty)
505 506 507
    go (IfaceCastTy ty co)    = IfaceCastTy (go ty) (go_co co)
    go (IfaceCoercionTy co)   = IfaceCoercionTy (go_co co)

Ningning Xie's avatar
Ningning Xie committed
508 509 510 511 512 513
    go_mco IfaceMRefl    = IfaceMRefl
    go_mco (IfaceMCo co) = IfaceMCo $ go_co co

    go_co (IfaceReflCo ty)           = IfaceReflCo (go ty)
    go_co (IfaceGReflCo r ty mco)    = IfaceGReflCo r (go ty) (go_mco mco)
    go_co (IfaceFunCo r c1 c2)       = IfaceFunCo r (go_co c1) (go_co c2)
514 515 516
    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)
517
    go_co (IfaceFreeCoVar cv)        = IfaceFreeCoVar cv
518
    go_co (IfaceCoVarCo cv)          = IfaceCoVarCo cv
Simon Peyton Jones's avatar
Simon Peyton Jones committed
519
    go_co (IfaceHoleCo cv)           = IfaceHoleCo cv
520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535
    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 (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 (IfacePhantomProv co)    = IfacePhantomProv (go_co co)
    go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co)
    go_prov (IfacePluginProv str)    = IfacePluginProv str
536

537 538
substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs env args
539 540
  = go args
  where
541 542
    go IA_Nil              = IA_Nil
    go (IA_Arg ty arg tys) = IA_Arg (substIfaceType env ty) arg (go tys)
543 544 545 546 547

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

549

Austin Seipp's avatar
Austin Seipp committed
550 551 552
{-
************************************************************************
*                                                                      *
553
                Functions over IfaceAppArgs
Austin Seipp's avatar
Austin Seipp committed
554 555 556
*                                                                      *
************************************************************************
-}
557

558
stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs
559
stripInvisArgs dflags tys
560
  | gopt Opt_PrintExplicitKinds dflags = tys
561
  | otherwise = suppress_invis tys
562
    where
563
      suppress_invis c
564
        = case c of
565 566 567 568
            IA_Nil -> IA_Nil
            IA_Arg t argf ts
              |  isVisibleArgFlag argf
              -> IA_Arg t argf $ suppress_invis ts
569 570
              -- Keep recursing through the remainder of the arguments, as it's
              -- possible that there are remaining invisible ones.
Ningning Xie's avatar
Ningning Xie committed
571 572
              -- See the "In type declarations" section of Note [VarBndrs,
              -- TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.
573 574
              |  otherwise
              -> suppress_invis ts
575

576 577
appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IA_Nil = []
578 579 580 581 582 583
appArgsIfaceTypes (IA_Arg t _ ts) = t : appArgsIfaceTypes ts

appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceType, ArgFlag)]
appArgsIfaceTypesArgFlags IA_Nil = []
appArgsIfaceTypesArgFlags (IA_Arg t a ts)
                                 = (t, a) : appArgsIfaceTypesArgFlags ts
584

585 586
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength = go 0
Ben Gamari's avatar
Ben Gamari committed
587
  where
588 589 590 591
    go !n IA_Nil = n
    go n  (IA_Arg _ argf rest)
      | isVisibleArgFlag argf = go (n+1) rest
      | otherwise             = go n rest
Ben Gamari's avatar
Ben Gamari committed
592

Austin Seipp's avatar
Austin Seipp committed
593
{-
594 595
Note [Suppressing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
596 597 598
We use the IfaceAppArgs data type to specify which of the arguments to a type
should be displayed when pretty-printing, under the control of
-fprint-explicit-kinds.
599
See also Type.filterOutInvisibleTypes.
600
For example, given
601

602 603
    T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism
    'Just :: forall k. k -> 'Maybe k   -- Promoted
604

605 606
we want

607 608 609 610 611 612 613 614 615 616 617
    T * Tree Int    prints as    T Tree Int
    'Just *         prints as    Just *

For type constructors (IfaceTyConApp), IfaceAppArgs is a quite natural fit,
since the corresponding Core constructor:

    data Type
      = ...
      | TyConApp TyCon [Type]

Already puts all of its arguments into a list. So when converting a Type to an
618 619 620
IfaceType (see toIfaceAppArgsX in GHC.Core.ToIface), we simply use the kind of
the TyCon (which is cached) to guide the process of converting the argument
Types into an IfaceAppArgs list.
621 622 623 624 625 626 627 628 629 630 631 632 633 634 635

We also want this behavior for IfaceAppTy, since given:

    data Proxy (a :: k)
    f :: forall (t :: forall a. a -> Type). Proxy Type (t Bool True)

We want to print the return type as `Proxy (t True)` without the use of
-fprint-explicit-kinds (#15330). Accomplishing this is trickier than in the
tycon case, because the corresponding Core constructor for IfaceAppTy:

    data Type
      = ...
      | AppTy Type Type

Only stores one argument at a time. Therefore, when converting an AppTy to an
636
IfaceAppTy (in toIfaceTypeX in GHC.CoreToIface), we:
637 638 639 640 641 642 643 644 645 646 647 648 649 650

1. Flatten the chain of AppTys down as much as possible
2. Use typeKind to determine the function Type's kind
3. Use this kind to guide the process of converting the argument Types into an
   IfaceAppArgs list.

By flattening the arguments like this, we obtain two benefits:

(a) We can reuse the same machinery to pretty-print IfaceTyConApp arguments as
    we do IfaceTyApp arguments, which means that we only need to implement the
    logic to filter out invisible arguments once.
(b) Unlike for tycons, finding the kind of a type in general (through typeKind)
    is not a constant-time operation, so by flattening the arguments first, we
    decrease the number of times we have to call typeKind.
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
Note [Pretty-printing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Note [Suppressing invisible arguments] is all about how to avoid printing
invisible arguments when the -fprint-explicit-kinds flag is disables. Well,
what about when it's enabled? Then we can and should print invisible kind
arguments, and this Note explains how we do it.

As two running examples, consider the following code:

  {-# LANGUAGE PolyKinds #-}
  data T1 a
  data T2 (a :: k)

When displaying these types (with -fprint-explicit-kinds on), we could just
do the following:

  T1 k a
  T2 k a

That certainly gets the job done. But it lacks a crucial piece of information:
is the `k` argument inferred or specified? To communicate this, we use visible
kind application syntax to distinguish the two cases:

  T1 @{k} a
  T2 @k   a

Here, @{k} indicates that `k` is an inferred argument, and @k indicates that
`k` is a specified argument. (See
Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep for
a lengthier explanation on what "inferred" and "specified" mean.)

Austin Seipp's avatar
Austin Seipp committed
683 684
************************************************************************
*                                                                      *
685
                Pretty-printing
Austin Seipp's avatar
Austin Seipp committed
686 687 688
*                                                                      *
************************************************************************
-}
689

Ben Gamari's avatar
Ben Gamari committed
690 691 692 693 694 695 696 697 698 699 700
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

701
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
702
pprIfaceInfixApp ctxt_prec pp_tc pp_ty1 pp_ty2
703
  = maybeParen ctxt_prec opPrec $
704
    sep [pp_ty1, pp_tc <+> pp_ty2]
705

706
pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
707
pprIfacePrefixApp ctxt_prec pp_fun pp_tys
708
  | null pp_tys = pp_fun
709
  | otherwise   = maybeParen ctxt_prec appPrec $
710
                  hang pp_fun 2 (sep pp_tys)
711

712 713 714 715 716
isIfaceTauType :: IfaceType -> Bool
isIfaceTauType (IfaceForAllTy _ _) = False
isIfaceTauType (IfaceFunTy InvisArg _ _) = False
isIfaceTauType _ = True

Austin Seipp's avatar
Austin Seipp committed
717
-- ----------------------------- Printing binders ------------------------------------
718 719 720

instance Outputable IfaceBndr where
    ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
721 722
    ppr (IfaceTvBndr bndr) = char '@' <> pprIfaceTvBndr bndr (SuppressBndrSig False)
                                                             (UseBndrParens False)
723 724 725 726

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

727 728 729 730
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b
pprIfaceLamBndr (b, IfaceOneShot)   = ppr b <> text "[OneShot]"

Ben Gamari's avatar
Ben Gamari committed
731
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
732
pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)
733

734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764
{- Note [Suppressing binder signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When printing the binders in a 'forall', we want to keep the kind annotations:

    forall (a :: k). blah
              ^^^^
              good

On the other hand, when we print the binders of a data declaration in :info,
the kind information would be redundant due to the standalone kind signature:

   type F :: Symbol -> Type
   type F (s :: Symbol) = blah
             ^^^^^^^^^
             redundant

Here we'd like to omit the kind annotation:

   type F :: Symbol -> Type
   type F s = blah
-}

-- | Do we want to suppress kind annotations on binders?
-- See Note [Suppressing binder signatures]
newtype SuppressBndrSig = SuppressBndrSig Bool

newtype UseBndrParens = UseBndrParens Bool

pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens)
  | suppress_sig             = ppr tv
765
  | isIfaceLiftedTypeKind ki = ppr tv
Ben Gamari's avatar
Ben Gamari committed
766 767 768 769
  | otherwise                = maybe_parens (ppr tv <+> dcolon <+> ppr ki)
  where
    maybe_parens | use_parens = parens
                 | otherwise  = id
770

771 772
pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders suppress_sig = sep . map go
773
  where
774 775 776 777 778
    go :: IfaceTyConBinder -> SDoc
    go (Bndr (IfaceIdBndr bndr) _) = pprIfaceIdBndr bndr
    go (Bndr (IfaceTvBndr bndr) vis) =
      -- See Note [Pretty-printing invisible arguments]
      case vis of
779 780
        AnonTCB  VisArg    -> ppr_bndr (UseBndrParens True)
        AnonTCB  InvisArg  -> char '@' <> braces (ppr_bndr (UseBndrParens False))
781 782
          -- The above case is rare. (See Note [AnonTCB InvisArg] in TyCon.)
          -- Should we print these differently?
783 784 785
        NamedTCB Required  -> ppr_bndr (UseBndrParens True)
        NamedTCB Specified -> char '@' <> ppr_bndr (UseBndrParens True)
        NamedTCB Inferred  -> char '@' <> braces (ppr_bndr (UseBndrParens False))
786
      where
787
        ppr_bndr = pprIfaceTvBndr bndr suppress_sig
788 789 790 791 792 793 794 795 796 797 798 799 800 801 802

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)
803 804 805 806 807 808 809 810 811 812 813

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
814

Austin Seipp's avatar
Austin Seipp committed
815
-- ----------------------------- Printing IfaceType ------------------------------------
816 817 818

---------------------------------
instance Outputable IfaceType where
819
  ppr ty = pprIfaceType ty
820

Ben Gamari's avatar
Ben Gamari committed
821
pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
822 823
pprIfaceType       = pprPrecIfaceType topPrec
pprParendIfaceType = pprPrecIfaceType appPrec
824

825
pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
826 827
-- We still need `eliminateRuntimeRep`, since the `pprPrecIfaceType` maybe
-- called from other places, besides `:type` and `:info`.
828
pprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty
829

830 831 832 833
ppr_sigma :: PprPrec -> IfaceType -> SDoc
ppr_sigma ctxt_prec ty
  = maybeParen ctxt_prec funPrec (pprIfaceSigmaType ShowForAllMust ty)

834
ppr_ty :: PprPrec -> IfaceType -> SDoc
835 836 837
ppr_ty ctxt_prec ty@(IfaceForAllTy {})        = ppr_sigma ctxt_prec ty
ppr_ty ctxt_prec ty@(IfaceFunTy InvisArg _ _) = ppr_sigma ctxt_prec ty

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
838
ppr_ty _         (IfaceFreeTyVar tyvar) = ppr tyvar  -- This is the main reason for IfaceFreeTyVar!
839
ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar  -- See Note [TcTyVars in IfaceType]
Ben Gamari's avatar
Ben Gamari committed
840
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
841
ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys
Ben Gamari's avatar
Ben Gamari committed
842
ppr_ty _         (IfaceLitTy n)         = pprIfaceTyLit n
843
        -- Function types
844
ppr_ty ctxt_prec (IfaceFunTy _ ty1 ty2)  -- Should be VisArg
845
  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
846 847
    maybeParen ctxt_prec funPrec $
    sep [ppr_ty funPrec ty1, sep (ppr_fun_tail ty2)]
848
  where
849
    ppr_fun_tail (IfaceFunTy VisArg ty1 ty2)
850
      = (arrow <+> ppr_ty funPrec ty1) : ppr_fun_tail ty2
851
    ppr_fun_tail other_ty
852
      = [arrow <+> pprIfaceType other_ty]
853

854
ppr_ty ctxt_prec (IfaceAppTy t ts)
Ben Gamari's avatar
Ben Gamari committed
855 856 857 858 859
  = if_print_coercions
      ppr_app_ty
      ppr_app_ty_no_casts
  where
    ppr_app_ty =
860 861 862
        sdocWithDynFlags $ \dflags ->
        pprIfacePrefixApp ctxt_prec
                          (ppr_ty funPrec t)
863
                          (map (ppr_app_arg appPrec) (tys_wo_kinds dflags))
864

865
    tys_wo_kinds dflags = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags ts
Ben Gamari's avatar
Ben Gamari committed
866 867 868

    -- Strip any casts from the head of the application
    ppr_app_ty_no_casts =
869 870 871
        case t of
          IfaceCastTy head _ -> ppr_ty ctxt_prec (mk_app_tys head ts)
          _                  -> ppr_app_ty
Ben Gamari's avatar
Ben Gamari committed
872

873
    mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
Ben Gamari's avatar
Ben Gamari committed
874 875
    mk_app_tys (IfaceTyConApp tc tys1) tys2 =
        IfaceTyConApp tc (tys1 `mappend` tys2)
876
    mk_app_tys t1 tys2 = IfaceAppTy t1 tys2
877

878
ppr_ty ctxt_prec (IfaceCastTy ty co)
Ben Gamari's avatar
Ben Gamari committed
879
  = if_print_coercions
880
      (parens (ppr_ty topPrec ty <+> text "|>" <+> ppr co))
Ben Gamari's avatar
Ben Gamari committed
881
      (ppr_ty ctxt_prec ty)
882 883

ppr_ty ctxt_prec (IfaceCoercionTy co)
Ben Gamari's avatar
Ben Gamari committed
884 885 886
  = if_print_coercions
      (ppr_co ctxt_prec co)
      (text "<>")
887

888 889 890 891
{- 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
892
significant and understandable push-back from those with pedagogy in
893 894 895
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,
Ben Gamari's avatar
Ben Gamari committed
896 897 898 899 900 901 902

    ($) :: 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

903 904 905 906 907 908 909 910 911 912 913 914
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 LiftedRep. This is done in a pass right before
pretty-printing (defaultRuntimeRepVars, controlled by
-fprint-explicit-runtime-reps)

This applies to /quantified/ variables like 'w' above.  What about
variables that are /free/ in the type being printed, which certainly
915
happens in error messages.  Suppose (#16074) we are reporting a
916 917 918 919 920 921 922 923 924 925 926
mismatch between two skolems
          (a :: RuntimeRep) ~ (b :: RuntimeRep)
We certainly don't want to say "Can't match LiftedRep ~ LiftedRep"!

But if we are printing the type
    (forall (a :: Type r). blah
we do want to turn that (free) r into LiftedRep, so it prints as
    (forall a. blah)

Conclusion: keep track of whether we we are in the kind of a
binder; ohly if so, convert free RuntimeRep variables to LiftedRep.
Ben Gamari's avatar
Ben Gamari committed
927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943
-}

-- | 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.
--
944 945
defaultRuntimeRepVars :: IfaceType -> IfaceType
defaultRuntimeRepVars ty = go False emptyFsEnv ty
Ben Gamari's avatar
Ben Gamari committed
946
  where
947 948 949 950 951 952 953
    go :: Bool              -- True <=> Inside the kind of a binder
       -> FastStringEnv ()  -- Set of enclosing forall-ed RuntimeRep variables
       -> IfaceType         --  (replace them with LiftedRep)
       -> IfaceType
    go ink subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty)
     | isRuntimeRep var_kind
      , isInvisibleArgFlag argf -- Don't default *visible* quantification
Ningning Xie's avatar
Ningning Xie committed
954
                                -- or we get the mess in #13963
Ben Gamari's avatar
Ben Gamari committed
955
      = let subs' = extendFsEnv subs var ()
956 957 958
            -- Record that we should replace it with LiftedRep,
            -- and recurse, discarding the forall
        in go ink subs' ty
Ningning Xie's avatar
Ningning Xie committed
959

960 961
    go ink subs (IfaceForAllTy bndr ty)
      = IfaceForAllTy (go_ifacebndr subs bndr) (go ink subs ty)
Ben Gamari's avatar
Ben Gamari committed
962

963
    go _ subs ty@(IfaceTyVar tv)
Ben Gamari's avatar
Ben Gamari committed
964
      | tv `elemFsEnv` subs
965
      = IfaceTyConApp liftedRep IA_Nil
966 967 968
      | otherwise
      = ty

969 970
    go in_kind _ ty@(IfaceFreeTyVar tv)
      -- See Note [Defaulting RuntimeRep variables], about free vars
971
      | in_kind && Type.isRuntimeRepTy (tyVarKind tv)
972
      = IfaceTyConApp liftedRep IA_Nil
973 974
      | otherwise
      = ty
Ben Gamari's avatar
Ben Gamari committed
975

976 977
    go ink subs (IfaceTyConApp tc tc_args)
      = IfaceTyConApp tc (go_args ink subs tc_args)
978

979 980
    go ink subs (IfaceTupleTy sort is_prom tc_args)
      = IfaceTupleTy sort is_prom (go_args ink subs tc_args)
981

982 983
    go ink subs (IfaceFunTy af arg res)
      = IfaceFunTy af (go ink subs arg) (go ink subs res)
Ben Gamari's avatar
Ben Gamari committed
984

985 986
    go ink subs (IfaceAppTy t ts)
      = IfaceAppTy (go ink subs t) (go_args ink subs ts)
Ben Gamari's avatar
Ben Gamari committed
987

988 989
    go ink subs (IfaceCastTy x co)
      = IfaceCastTy (go ink subs x) co
Ben Gamari's avatar
Ben Gamari committed
990

991 992
    go _ _ ty@(IfaceLitTy {}) = ty
    go _ _ ty@(IfaceCoercionTy {}) = ty
993

Ningning Xie's avatar
Ningning Xie committed
994 995
    go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
    go_ifacebndr subs (Bndr (IfaceIdBndr (n, t)) argf)
996
      = Bndr (IfaceIdBndr (n, go True subs t)) argf
Ningning Xie's avatar
Ningning Xie committed
997
    go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf)
998
      = Bndr (IfaceTvBndr (n, go True subs t)) argf
Ningning Xie's avatar
Ningning Xie committed
999

1000 1001 1002 1003
    go_args :: Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
    go_args _ _ IA_Nil = IA_Nil
    go_args ink subs (IA_Arg ty argf args)
      = IA_Arg (go ink subs ty) argf (go_args ink subs args)
Ben Gamari's avatar
Ben Gamari committed
1004

1005
    liftedRep :: IfaceTyCon
1006
    liftedRep = IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
1007
      where dc_name = getName liftedRepDataConTyCon
Ben Gamari's avatar
Ben Gamari committed
1008 1009 1010 1011 1012 1013 1014

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

eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
1015 1016 1017 1018 1019 1020
eliminateRuntimeRep f ty
  = sdocWithDynFlags $ \dflags ->
    getPprStyle      $ \sty    ->
    if userStyle sty && not (gopt Opt_PrintExplicitRuntimeReps dflags)
      then f (defaultRuntimeRepVars ty)
      else f ty
Ben Gamari's avatar
Ben Gamari committed
1021

1022 1023
instance Outputable IfaceAppArgs where
  ppr tca = pprIfaceAppArgs tca
1024

1025 1026 1027
pprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
pprIfaceAppArgs  = ppr_app_args topPrec
pprParendIfaceAppArgs = ppr_app_args appPrec
1028

1029
ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047
ppr_app_args ctx_prec = go
  where
    go :: IfaceAppArgs -> SDoc
    go IA_Nil             = empty
    go (IA_Arg t argf ts) = ppr_app_arg ctx_prec (t, argf) <+> go ts

-- See Note [Pretty-printing invisible arguments]
ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg ctx_prec (t, argf) =
  sdocWithDynFlags $ \dflags ->
  let print_kinds = gopt Opt_PrintExplicitKinds dflags
  in case argf of
       Required  -> ppr_ty ctx_prec t
       Specified |  print_kinds
                 -> char '@' <> ppr_ty appPrec t
       Inferred  |  print_kinds
                 -> char '@' <> braces (ppr_ty topPrec t)
       _         -> empty
1048

1049
-------------------
Ben Gamari's avatar
Ben Gamari committed
1050
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
1051 1052
pprIfaceForAllPart tvs ctxt sdoc
  = ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc
1053

1054 1055 1056 1057 1058
-- | 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

1059
pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
1060 1061
pprIfaceForAllCoPart tvs sdoc
  = sep [ pprIfaceForAllCo tvs, sdoc ]
1062