IfaceSyn.hs 88.4 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

6
{-# LANGUAGE CPP #-}
Ian Lynagh's avatar
Ian Lynagh committed
7

8
module IfaceSyn (
dterei's avatar
dterei committed
9
        module IfaceType,
10

11
        IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..),
12
        IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
lukemaurer's avatar
lukemaurer committed
13
        IfaceExpr(..), IfaceAlt, IfaceLetBndr(..), IfaceJoinInfo(..),
dterei's avatar
dterei committed
14 15 16
        IfaceBinding(..), IfaceConAlt(..),
        IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
        IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
17
        IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
18
        IfaceClassBody(..),
19 20 21
        IfaceBang(..),
        IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),
        IfaceAxBranch(..),
22
        IfaceTyConParent(..),
23
        IfaceCompleteMatch(..),
24

25 26 27 28
        -- * Binding names
        IfaceTopBndr,
        putIfaceTopBndr, getIfaceTopBndr,

dterei's avatar
dterei committed
29
        -- Misc
30
        ifaceDeclImplicitBndrs, visibleIfConDecls,
31
        ifaceDeclFingerprints,
32

33
        -- Free Names
34
        freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
35

dterei's avatar
dterei committed
36
        -- Pretty printing
37 38
        pprIfaceExpr,
        pprIfaceDecl,
39
        AltPpr(..), ShowSub(..), ShowHowMuch(..), showToIface, showToHeader
40 41 42 43
    ) where

#include "HsVersions.h"

44 45
import GhcPrelude

46
import IfaceType
47
import BinFingerprint
48
import CoreSyn( IsOrphan, isOrphan )
49
import PprCore()            -- Printing DFunArgs
50
import DynFlags( gopt, GeneralFlag (Opt_PrintAxiomIncomps) )
51
import Demand
Simon Marlow's avatar
Simon Marlow committed
52
import Class
Adam Gundry's avatar
Adam Gundry committed
53
import FieldLabel
dterei's avatar
dterei committed
54
import NameSet
Adam Gundry's avatar
Adam Gundry committed
55
import CoAxiom ( BranchIndex )
Simon Marlow's avatar
Simon Marlow committed
56 57 58 59
import Name
import CostCentre
import Literal
import ForeignCall
60
import Annotations( AnnPayload, AnnTarget )
61
import BasicTypes
62
import Outputable
63
import Module
Peter Wortmann's avatar
Peter Wortmann committed
64
import SrcLoc
65 66
import Fingerprint
import Binary
67
import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
68
import Var( VarBndr(..), binderVar )
69
import TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )
70
import Util( dropList, filterByList, notNull, unzipWith )
71
import DataCon (SrcStrictness(..), SrcUnpackedness(..))
72
import Lexeme (isLexSym)
73

74
import Control.Monad
75
import System.IO.Unsafe
76

77 78
infixl 3 &&&

Austin Seipp's avatar
Austin Seipp committed
79 80 81
{-
************************************************************************
*                                                                      *
82
                    Declarations
Austin Seipp's avatar
Austin Seipp committed
83 84 85
*                                                                      *
************************************************************************
-}
86

87 88 89
-- | A binding top-level 'Name' in an interface file (e.g. the name of an
-- 'IfaceDecl').
type IfaceTopBndr = Name
Gabor Greif's avatar
Gabor Greif committed
90
  -- It's convenient to have a Name in the IfaceSyn, although in each
91
  -- case the namespace is implied by the context. However, having an
92 93 94 95
  -- Name makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
  -- very convenient. Moreover, having the key of the binder means that
  -- we can encode known-key things cleverly in the symbol table. See Note
  -- [Symbol table representation of Names]
96 97
  --
  -- We don't serialise the namespace onto the disk though; rather we
98 99
  -- drop it when serialising and add it back in when deserialising.

100 101 102 103 104 105 106 107 108 109
getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr
getIfaceTopBndr bh = get bh

putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr bh name =
    case getUserData bh of
      UserData{ ud_put_binding_name = put_binding_name } ->
          --pprTrace "putIfaceTopBndr" (ppr name) $
          put_binding_name bh name

dterei's avatar
dterei committed
110
data IfaceDecl
111
  = IfaceId { ifName      :: IfaceTopBndr,
dterei's avatar
dterei committed
112 113 114 115
              ifType      :: IfaceType,
              ifIdDetails :: IfaceIdDetails,
              ifIdInfo    :: IfaceIdInfo }

