Type.hs 84.2 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

Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
10
11
12
{-# LANGUAGE FlexibleInstances #-}
  -- FlexibleInstances for Binary (DefMethSpec IfaceType)
{-# LANGUAGE BangPatterns #-}
Sylvain Henry's avatar
Sylvain Henry committed
13
{-# LANGUAGE MultiWayIf #-}
14
{-# LANGUAGE TupleSections #-}
15
{-# LANGUAGE LambdaCase #-}
Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
16

17
module GHC.Iface.Type (
18
        IfExtName, IfLclName,
19

20
        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
Ningning Xie's avatar
Ningning Xie committed
21
        IfaceMCoercion(..),
22
        IfaceUnivCoProv(..),
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
23
        IfaceMult,
24
25
26
        IfaceTyCon(..),
        IfaceTyConInfo(..), mkIfaceTyConInfo,
        IfaceTyConSort(..),
27
        IfaceTyLit(..), IfaceAppArgs(..),
28
        IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
29
        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
30
        IfaceForAllSpecBndr,
31
        IfaceForAllBndr, ArgFlag(..), AnonArgFlag(..), ShowForAllFlag(..),
32
        mkIfaceForAllTvBndr,
33
        mkIfaceTyConKind,
Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
34
        ifaceForAllSpecToBndrs, ifaceForAllSpecToBndr,
35

36
        ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
Ningning Xie's avatar
Ningning Xie committed
37
        ifTyConBinderVar, ifTyConBinderName,
38

39
        -- Equality testing
40
        isIfaceLiftedTypeKind,
41

42
43
        -- Conversion from IfaceAppArgs to IfaceTypes/ArgFlags
        appArgsIfaceTypes, appArgsIfaceTypesArgFlags,
44

45
        -- Printing
46
47
        SuppressBndrSig(..),
        UseBndrParens(..),
Sylvain Henry's avatar
Sylvain Henry committed
48
        PrintExplicitKinds(..),
49
        pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
50
        pprIfaceContext, pprIfaceContextArr,
51
        pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
52
        pprIfaceBndrs, pprIfaceAppArgs, pprParendIfaceAppArgs,
53
54
        pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,
        pprIfaceSigmaType, pprIfaceTyLit,
55
56
        pprIfaceCoercion, pprParendIfaceCoercion,
        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
Ben Gamari's avatar
Ben Gamari committed
57
        pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
58
        mulArrow,
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
59
        ppr_fun_arrow,
60
        isIfaceTauType,
61

62
63
64
        suppressIfaceInvisibles,
        stripIfaceInvisVars,
        stripInvisArgs,
65

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
66
67
68
        mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst,

        many_ty
69
70
    ) where

71
import GHC.Prelude
72

Sylvain Henry's avatar
Sylvain Henry committed
73
74
import {-# SOURCE #-} GHC.Builtin.Types
                                 ( coercibleTyCon, heqTyCon
Ben Gamari's avatar
Ben Gamari committed
75
76
                                 , tupleTyConName
                                 , manyDataConTyCon, oneDataConTyCon
77
                                 , liftedRepTyCon, liftedDataConTyCon )
Sylvain Henry's avatar
Sylvain Henry committed
78
import GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy, isLevityTy )
Ben Gamari's avatar
Ben Gamari committed
79

Sylvain Henry's avatar
Sylvain Henry committed
80
81
import GHC.Core.TyCon hiding ( pprPromotionQuote )
import GHC.Core.Coercion.Axiom
Sylvain Henry's avatar
Sylvain Henry committed
82
import GHC.Types.Var
Sylvain Henry's avatar
Sylvain Henry committed
83
import GHC.Builtin.Names
84
import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyConName )
Sylvain Henry's avatar
Sylvain Henry committed
85
86
import GHC.Types.Name
import GHC.Types.Basic
87
88
89
90
import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Utils.Misc
91
import GHC.Utils.Panic
92
import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar )
93

94
import Data.Maybe( isJust )
95
import qualified Data.Semigroup as Semi
96
import Control.DeepSeq
Ben Gamari's avatar
Ben Gamari committed
97

Austin Seipp's avatar
Austin Seipp committed
98
99
100
{-
************************************************************************
*                                                                      *
101
                Local (nested) binders
Austin Seipp's avatar
Austin Seipp committed
102
103
104
*                                                                      *
************************************************************************
-}
105

106
type IfLclName = FastString     -- A local name in iface syntax
107

108
type IfExtName = Name   -- An External or WiredIn Name can appear in Iface syntax
109
                        -- (However Internal or System Names never should)
110

111
data IfaceBndr          -- Local (non-top-level) binders
112
113
  = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
  | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
114

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
115
type IfaceIdBndr  = (IfaceType, IfLclName, IfaceType)
116
type IfaceTvBndr  = (IfLclName, IfaceKind)
117

Simon Peyton Jones's avatar
Simon Peyton Jones committed
118
119
120
ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName (n,_) = n

Ningning Xie's avatar
Ningning Xie committed
121
ifaceIdBndrName :: IfaceIdBndr -> IfLclName
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
122
ifaceIdBndrName (_,n,_) = n
Ningning Xie's avatar
Ningning Xie committed
123
124
125
126
127

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

128
ifaceBndrType :: IfaceBndr -> IfaceType
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
129
ifaceBndrType (IfaceIdBndr (_, _, t)) = t
130
131
ifaceBndrType (IfaceTvBndr (_, t)) = t

Simon Peyton Jones's avatar
Simon Peyton Jones committed
132
type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
133

134
135
data IfaceOneShot    -- See Note [Preserve OneShotInfo] in "GHC.Core.Tidy"
  = IfaceNoOneShot   -- and Note [The oneShot function] in "GHC.Types.Id.Make"
136
137
  | IfaceOneShot

138
139
140
instance Outputable IfaceOneShot where
  ppr IfaceNoOneShot = text "NoOneShotInfo"
  ppr IfaceOneShot = text "OneShot"
141

142
143
144
145
146
147
148
149
{-
%************************************************************************
%*                                                                      *
                IfaceType
%*                                                                      *
%************************************************************************
-}

150
-------------------------------
151
type IfaceKind     = IfaceType
152

153
154
155
-- | A kind of universal type, used for types and kinds.
--
-- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType'
Sylvain Henry's avatar
Sylvain Henry committed
156
-- before being printed. See Note [Pretty printing via Iface syntax] in "GHC.Types.TyThing.Ppr"
157
data IfaceType
158
  = IfaceFreeTyVar TyVar                -- See Note [Free tyvars in IfaceType]
159
160
  | IfaceTyVar     IfLclName            -- Type/coercion variable only, not tycon
  | IfaceLitTy     IfaceTyLit
161
162
163
164
  | IfaceAppTy     IfaceType IfaceAppArgs
                             -- See Note [Suppressing invisible arguments] for
                             -- an explanation of why the second field isn't
                             -- IfaceType, analogous to AppTy.
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
165
  | IfaceFunTy     AnonArgFlag IfaceMult IfaceType IfaceType
166
  | IfaceForAllTy  IfaceForAllBndr IfaceType
167
168
  | IfaceTyConApp  IfaceTyCon IfaceAppArgs  -- Not necessarily saturated
                                            -- Includes newtypes, synonyms, tuples
169
170
  | IfaceCastTy     IfaceType IfaceCoercion
  | IfaceCoercionTy IfaceCoercion
Ben Gamari's avatar
Ben Gamari committed
171

172
  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)
Ben Gamari's avatar
Ben Gamari committed
173
       TupleSort                  -- What sort of tuple?
174
       PromotionFlag                 -- A bit like IfaceTyCon
175
       IfaceAppArgs               -- arity = length args
176
          -- For promoted data cons, the kind args are omitted
Richard Eisenberg's avatar
Richard Eisenberg committed
177
178
179
180
181
          -- Why have this? Only for efficiency: IfaceTupleTy can omit the
          -- type arguments, as they can be recreated when deserializing.
          -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression
          -- in interface file size (in GHC's boot libraries).
          -- See !3987.
182

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
183
184
type IfaceMult = IfaceType

batterseapower's avatar
batterseapower committed
185
type IfacePredType = IfaceType
186
187
type IfaceContext = [IfacePredType]

188
data IfaceTyLit
189
190
  = IfaceNumTyLit Integer
  | IfaceStrTyLit FastString
Daniel Rogozin's avatar
Daniel Rogozin committed
191
  | IfaceCharTyLit Char
192
  deriving (Eq)
193

Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
194
195
196
type IfaceTyConBinder    = VarBndr IfaceBndr TyConBndrVis
type IfaceForAllBndr     = VarBndr IfaceBndr ArgFlag
type IfaceForAllSpecBndr = VarBndr IfaceBndr Specificity
197

198
199
200
201
-- | Make an 'IfaceForAllBndr' from an 'IfaceTvBndr'.
mkIfaceForAllTvBndr :: ArgFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr vis var = Bndr (IfaceTvBndr var) vis

202
-- | Build the 'tyConKind' from the binders and the result kind.
203
-- Keep in sync with 'mkTyConKind' in "GHC.Core.TyCon".
204
205
206
207
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceKind -> IfaceKind
mkIfaceTyConKind bndrs res_kind = foldr mk res_kind bndrs
  where
    mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
208
    mk (Bndr tv (AnonTCB af))   k = IfaceFunTy af many_ty (ifaceBndrType tv) k
209
210
    mk (Bndr tv (NamedTCB vis)) k = IfaceForAllTy (Bndr tv vis) k

Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
211
212
213
214
215
216
ifaceForAllSpecToBndrs :: [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
ifaceForAllSpecToBndrs = map ifaceForAllSpecToBndr

ifaceForAllSpecToBndr :: IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr (Bndr tv spec) = Bndr tv (Invisible spec)

217
218
-- | Stores the arguments in a type application as a list.
-- See @Note [Suppressing invisible arguments]@.
219
220
data IfaceAppArgs
  = IA_Nil
221
222
223
224
225
226
227
228
229
230
231
232
233
  | 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
234

235
instance Semi.Semigroup IfaceAppArgs where
236
237
  IA_Nil <> xs              = xs
  IA_Arg ty argf rest <> xs = IA_Arg ty argf (rest Semi.<> xs)
238

239
240
instance Monoid IfaceAppArgs where
  mempty = IA_Nil
241
  mappend = (Semi.<>)
Ben Gamari's avatar
Ben Gamari committed
242

243
244
245
246
-- Encodes type constructors, kind constructors,
-- coercion constructors, the lot.
-- We have to tag them in order to pretty print them
-- properly.
247
248
data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName
                             , ifaceTyConInfo :: IfaceTyConInfo }
249
    deriving (Eq)
250

Ben Gamari's avatar
Ben Gamari committed
251
252
253
254
-- | The various types of TyCons which have special, built-in syntax.
data IfaceTyConSort = IfaceNormalTyCon          -- ^ a regular tycon

                    | IfaceTupleTyCon !Arity !TupleSort
sheaf's avatar
sheaf committed
255
                      -- ^ a tuple, e.g. @(a, b, c)@ or @(#a, b, c#)@.
Ben Gamari's avatar
Ben Gamari committed
256
257
258
259
260
                      -- The arity is the tuple width, not the tycon arity
                      -- (which is twice the width in the case of unboxed
                      -- tuples).

                    | IfaceSumTyCon !Arity
sheaf's avatar
sheaf committed
261
                      -- ^ an unboxed sum, e.g. @(# a | b | c #)@
Ben Gamari's avatar
Ben Gamari committed
262

263
264
265
266
267
268
                    | 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
269
270
                    deriving (Eq)

271
272
273
274
275
276
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"

277
{- Note [Free tyvars in IfaceType]
278
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Simon Peyton Jones's avatar
Simon Peyton Jones committed
279
280
Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to
an IfaceType and pretty printing that.  This eliminates a lot of
281
pretty-print duplication, and it matches what we do with pretty-
Sylvain Henry's avatar
Sylvain Henry committed
282
printing TyThings. See Note [Pretty printing via Iface syntax] in GHC.Types.TyThing.Ppr.
283
284
285
286
287
288

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.

289
So we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor.
290
291
Note that:

292
293
* We never expect to serialise an IfaceFreeTyVar into an interface file, nor
  to deserialise one.  IfaceFreeTyVar is used only in the "convert to IfaceType
294
295
  and then pretty-print" pipeline.

296
We do the same for covars, naturally.
297

Ben Gamari's avatar
Ben Gamari committed
298
299
300
Note [Equality predicates in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has several varieties of type equality (see Note [The equality types story]
Sylvain Henry's avatar
Sylvain Henry committed
301
in GHC.Builtin.Types.Prim for details).  In an effort to avoid confusing users, we suppress
302
303
304
305
306
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:

307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
--------------------------------------------------------------------------------------------
|         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)    |
--------------------------------------------------------------------------------------------
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349

(* 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
350
351
for the purposes of pretty-printing.

Sylvain Henry's avatar
Sylvain Henry committed
352
See Note [The equality types story] in GHC.Builtin.Types.Prim.
Ben Gamari's avatar
Ben Gamari committed
353
354
-}

355
356
data IfaceTyConInfo   -- Used to guide pretty-printing
                      -- and to disambiguate D from 'D (they share a name)
357
  = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag
Ben Gamari's avatar
Ben Gamari committed
358
                   , ifaceTyConSort       :: IfaceTyConSort }
359
    deriving (Eq)
360

361
362
363
364
365
366
367
-- This smart constructor allows sharing of the two most common
-- cases. See #19194
mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo IsPromoted  IfaceNormalTyCon = IfaceTyConInfo IsPromoted  IfaceNormalTyCon
mkIfaceTyConInfo NotPromoted IfaceNormalTyCon = IfaceTyConInfo NotPromoted IfaceNormalTyCon
mkIfaceTyConInfo prom        sort             = IfaceTyConInfo prom        sort

Ningning Xie's avatar
Ningning Xie committed
368
369
370
371
data IfaceMCoercion
  = IfaceMRefl
  | IfaceMCo IfaceCoercion

372
data IfaceCoercion
Ningning Xie's avatar
Ningning Xie committed
373
374
  = IfaceReflCo       IfaceType
  | IfaceGReflCo      Role IfaceType (IfaceMCoercion)
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
375
  | IfaceFunCo        Role IfaceCoercion IfaceCoercion IfaceCoercion
376
377
  | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]
  | IfaceAppCo        IfaceCoercion IfaceCoercion
Ningning Xie's avatar
Ningning Xie committed
378
  | IfaceForAllCo     IfaceBndr IfaceCoercion IfaceCoercion
379
380
  | IfaceCoVarCo      IfLclName
  | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]
381
382
383
  | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]
       -- There are only a fixed number of CoAxiomRules, so it suffices
       -- to use an IfaceLclName to distinguish them.
Sylvain Henry's avatar
Sylvain Henry committed
384
       -- See Note [Adding built-in type families] in GHC.Builtin.Types.Literals
385
386
387
388
389
390
391
392
  | 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
393
394
  | IfaceFreeCoVar    CoVar    -- See Note [Free tyvars in IfaceType]
  | IfaceHoleCo       CoVar    -- ^ See Note [Holes in IfaceCoercion]
395
396

data IfaceUnivCoProv
397
  = IfacePhantomProv IfaceCoercion
398
399
  | IfaceProofIrrelProv IfaceCoercion
  | IfacePluginProv String
400
  | IfaceCorePrepProv Bool  -- See defn of CorePrepProv
401

Simon Peyton Jones's avatar
Simon Peyton Jones committed
402
403
404
405
406
407
408
409
410
411
{- 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.

412

413
414
%************************************************************************
%*                                                                      *
415
                Functions over IFaceTypes
Austin Seipp's avatar
Austin Seipp committed
416
417
418
*                                                                      *
************************************************************************
-}
419

Ben Gamari's avatar
Ben Gamari committed
420
421
422
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key

Ben Gamari's avatar
Ben Gamari committed
423
-- | Given a kind K, is K of the form (TYPE ('BoxedRep 'LiftedRep))?
424
isIfaceLiftedTypeKind :: IfaceKind -> Bool
425
isIfaceLiftedTypeKind (IfaceTyConApp tc IA_Nil)
426
  = isLiftedTypeKindTyConName (ifaceTyConName tc)
Ben Gamari's avatar
Ben Gamari committed
427
428
isIfaceLiftedTypeKind (IfaceTyConApp tc1 args1)
  = isIfaceTyConAppLiftedTypeKind tc1 args1
429
430
isIfaceLiftedTypeKind _ = False

Ben Gamari's avatar
Ben Gamari committed
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
-- | Given a kind constructor K and arguments A, returns true if
-- both of the following statements are true:
--
-- * K is TYPE
-- * A is a singleton IfaceAppArgs of the form ('BoxedRep 'Lifted)
--
-- For the second condition, we must also check for the type
-- synonym LiftedRep.
isIfaceTyConAppLiftedTypeKind :: IfaceTyCon -> IfaceAppArgs -> Bool
isIfaceTyConAppLiftedTypeKind tc1 args1
  | tc1 `ifaceTyConHasKey` tYPETyConKey
  , IA_Arg soleArg1 Required IA_Nil <- args1
  , IfaceTyConApp rep args2 <- soleArg1 =
    if | rep `ifaceTyConHasKey` boxedRepDataConKey
       , IA_Arg soleArg2 Required IA_Nil <- args2
       , IfaceTyConApp lev IA_Nil <- soleArg2
       , lev `ifaceTyConHasKey` liftedDataConKey -> True
       | rep `ifaceTyConHasKey` liftedRepTyConKey
       , IA_Nil <- args2 -> True
       | otherwise -> False
  | otherwise = False

453
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
454
-- Mainly for printing purposes
455
456
457
458
459
460
461
462
463
464
465
466
--
-- 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))
-- @
467
splitIfaceSigmaTy ty
468
469
470
471
  = case (bndrs, theta) of
      ([], []) -> (bndrs, theta, tau)
      _        -> let (bndrs', theta', tau') = splitIfaceSigmaTy tau
                   in (bndrs ++ bndrs', theta ++ theta', tau')
472
  where
473
    (bndrs, rho)   = split_foralls ty
batterseapower's avatar
batterseapower committed
474
    (theta, tau)   = split_rho rho
475

476
    split_foralls (IfaceForAllTy bndr ty)
477
        | isInvisibleArgFlag (binderArgFlag bndr)
478
        = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
479
480
    split_foralls rho = ([], rho)

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
481
    split_rho (IfaceFunTy InvisArg _ ty1 ty2)
482
        = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
483
    split_rho tau = ([], tau)
484

485
486
487
488
489
490
splitIfaceReqForallTy :: IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy (IfaceForAllTy bndr ty)
  | isVisibleArgFlag (binderArgFlag bndr)
  = case splitIfaceReqForallTy ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
splitIfaceReqForallTy rho = ([], rho)

Sylvain Henry's avatar
Sylvain Henry committed
491
492
493
suppressIfaceInvisibles :: PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles (PrintExplicitKinds True) _tys xs = xs
suppressIfaceInvisibles (PrintExplicitKinds False) tys xs = suppress tys xs
494
495
496
    where
      suppress _       []      = []
      suppress []      a       = a
497
498
499
      suppress (k:ks) (x:xs)
        | isInvisibleTyConBinder k =     suppress ks xs
        | otherwise                = x : suppress ks xs
500

Sylvain Henry's avatar
Sylvain Henry committed
501
502
503
504
stripIfaceInvisVars :: PrintExplicitKinds -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars (PrintExplicitKinds True)  tyvars = tyvars
stripIfaceInvisVars (PrintExplicitKinds False) tyvars
  = filterOut isInvisibleTyConBinder tyvars
505

Ningning Xie's avatar
Ningning Xie committed
506
507
508
-- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'.
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar = binderVar
509
510
511

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

Ningning Xie's avatar
Ningning Xie committed
514
515
516
-- | Extract an 'IfaceBndr' from an 'IfaceTyConBinder'.
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar = binderVar
517

518
-- | Extract the variable name from an 'IfaceTyConBinder'.
519
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
Ningning Xie's avatar
Ningning Xie committed
520
ifTyConBinderName tcb = ifaceBndrName (ifTyConBinderVar tcb)
521

522
523
524
525
ifTypeIsVarFree :: IfaceType -> Bool
-- Returns True if the type definitely has no variables at all
-- Just used to control pretty printing
ifTypeIsVarFree ty = go ty
526
  where
527
    go (IfaceTyVar {})         = False
528
    go (IfaceFreeTyVar {})     = False
529
    go (IfaceAppTy fun args)   = go fun && go_args args
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
530
    go (IfaceFunTy _ w arg res) = go w && go arg && go res
531
532
533
534
535
536
537
    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

538
    go_args IA_Nil = True
539
    go_args (IA_Arg arg _ args) = go arg && go_args args
540

541
542
543
544
545
{- 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.  -}
546

547
type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType]
548

549
550
551
552
553
554
555
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)
556
557

substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
558
-- See Note [Substitution on IfaceType]
559
560
561
substIfaceType env ty
  = go ty
  where
562
    go (IfaceFreeTyVar tv)    = IfaceFreeTyVar tv
563
    go (IfaceTyVar tv)        = substIfaceTyVar env tv
564
    go (IfaceAppTy  t ts)     = IfaceAppTy  (go t) (substIfaceAppArgs env ts)
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
565
    go (IfaceFunTy af w t1 t2)  = IfaceFunTy af (go w) (go t1) (go t2)
566
    go ty@(IfaceLitTy {})     = ty
567
568
    go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceAppArgs env tys)
    go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceAppArgs env tys)
569
    go (IfaceForAllTy {})     = pprPanic "substIfaceType" (ppr ty)
570
571
572
    go (IfaceCastTy ty co)    = IfaceCastTy (go ty) (go_co co)
    go (IfaceCoercionTy co)   = IfaceCoercionTy (go_co co)

Ningning Xie's avatar
Ningning Xie committed
573
574
575
576
577
    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)
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
578
    go_co (IfaceFunCo r w c1 c2)     = IfaceFunCo r (go_co w) (go_co c1) (go_co c2)
579
580
581
    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)
582
    go_co (IfaceFreeCoVar cv)        = IfaceFreeCoVar cv
583
    go_co (IfaceCoVarCo cv)          = IfaceCoVarCo cv
Simon Peyton Jones's avatar
Simon Peyton Jones committed
584
    go_co (IfaceHoleCo cv)           = IfaceHoleCo cv
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
    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)
600
601
    go_prov co@(IfacePluginProv _)   = co
    go_prov co@(IfaceCorePrepProv _) = co
602

603
604
substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs env args
605
606
  = go args
  where
607
608
    go IA_Nil              = IA_Nil
    go (IA_Arg ty arg tys) = IA_Arg (substIfaceType env ty) arg (go tys)
609
610
611
612
613

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

615

Austin Seipp's avatar
Austin Seipp committed
616
617
618
{-
************************************************************************
*                                                                      *
619
                Functions over IfaceAppArgs
Austin Seipp's avatar
Austin Seipp committed
620
621
622
*                                                                      *
************************************************************************
-}
623

Sylvain Henry's avatar
Sylvain Henry committed
624
625
626
stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (PrintExplicitKinds True)  tys = tys
stripInvisArgs (PrintExplicitKinds False) tys = suppress_invis tys
627
    where
628
      suppress_invis c
629
        = case c of
630
631
632
633
            IA_Nil -> IA_Nil
            IA_Arg t argf ts
              |  isVisibleArgFlag argf
              -> IA_Arg t argf $ suppress_invis ts