116
  | IfaceData { ifName       :: IfaceTopBndr,   -- Type constructor
117 118
                ifBinders    :: [IfaceTyConBinder],
                ifResKind    :: IfaceType,      -- Result kind of type constructor
119
                ifCType      :: Maybe CType,    -- C type for CAPI FFI
120
                ifRoles      :: [Role],         -- Roles
dterei's avatar
dterei committed
121
                ifCtxt       :: IfaceContext,   -- The "stupid theta"
122
                ifCons       :: IfaceConDecls,  -- Includes new/data/data family info
dterei's avatar
dterei committed
123 124
                ifGadtSyntax :: Bool,           -- True <=> declared using
                                                -- GADT syntax
125 126
                ifParent     :: IfaceTyConParent -- The axiom, for a newtype,
                                                 -- or data/newtype family instance
127
    }
128

129 130
  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor
                   ifRoles   :: [Role],            -- Roles
131 132
                   ifBinders :: [IfaceTyConBinder],
                   ifResKind :: IfaceKind,         -- Kind of the *result*
133 134 135
                   ifSynRhs  :: IfaceType }

  | IfaceFamily  { ifName    :: IfaceTopBndr,      -- Type constructor
Jan Stolarek's avatar
Jan Stolarek committed
136 137 138
                   ifResVar  :: Maybe IfLclName,   -- Result variable name, used
                                                   -- only for pretty-printing
                                                   -- with --show-iface
139 140
                   ifBinders :: [IfaceTyConBinder],
                   ifResKind :: IfaceKind,         -- Kind of the *tycon*
Jan Stolarek's avatar
Jan Stolarek committed
141 142
                   ifFamFlav :: IfaceFamTyConFlav,
                   ifFamInj  :: Injectivity }      -- injectivity information
143

144
  | IfaceClass { ifName    :: IfaceTopBndr,             -- Name of the class TyCon
145
                 ifRoles   :: [Role],                   -- Roles
146
                 ifBinders :: [IfaceTyConBinder],
147 148
                 ifFDs     :: [FunDep IfLclName],       -- Functional dependencies
                 ifBody    :: IfaceClassBody            -- Methods, superclasses, ATs
149 150
    }

151
  | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name
152
                 ifTyCon      :: IfaceTyCon,     -- LHS TyCon
153
                 ifRole       :: Role,           -- Role of axiom
154 155
                 ifAxBranches :: [IfaceAxBranch] -- Branches
    }
156

157
  | IfacePatSyn { ifName          :: IfaceTopBndr,           -- Name of the pattern synonym
cactus's avatar
cactus committed
158
                  ifPatIsInfix    :: Bool,
159 160
                  ifPatMatcher    :: (IfExtName, Bool),
                  ifPatBuilder    :: Maybe (IfExtName, Bool),
161 162
                  -- Everything below is redundant,
                  -- but needed to implement pprIfaceDecl
163 164
                  ifPatUnivBndrs  :: [IfaceForAllBndr],
                  ifPatExBndrs    :: [IfaceForAllBndr],
cactus's avatar
cactus committed
165 166
                  ifPatProvCtxt   :: IfaceContext,
                  ifPatReqCtxt    :: IfaceContext,
167
                  ifPatArgs       :: [IfaceType],
Matthew Pickering's avatar
Matthew Pickering committed
168 169
                  ifPatTy         :: IfaceType,
                  ifFieldLabels   :: [FieldLabel] }
cactus's avatar
cactus committed
170

171 172 173 174 175 176 177 178 179 180 181
-- See also 'ClassBody'
data IfaceClassBody
  -- Abstract classes don't specify their body; they only occur in @hs-boot@ and
  -- @hsig@ files.
  = IfAbstractClass
  | IfConcreteClass {
     ifClassCtxt :: IfaceContext,             -- Super classes
     ifATs       :: [IfaceAT],                -- Associated type families
     ifSigs      :: [IfaceClassOp],           -- Method signatures
     ifMinDef    :: BooleanFormula IfLclName  -- Minimal complete definition
    }
cactus's avatar
cactus committed
182

183 184
data IfaceTyConParent
  = IfNoParent
185 186 187 188 189
  | IfDataInstance
       IfExtName     -- Axiom name
       IfaceTyCon    -- Family TyCon (pretty-printing only, not used in TcIface)
                     -- see Note [Pretty printing via IfaceSyn] in PprTyThing
       IfaceAppArgs  -- Arguments of the family TyCon
190

191
data IfaceFamTyConFlav
192 193
  = IfaceDataFamilyTyCon                      -- Data family
  | IfaceOpenSynFamilyTyCon