634
635
              -- 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
636
              -- See the "In type declarations" section of Note [VarBndrs,
Sylvain Henry's avatar
Sylvain Henry committed
637
              -- TyCoVarBinders, TyConBinders, and visibility] in GHC.Core.TyCo.Rep.
638
639
              |  otherwise
              -> suppress_invis ts
640

641
642
appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IA_Nil = []
643
644
645
646
647
648
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
649

650
651
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength = go 0
Ben Gamari's avatar
Ben Gamari committed
652
  where
653
654
655
656
    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
657

Austin Seipp's avatar
Austin Seipp committed
658
{-
659
660
Note [Suppressing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
661
662
663
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.
664
See also Type.filterOutInvisibleTypes.
665
For example, given
666

667
668
    T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism
    'Just :: forall k. k -> 'Maybe k   -- Promoted
669

670
671
we want

672
673
674
675
676
677
678
679
680
681
682
    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
683
684
685
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.
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700

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
701
IfaceAppTy (in toIfaceTypeX in GHC.CoreToIface), we:
702
703
704
705
706
707
708
709
710
711
712
713
714
715

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.
716

717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
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
Sylvain Henry's avatar
Sylvain Henry committed
745
Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in GHC.Core.TyCo.Rep for
746
747
a lengthier explanation on what "inferred" and "specified" mean.)

Austin Seipp's avatar
Austin Seipp committed
748
749
************************************************************************
*                                                                      *
750
                Pretty-printing
Austin Seipp's avatar
Austin Seipp committed
751
752
753
*                                                                      *
************************************************************************
-}
754

Ben Gamari's avatar
Ben Gamari committed
755
756
757
758
if_print_coercions :: SDoc  -- ^ if printing coercions
                   -> SDoc  -- ^ otherwise
                   -> SDoc
if_print_coercions yes no
Sylvain Henry's avatar
Sylvain Henry committed
759
  = sdocOption sdocPrintExplicitCoercions $ \print_co ->
Ben Gamari's avatar
Ben Gamari committed
760
    getPprStyle $ \style ->
Sylvain Henry's avatar
Sylvain Henry committed
761
762
    getPprDebug $ \debug ->
    if print_co || dumpStyle style || debug
Ben Gamari's avatar
Ben Gamari committed
763
764
765
    then yes
    else no

766
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
767
pprIfaceInfixApp ctxt_prec pp_tc pp_ty1 pp_ty2
768
  = maybeParen ctxt_prec opPrec $
769
    sep [pp_ty1, pp_tc <+> pp_ty2]
770

771
pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
772
pprIfacePrefixApp ctxt_prec pp_fun pp_tys
773
  | null pp_tys = pp_fun
774
  | otherwise   = maybeParen ctxt_prec appPrec $
775
                  hang pp_fun 2 (sep pp_tys)
776

777
778
isIfaceTauType :: IfaceType -> Bool
isIfaceTauType (IfaceForAllTy _ _) = False
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
779
isIfaceTauType (IfaceFunTy InvisArg _ _ _) = False
780
781
isIfaceTauType _ = True