194 195 196
  | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))
    -- ^ Name of associated axiom and branches for pretty printing purposes,
    -- or 'Nothing' for an empty closed family without an axiom
197
    -- See Note [Pretty printing via IfaceSyn] in PprTyThing
198
  | IfaceAbstractClosedSynFamilyTyCon
199
  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
200

201 202 203 204 205
data IfaceClassOp
  = IfaceClassOp IfaceTopBndr
                 IfaceType                         -- Class op type
                 (Maybe (DefMethSpec IfaceType))   -- Default method
                 -- The types of both the class op itself,
Gabor Greif's avatar
Gabor Greif committed
206
                 -- and the default method, are *not* quantified
207
                 -- over the class variables
208

209 210 211 212
data IfaceAT = IfaceAT  -- See Class.ClassATItem
                  IfaceDecl          -- The associated type declaration
                  (Maybe IfaceType)  -- Default associated type instance, if any

213

214
-- This is just like CoAxBranch
215 216 217 218 219 220 221
data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars    :: [IfaceTvBndr]
                                   , ifaxbEtaTyVars :: [IfaceTvBndr]
                                   , ifaxbCoVars    :: [IfaceIdBndr]
                                   , ifaxbLHS       :: IfaceAppArgs
                                   , ifaxbRoles     :: [Role]
                                   , ifaxbRHS       :: IfaceType
                                   , ifaxbIncomps   :: [BranchIndex] }
222
                                     -- See Note [Storing compatibility] in CoAxiom
223

224
data IfaceConDecls
225
  = IfAbstractTyCon     -- c.f TyCon.AbstractTyCon
226 227
  | IfDataTyCon [IfaceConDecl] -- Data type decls
  | IfNewTyCon  IfaceConDecl   -- Newtype decls
Adam Gundry's avatar
Adam Gundry committed
228 229 230

-- For IfDataTyCon and IfNewTyCon we store:
--  * the data constructor(s);
231 232 233
-- The field labels are stored individually in the IfaceConDecl
-- (there is some redundancy here, because a field label may occur
-- in multiple IfaceConDecls and represent the same field label)
234

dterei's avatar
dterei committed
235
data IfaceConDecl
236
  = IfCon {
237
        ifConName    :: IfaceTopBndr,                -- Constructor name
dterei's avatar
dterei committed
238 239
        ifConWrapper :: Bool,                   -- True <=> has a wrapper
        ifConInfix   :: Bool,                   -- True <=> declared infix
240 241 242 243 244 245 246

        -- The universal type variables are precisely those
        -- of the type constructor of this data constructor
        -- This is *easy* to guarantee when creating the IfCon
        -- but it's not so easy for the original TyCon/DataCon
        -- So this guarantee holds for IfaceConDecl, but *not* for DataCon

Ningning Xie's avatar
Ningning Xie committed
247
        ifConExTCvs   :: [IfaceBndr],  -- Existential ty/covars
248 249 250
        ifConUserTvBinders :: [IfaceForAllBndr],
          -- The tyvars, in the order the user wrote them
          -- INVARIANT: the set of tyvars in ifConUserTvBinders is exactly the
Ningning Xie's avatar
Ningning Xie committed
251 252 253
          --            set of tyvars (*not* covars) of ifConExTCvs, unioned
          --            with the set of ifBinders (from the parent IfaceDecl)
          --            whose tyvars do not appear in ifConEqSpec
254
          -- See Note [DataCon user type variable binders] in DataCon
255 256 257
        ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints
        ifConCtxt    :: IfaceContext,       -- Non-stupid context
        ifConArgTys  :: [IfaceType],        -- Arg types
258
        ifConFields  :: [FieldLabel],  -- ...ditto... (field labels)
259 260 261 262 263
        ifConStricts :: [IfaceBang],
          -- Empty (meaning all lazy),
          -- or 1-1 corresp with arg tys
          -- See Note [Bangs on imported data constructors] in MkId
        ifConSrcStricts :: [IfaceSrcBang] } -- empty meaning no src stricts
dterei's avatar
dterei committed
264

265
type IfaceEqSpec = [(IfLclName,IfaceType)]
266

267 268 269
-- | This corresponds to an HsImplBang; that is, the final
-- implementation decision about the data constructor arg
data IfaceBang
270 271
  = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion

272 273 274 275
-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

276 277 278 279 280
data IfaceClsInst
  = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
                   ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
                   ifDFun     :: IfExtName,                -- The dfun
                   ifOFlag    :: OverlapFlag,              -- Overlap flag
281
                   ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv
dterei's avatar
dterei committed
282 283 284 285 286 287
        -- There's always a separate IfaceDecl for the DFun, which gives
        -- its IdInfo with its full type and version number.
        -- The instance declarations taken together have a version number,
        -- and we don't want that to wobble gratuitously
        -- If this instance decl is *used*, we'll record a usage on the dfun;
        -- and if the head does not change it won't be used if it wasn't before
288

289
-- The ifFamInstTys field of IfaceFamInst contains a list of the rough
290
-- match types
291
data IfaceFamInst
292
  = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name
293
                 , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above
294
                 , ifFamInstAxiom    :: IfExtName            -- The axiom
295
                 , ifFamInstOrph     :: IsOrphan             -- Just like IfaceClsInst
dterei's avatar
dterei committed
296
                 }
297

298
data IfaceRule
dterei's avatar
dterei committed
299 300 301 302 303 304 305 306
  = IfaceRule {
        ifRuleName   :: RuleName,
        ifActivation :: Activation,
        ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
        ifRuleHead   :: IfExtName,      -- Head of lhs
        ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
        ifRuleRhs    :: IfaceExpr,
        ifRuleAuto   :: Bool,
307
        ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst
308 309
    }

310 311 312
data IfaceAnnotation
  = IfaceAnnotation {
        ifAnnotatedTarget :: IfaceAnnTarget,
313
        ifAnnotatedValue  :: AnnPayload
314 315 316 317
  }

type IfaceAnnTarget = AnnTarget OccName

318 319
data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName

320 321 322 323
instance Outputable IfaceCompleteMatch where
  ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls
                                                    <+> dcolon <+> ppr ty

324 325 326



327
-- Here's a tricky case:
328 329
--   * Compile with -O module A, and B which imports A.f
--   * Change function f in A, and recompile without -O
330
--   * When we read in old A.hi we read in its IdInfo (as a thunk)
dterei's avatar
dterei committed
331 332 333
--      (In earlier GHCs we used to drop IdInfo immediately on reading,
--       but we do not do that now.  Instead it's discarded when the
--       ModIface is read into the various decl pools.)
Gabor Greif's avatar
typo  
Gabor Greif committed
334
--   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
dterei's avatar
dterei committed
335
--      and so gives a new version.
336

337 338 339 340
data IfaceIdInfo
  = NoInfo                      -- When writing interface file without -O
  | HasInfo [IfaceInfoItem]     -- Has info, and here it is

341
data IfaceInfoItem
342 343 344 345 346
  = HsArity         Arity
  | HsStrictness    StrictSig
  | HsInline        InlinePragma
  | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true
                    IfaceUnfolding   -- See Note [Expose recursive functions]
347
  | HsNoCafRefs
Richard Eisenberg's avatar
Richard Eisenberg committed
348
  | HsLevity                         -- Present <=> never levity polymorphic
349

350 351 352
-- NB: Specialisations and rules come in separately and are
-- only later attached to the Id.  Partial reason: some are orphans.

dterei's avatar
dterei committed
353
data IfaceUnfolding
354
  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
355 356
                                -- Possibly could eliminate the Bool here, the information
                                -- is also in the InlinePragma.
357

dterei's avatar
dterei committed
358
  | IfCompulsory IfaceExpr      -- Only used for default methods, in fact
359

360
  | IfInlineRule Arity          -- INLINE pragmas
dterei's avatar
dterei committed
361 362 363
                 Bool           -- OK to inline even if *un*-saturated
                 Bool           -- OK to inline even if context is boring
                 IfaceExpr
364

365
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
366

367

368 369 370 371
-- We only serialise the IdDetails of top-level Ids, and even then
-- we only need a very limited selection.  Notably, none of the
-- implicit ones are needed here, because they are not put it
-- interface files
372

373 374
data IfaceIdDetails
  = IfVanillaId
Matthew Pickering's avatar
Matthew Pickering committed
375
  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
376
  | IfDFunId
377

Austin Seipp's avatar
Austin Seipp committed
378
{-
379 380
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
381
See [https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance#instances]
382

383

Austin Seipp's avatar
Austin Seipp committed
384 385
************************************************************************
*                                                                      *
386
                Functions over declarations
Austin Seipp's avatar
Austin Seipp committed
387 388 389
*                                                                      *
************************************************************************
-}
390 391

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
392
visibleIfConDecls IfAbstractTyCon  = []
393
visibleIfConDecls (IfDataTyCon cs) = cs
394
visibleIfConDecls (IfNewTyCon c)   = [c]
395

396
ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
397 398 399
--  *Excludes* the 'main' name, but *includes* the implicitly-bound names
-- Deeply revolting, because it has to predict what gets bound,
-- especially the question of whether there's a wrapper for a datacon
400
-- See Note [Implicit TyThings] in HscTypes
401

402 403 404 405 406
-- N.B. the set of names returned here *must* match the set of
-- TyThings returned by HscTypes.implicitTyThings, in the sense that
-- TyThing.getOccName should define a bijection between the two lists.
-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
-- The order of the list does not matter.
407

408
ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })
409
  = case cons of
410
      IfAbstractTyCon -> []
411 412
      IfNewTyCon  cd  -> mkNewTyCoOcc (occName tc_name) : ifaceConDeclImplicitBndrs cd
      IfDataTyCon cds -> concatMap ifaceConDeclImplicitBndrs cds
413

414 415 416 417 418 419 420 421 422
ifaceDeclImplicitBndrs (IfaceClass { ifBody = IfAbstractClass })
  = []

ifaceDeclImplicitBndrs (IfaceClass { ifName = cls_tc_name
                                   , ifBody = IfConcreteClass {
                                        ifClassCtxt = sc_ctxt,
                                        ifSigs      = sigs,
                                        ifATs       = ats
                                     }})
batterseapower's avatar
batterseapower committed
423
  = --   (possibly) newtype coercion
424 425 426 427 428 429
    co_occs ++
    --    data constructor (DataCon namespace)
    --    data worker (Id namespace)
    --    no wrapper (class dictionaries never have a wrapper)
    [dc_occ, dcww_occ] ++
    -- associated types
430
    [occName (ifName at) | IfaceAT at _ <- ats ] ++
431
    -- superclass selectors
batterseapower's avatar
batterseapower committed
432
    [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
433
    -- operation selectors
434
    [occName op | IfaceClassOp op  _ _ <- sigs]
435
  where
436
    cls_tc_occ = occName cls_tc_name
437 438
    n_ctxt = length sc_ctxt
    n_sigs = length sigs
batterseapower's avatar
batterseapower committed
439
    co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
dterei's avatar
dterei committed
440
            | otherwise  = []
441
    dcww_occ = mkDataConWorkerOcc dc_occ
batterseapower's avatar
batterseapower committed
442
    dc_occ = mkClassDataConOcc cls_tc_occ
443
    is_newtype = n_sigs + n_ctxt == 1 -- Sigh (keep this synced with buildClass)
444

445
ifaceDeclImplicitBndrs _ = []
446

447
ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
448 449
ifaceConDeclImplicitBndrs (IfCon {
        ifConWrapper = has_wrapper, ifConName = con_name })
450
  = [occName con_name, work_occ] ++ wrap_occs
451
  where
452
    con_occ = occName con_name
453 454 455 456
    work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace
    wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace
              | otherwise   = []

457 458 459 460 461 462 463 464 465
-- -----------------------------------------------------------------------------
-- The fingerprints of an IfaceDecl

       -- We better give each name bound by the declaration a
       -- different fingerprint!  So we calculate the fingerprint of
       -- each binder by combining the fingerprint of the whole
       -- declaration with the name of the binder. (#5614, #7215)
ifaceDeclFingerprints :: Fingerprint -> IfaceDecl -> [(OccName,Fingerprint)]
ifaceDeclFingerprints hash decl
466
  = (getOccName decl, hash) :
467 468 469 470 471 472
    [ (occ, computeFingerprint' (hash,occ))
    | occ <- ifaceDeclImplicitBndrs decl ]
  where
     computeFingerprint' =
       unsafeDupablePerformIO
        . computeFingerprint (panic "ifaceDeclFingerprints")
473

Austin Seipp's avatar
Austin Seipp committed
474 475 476
{-
************************************************************************
*                                                                      *
477
                Expressions
Austin Seipp's avatar
Austin Seipp committed
478 479 480
*                                                                      *
************************************************************************
-}
481 482 483 484 485 486

data IfaceExpr
  = IfaceLcl    IfLclName
  | IfaceExt    IfExtName
  | IfaceType   IfaceType
  | IfaceCo     IfaceCoercion
487
  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
488
  | IfaceLam    IfaceLamBndr IfaceExpr
489 490
  | IfaceApp    IfaceExpr IfaceExpr
  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
491
  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
492
  | IfaceLet    IfaceBinding  IfaceExpr
493 494 495 496 497 498 499 500
  | IfaceCast   IfaceExpr IfaceCoercion
  | IfaceLit    Literal
  | IfaceFCall  ForeignCall IfaceType
  | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E

data IfaceTickish
  = IfaceHpcTick Module Int                -- from HpcTick x
  | IfaceSCC     CostCentre Bool Bool      -- from ProfNote
Peter Wortmann's avatar
Peter Wortmann committed
501
  | IfaceSource  RealSrcSpan String        -- from SourceNote
502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519
  -- no breakpoints: we never export these into interface files

type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
        -- Note: IfLclName, not IfaceBndr (and same with the case binder)
        -- We reconstruct the kind/type of the thing from the context
        -- thus saving bulk in interface files

data IfaceConAlt = IfaceDefault
                 | IfaceDataAlt IfExtName
                 | IfaceLitAlt Literal

data IfaceBinding
  = IfaceNonRec IfaceLetBndr IfaceExpr
  | IfaceRec    [(IfaceLetBndr, IfaceExpr)]

-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
-- It's used for *non-top-level* let/rec binders
-- See Note [IdInfo on nested let-bindings]
lukemaurer's avatar
lukemaurer committed
520 521 522 523
data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo

data IfaceJoinInfo = IfaceNotJoinPoint
                   | IfaceJoinPoint JoinArity
524

Austin Seipp's avatar
Austin Seipp committed
525
{-
526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548
Note [Empty case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In IfaceSyn an IfaceCase does not record the types of the alternatives,
unlike CorSyn Case.  But we need this type if the alternatives are empty.
Hence IfaceECase.  See Note [Empty case alternatives] in CoreSyn.

Note [Expose recursive functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For supercompilation we want to put *all* unfoldings in the interface
file, even for functions that are recursive (or big).  So we need to
know when an unfolding belongs to a loop-breaker so that we can refrain
from inlining it (except during supercompilation).

Note [IdInfo on nested let-bindings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Occasionally we want to preserve IdInfo on nested let bindings. The one
that came up was a NOINLINE pragma on a let-binding inside an INLINE
function.  The user (Duncan Coutts) really wanted the NOINLINE control
to cross the separate compilation boundary.

In general we retain all info that is left by CoreTidy.tidyLetBndr, since
that is what is seen by importing module with --make

549 550 551 552 553 554 555 556 557 558 559 560 561 562 563
Note [Displaying axiom incompatibilities]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With -fprint-axiom-incomps we display which closed type family equations
are incompatible with which. This information is sometimes necessary
because GHC doesn't try equations in order: any equation can be used when
all preceding equations that are incompatible with it do not apply.

For example, the last "a && a = a" equation in Data.Type.Bool.&& is
actually compatible with all previous equations, and can reduce at any
time.

This is displayed as:
Prelude> :i Data.Type.Equality.==
type family (==) (a :: k) (b :: k) :: Bool
  where
564 565 566 567 568
    {- #0 -} (==) (f a) (g b) = (f == g) && (a == b)
    {- #1 -} (==) a a = 'True
          -- incompatible with: #0
    {- #2 -} (==) _1 _2 = 'False
          -- incompatible with: #1, #0
569 570
The comment after an equation refers to all previous equations (0-indexed)
that are incompatible with it.
571

Austin Seipp's avatar
Austin Seipp committed
572 573
************************************************************************
*                                                                      *
574
              Printing IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
575 576 577
*                                                                      *
************************************************************************
-}
578

579
pprAxBranch :: SDoc -> BranchIndex -> IfaceAxBranch -> SDoc
580 581 582
-- The TyCon might be local (just an OccName), or this might
-- be a branch for an imported TyCon, so it would be an ExtName
-- So it's easier to take an SDoc here
583 584 585 586 587 588
--
-- This function is used
--    to print interface files,
--    in debug messages
--    in :info F for GHCi, which goes via toConToIfaceDecl on the family tycon
-- For user error messages we use Coercion.pprCoAxiom and friends
589 590 591 592 593
pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs
                                     , ifaxbCoVars = _cvs
                                     , ifaxbLHS = pat_tys
                                     , ifaxbRHS = rhs
                                     , ifaxbIncomps = incomps })
594 595
  = WARN( not (null _cvs), pp_tc $$ ppr _cvs )
    hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))
596
    $+$
597
    nest 4 maybe_incomps
598
  where
599
    -- See Note [Printing foralls in type family instances] in IfaceType
600 601
    ppr_binders = maybe_index <+>
      pprUserIfaceForAll (map (mkIfaceForAllTvBndr Specified) tvs)
602
    pp_lhs = hang pp_tc 2 (pprParendIfaceAppArgs pat_tys)
603 604

    -- See Note [Displaying axiom incompatibilities]
605 606 607 608
    maybe_index
      = sdocWithDynFlags $ \dflags ->
        ppWhen (gopt Opt_PrintAxiomIncomps dflags) $
          text "{-" <+> (text "#" <> ppr idx) <+> text "-}"
609 610 611
    maybe_incomps
      = sdocWithDynFlags $ \dflags ->
        ppWhen (gopt Opt_PrintAxiomIncomps dflags && notNull incomps) $
612 613
          text "--" <+> text "incompatible with:"
          <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps
614 615 616 617

instance Outputable IfaceAnnotation where
  ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value

618 619 620
instance NamedThing IfaceClassOp where
  getName (IfaceClassOp n _ _) = n

621
instance HasOccName IfaceClassOp where
622 623 624 625
  occName = getOccName

instance NamedThing IfaceConDecl where
  getName = ifConName
626

627
instance HasOccName IfaceConDecl where
628 629 630 631
  occName = getOccName

instance NamedThing IfaceDecl where
  getName = ifName
632

633
instance HasOccName IfaceDecl where
634
  occName = getOccName
635

636
instance Outputable IfaceDecl where
637
  ppr = pprIfaceDecl showToIface
638

639 640 641 642 643 644 645 646 647
{-
Note [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The minimal complete definition should only be included if a complete
class definition is shown. Since the minimal complete definition is
anonymous we can't reuse the same mechanism that is used for the
filtering of method signatures. Instead we just check if anything at all is
filtered and hide it in that case.
-}

648 649
data ShowSub
  = ShowSub
650 651 652 653 654 655
      { ss_how_much :: ShowHowMuch
      , ss_forall :: ShowForAllFlag }

-- See Note [Printing IfaceDecl binders]
-- The alternative pretty printer referred to in the note.
newtype AltPpr = AltPpr (Maybe (OccName -> SDoc))
656 657

data ShowHowMuch
658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680
  = ShowHeader AltPpr -- ^Header information only, not rhs
  | ShowSome [OccName] AltPpr
  -- ^ Show only some sub-components. Specifically,
  --
  -- [@[]@] Print all sub-components.
  -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@;
  -- elide other sub-components to @...@
  -- May 14: the list is max 1 element long at the moment
  | ShowIface
  -- ^Everything including GHC-internal information (used in --show-iface)

{-
Note [Printing IfaceDecl binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The binders in an IfaceDecl are just OccNames, so we don't know what module they
come from.  But when we pretty-print a TyThing by converting to an IfaceDecl
(see PprTyThing), the TyThing may come from some other module so we really need
the module qualifier.  We solve this by passing in a pretty-printer for the
binders.

When printing an interface file (--show-iface), we want to print
everything unqualified, so we can just print the OccName directly.
-}
681

682
instance Outputable ShowHowMuch where
683 684 685 686 687 688 689
  ppr (ShowHeader _)    = text "ShowHeader"
  ppr ShowIface         = text "ShowIface"
  ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs

showToHeader :: ShowSub
showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing
                       , ss_forall = ShowForAllWhen }
690

691 692 693
showToIface :: ShowSub
showToIface = ShowSub { ss_how_much = ShowIface
                      , ss_forall = ShowForAllWhen }
694 695 696

ppShowIface :: ShowSub -> SDoc -> SDoc
ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
697
ppShowIface _                                     _   = Outputable.empty
698

699 700
-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
701 702 703
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc
ppShowAllSubs _                                         _   = Outputable.empty
704

705
ppShowRhs :: ShowSub -> SDoc -> SDoc
706 707
ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty
ppShowRhs _                                        doc = doc
708 709

showSub :: HasOccName n => ShowSub -> n -> Bool
710 711
showSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
712
showSub (ShowSub { ss_how_much = _ })              _     = True
713

714 715 716 717 718 719 720
ppr_trim :: [Maybe SDoc] -> [SDoc]
-- Collapse a group of Nothings to a single "..."
ppr_trim xs
  = snd (foldr go (False, []) xs)
  where
    go (Just doc) (_,     so_far) = (False, doc : so_far)
    go Nothing    (True,  so_far) = (True, so_far)
721
    go Nothing    (False, so_far) = (True, text "..." : so_far)
722 723 724 725 726

isIfaceDataInstance :: IfaceTyConParent -> Bool
isIfaceDataInstance IfNoParent = False
isIfaceDataInstance _          = True

727 728 729 730 731 732 733
pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
pprClassRoles ss clas binders roles =
    pprRoles (== Nominal)
             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
             binders
             roles

734
pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
735 736
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
737
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
Edward Z. Yang's avatar
Edward Z. Yang committed
738
                             ifCtxt = context, ifResKind = kind,
739
                             ifRoles = roles, ifCons = condecls,
Edward Z. Yang's avatar
Edward Z. Yang committed
740
                             ifParent = parent,
741
                             ifGadtSyntax = gadt,
742
                             ifBinders = binders })
743

744
  | gadt      = vcat [ pp_roles
Edward Z. Yang's avatar
Edward Z. Yang committed
745
                     , pp_nd <+> pp_lhs <+> pp_kind <+> pp_where
746 747 748
                     , nest 2 (vcat pp_cons)
                     , nest 2 $ ppShowIface ss pp_extra ]
  | otherwise = vcat [ pp_roles
749
                     , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
750
                     , nest 2 $ ppShowIface ss pp_extra ]
751 752
  where
    is_data_instance = isIfaceDataInstance parent
753 754 755 756 757 758
    -- See Note [Printing foralls in type family instances] in IfaceType
    pp_data_inst_forall :: SDoc
    pp_data_inst_forall = pprUserIfaceForAll forall_bndrs

    forall_bndrs :: [IfaceForAllBndr]
    forall_bndrs = [Bndr (binderVar tc_bndr) Specified | tc_bndr <- binders]
759 760

    cons       = visibleIfConDecls condecls
761
    pp_where   = ppWhen (gadt && not (null cons)) $ text "where"
762
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]
Edward Z. Yang's avatar
Edward Z. Yang committed
763 764 765
    pp_kind
      | isIfaceLiftedTypeKind kind = empty
      | otherwise = dcolon <+> ppr kind
766 767

    pp_lhs = case parent of
768
               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing
769 770 771
               IfDataInstance{}
                          -> text "instance" <+> pp_data_inst_forall
                                             <+> pprIfaceTyConParent parent
772 773

    pp_roles
774 775
      | is_data_instance = empty
      | otherwise        = pprRoles (== Representational)
776 777 778
                                    (pprPrefixIfDeclBndr
                                        (ss_how_much ss)
                                        (occName tycon))
779
                                    binders roles
780
            -- Don't display roles for data family instances (yet)
781
            -- See discussion on #8672.
782

783
    add_bars []     = Outputable.empty
784
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
785

786
    ok_con dc = showSub ss dc || any (showSub ss . flSelector) (ifConFields dc)
787 788

    show_con dc
789
      | ok_con dc = Just $ pprIfaceConDecl ss gadt tycon binders parent dc
790
      | otherwise = Nothing
791

792
    pp_nd = case condecls of
793
              IfAbstractTyCon{} -> text "data"
794 795
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
796

Edward Z. Yang's avatar
Edward Z. Yang committed
797
    pp_extra = vcat [pprCType ctype]
798

799
pprIfaceDecl ss (IfaceClass { ifName  = clas
800
                            , ifRoles = roles
801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818
                            , ifFDs    = fds
                            , ifBinders = binders
                            , ifBody = IfAbstractClass })
  = vcat [ pprClassRoles ss clas binders roles
         , text "class" <+> pprIfaceDeclHead [] ss clas binders Nothing
                                <+> pprFundeps fds ]

pprIfaceDecl ss (IfaceClass { ifName  = clas
                            , ifRoles = roles
                            , ifFDs    = fds
                            , ifBinders = binders
                            , ifBody = IfConcreteClass {
                                ifATs = ats,
                                ifSigs = sigs,
                                ifClassCtxt = context,
                                ifMinDef = minDef
                              }})
  = vcat [ pprClassRoles ss clas binders roles
819
         , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
820
                                <+> pprFundeps fds <+> pp_where
Edward Z. Yang's avatar
Edward Z. Yang committed
821
         , nest 2 (vcat [ vcat asocs, vcat dsigs
822
                        , ppShowAllSubs ss (pprMinDef minDef)])]
823
    where
824
      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
825 826 827 828 829 830 831 832 833 834 835 836 837 838

      asocs = ppr_trim $ map maybeShowAssoc ats
      dsigs = ppr_trim $ map maybeShowSig sigs

      maybeShowAssoc :: IfaceAT -> Maybe SDoc
      maybeShowAssoc asc@(IfaceAT d _)
        | showSub ss d = Just $ pprIfaceAT ss asc
        | otherwise    = Nothing

      maybeShowSig :: IfaceClassOp -> Maybe SDoc
      maybeShowSig sg
        | showSub ss sg = Just $  pprIfaceClassOp ss sg
        | otherwise     = Nothing

839 840
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
841
        text