Austin Seipp's avatar
Austin Seipp committed
782
-- ----------------------------- Printing binders ------------------------------------
783
784
785

instance Outputable IfaceBndr where
    ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
786
787
    ppr (IfaceTvBndr bndr) = char '@' <> pprIfaceTvBndr bndr (SuppressBndrSig False)
                                                             (UseBndrParens False)
788
789
790
791

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

792
793
794
795
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b
pprIfaceLamBndr (b, IfaceOneShot)   = ppr b <> text "[OneShot]"

Ben Gamari's avatar
Ben Gamari committed
796
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
797
pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr w) <+> dcolon <+> ppr ty)
798

799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
{- 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
819
820
821
822
823

Note [Printing type abbreviations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Normally, we pretty-print `TYPE 'LiftedRep` as `Type` (or `*`) and
`FUN 'Many` as `(->)`.
824
825
This way, error messages don't refer to representation polymorphism
or linearity if it is not necessary.
826
827
828
829
830
831
832
833
834

However, when printing the definition of Type or (->) with :info,
this would give confusing output: `type (->) = (->)` (#18594).
Solution: detect when we are in :info and disable displaying the synonym
with the SDoc option sdocPrintTypeAbbreviations.

If there will be a need, in the future we could expose it as a flag
-fprint-type-abbreviations or even two separate flags controlling
TYPE 'LiftedRep and FUN 'Many.
835
836
837
838
839
840
-}

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

Sylvain Henry's avatar
Sylvain Henry committed
841
842
newtype UseBndrParens      = UseBndrParens Bool
newtype PrintExplicitKinds = PrintExplicitKinds Bool
843
844
845
846

pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens)
  | suppress_sig             = ppr tv
847
  | isIfaceLiftedTypeKind ki = ppr tv
Ben Gamari's avatar
Ben Gamari committed
848
849
850
851
  | otherwise                = maybe_parens (ppr tv <+> dcolon <+> ppr ki)
  where
    maybe_parens | use_parens = parens
                 | otherwise  = id
852

853
854
pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders suppress_sig = sep . map go
855
  where
856
857
858
859
860
    go :: IfaceTyConBinder -> SDoc
    go (Bndr (IfaceIdBndr bndr) _) = pprIfaceIdBndr bndr
    go (Bndr (IfaceTvBndr bndr) vis) =
      -- See Note [Pretty-printing invisible arguments]
      case vis of
861
862
        AnonTCB  VisArg    -> ppr_bndr (UseBndrParens True)
        AnonTCB  InvisArg  -> char '@' <> braces (ppr_bndr (UseBndrParens False))
Sylvain Henry's avatar
Sylvain Henry committed
863
          -- The above case is rare. (See Note [AnonTCB InvisArg] in GHC.Core.TyCon.)
864
          -- Should we print these differently?
865
        NamedTCB Required  -> ppr_bndr (UseBndrParens True)
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
866
867
        NamedTCB Specified -> char '@' <> ppr_bndr (UseBndrParens True)
        NamedTCB Inferred  -> char '@' <> braces (ppr_bndr (UseBndrParens False))
868
      where
869
        ppr_bndr = pprIfaceTvBndr bndr suppress_sig
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884

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)
885
886

instance Binary IfaceOneShot where
887
    put_ bh IfaceNoOneShot =
888
            putByte bh 0
889
    put_ bh IfaceOneShot =
890
891
892
893
            putByte bh 1
    get bh = do
            h <- getByte bh
            case h of
894
895
              0 -> return IfaceNoOneShot
              _ -> return IfaceOneShot
896

Austin Seipp's avatar
Austin Seipp committed
897
-- ----------------------------- Printing IfaceType ------------------------------------
898
899
900

---------------------------------
instance Outputable IfaceType where
901
  ppr ty = pprIfaceType ty
902

Ben Gamari's avatar
Ben Gamari committed
903
pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
904
905
pprIfaceType       = pprPrecIfaceType topPrec
pprParendIfaceType = pprPrecIfaceType appPrec
906

907
pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
908
-- We still need `hideNonStandardTypes`, since the `pprPrecIfaceType` may be
909
-- called from other places, besides `:type` and `:info`.
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
910
911
912
pprPrecIfaceType prec ty =
  hideNonStandardTypes (ppr_ty prec) ty

913
914
915
916
917
918
-- mulArrow takes a pretty printer for the type it is being called on to
-- allow type applications to be printed with the correct precedence inside
-- the multiplicity e.g. a %(m n) -> b. See #20315.
mulArrow :: (PprPrec -> a -> SDoc) -> a -> SDoc
mulArrow ppr_mult mult = text "%" <> ppr_mult appPrec mult <+> arrow

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
919
920
921
922
923
924
ppr_fun_arrow :: IfaceMult -> SDoc
ppr_fun_arrow w
  | (IfaceTyConApp tc _) <- w
  , tc `ifaceTyConHasKey` (getUnique manyDataConTyCon) = arrow
  | (IfaceTyConApp tc _) <- w
  , tc `ifaceTyConHasKey` (getUnique oneDataConTyCon) = lollipop
925
  | otherwise = mulArrow pprPrecIfaceType w
926

Simon Peyton Jones's avatar
Simon Peyton Jones committed
927
928
929
930
ppr_sigma :: PprPrec -> IfaceType -> SDoc
ppr_sigma ctxt_prec ty
  = maybeParen ctxt_prec funPrec (pprIfaceSigmaType ShowForAllMust ty)

931
ppr_ty :: PprPrec -> IfaceType -> SDoc
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
932
933
ppr_ty ctxt_prec ty@(IfaceForAllTy {})          = ppr_sigma ctxt_prec ty
ppr_ty ctxt_prec ty@(IfaceFunTy InvisArg _ _ _) = ppr_sigma ctxt_prec ty
Simon Peyton Jones's avatar
Simon Peyton Jones committed
934

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
935
ppr_ty _         (IfaceFreeTyVar tyvar) = ppr tyvar  -- This is the main reason for IfaceFreeTyVar!
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
936
ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar  -- See Note [Free tyvars in IfaceType]
Ben Gamari's avatar
Ben Gamari committed
937
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
sheaf's avatar
sheaf committed
938
ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys -- always fully saturated
Ben Gamari's avatar
Ben Gamari committed
939
ppr_ty _         (IfaceLitTy n)         = pprIfaceTyLit n
940
        -- Function types
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
941
ppr_ty ctxt_prec (IfaceFunTy _ w ty1 ty2)  -- Should be VisArg
942
  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
943
    maybeParen ctxt_prec funPrec $
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
944
    sep [ppr_ty funPrec ty1, sep (ppr_fun_tail w ty2)]
945
  where
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
946
947
948
949
    ppr_fun_tail wthis (IfaceFunTy VisArg wnext ty1 ty2)
      = (ppr_fun_arrow wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2
    ppr_fun_tail wthis other_ty
      = [ppr_fun_arrow wthis <+> pprIfaceType other_ty]
950

951
ppr_ty ctxt_prec (IfaceAppTy t ts)
Ben Gamari's avatar
Ben Gamari committed
952
953
954
955
956
  = if_print_coercions
      ppr_app_ty
      ppr_app_ty_no_casts
  where
    ppr_app_ty =
Sylvain Henry's avatar
Sylvain Henry committed
957
958
959
960
961
962
        sdocOption sdocPrintExplicitKinds $ \print_kinds ->
        let tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs
                              (PrintExplicitKinds print_kinds) ts
        in pprIfacePrefixApp ctxt_prec
                             (ppr_ty funPrec t)
                             (map (ppr_app_arg appPrec) tys_wo_kinds)
963

Ben Gamari's avatar
Ben Gamari committed
964
965
966

    -- Strip any casts from the head of the application
    ppr_app_ty_no_casts =
967
968
969
        case t of
          IfaceCastTy head _ -> ppr_ty ctxt_prec (mk_app_tys head ts)
          _                  -> ppr_app_ty
Ben Gamari's avatar
Ben Gamari committed
970

971
    mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
Ben Gamari's avatar
Ben Gamari committed
972
973
    mk_app_tys (IfaceTyConApp tc tys1) tys2 =
        IfaceTyConApp tc (tys1 `mappend` tys2)
974
    mk_app_tys t1 tys2 = IfaceAppTy t1 tys2
975

976
ppr_ty ctxt_prec (IfaceCastTy ty co)
Ben Gamari's avatar
Ben Gamari committed
977
  = if_print_coercions
978
      (parens (ppr_ty topPrec ty <+> text "|>" <+> ppr co))
Ben Gamari's avatar
Ben Gamari committed
979
      (ppr_ty ctxt_prec ty)
980
981

ppr_ty ctxt_prec (IfaceCoercionTy co)
Ben Gamari's avatar
Ben Gamari committed
982
983
984
  = if_print_coercions
      (ppr_co ctxt_prec co)
      (text "<>")
985

986
987
988
989
{- 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
990
significant and understandable push-back from those with pedagogy in
991
992
993
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
994
995
996
997
998
999
1000

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

1001
1002
1003
1004
1005
1006
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
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
1007
1008
1009
1010
kind RuntimeRep to LiftedRep.
Likewise, we default all Multiplicity variables to Many.

This is done in a pass right before pretty-printing
1011
(defaultIfaceTyVarsOfKind, controlled by
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
1012
-fprint-explicit-runtime-reps and -XLinearTypes)
1013
1014
1015

This applies to /quantified/ variables like 'w' above.  What about
variables that are /free/ in the type being printed, which certainly
1016
1017
happens in error messages.  Suppose (#16074, #19361) we are reporting a
mismatch between skolems
1018
          (a :: RuntimeRep) ~ (b :: RuntimeRep)
1019
1020
1021
1022
        or
          (m :: Multiplicity) ~ Many
We certainly don't want to say "Can't match LiftedRep with LiftedRep" or
"Can't match Many with Many"!
1023
1024

But if we are printing the type
1025
    (forall (a :: TYPE r). blah)