Syntax.hs 96.6 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 #-}
7
{-# LANGUAGE LambdaCase #-}
Ian Lynagh's avatar
Ian Lynagh committed
8

9 10
module GHC.Iface.Syntax (
        module GHC.Iface.Type,
11

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

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

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

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

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

#include "HsVersions.h"

45 46
import GhcPrelude

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

77
import Control.Monad
78
import System.IO.Unsafe
79
import Control.DeepSeq
80

81 82
infixl 3 &&&

Austin Seipp's avatar
Austin Seipp committed
83 84 85
{-
************************************************************************
*                                                                      *
86
                    Declarations
Austin Seipp's avatar
Austin Seipp committed
87 88 89
*                                                                      *
************************************************************************
-}
90

91 92 93
-- | A binding top-level 'Name' in an interface file (e.g. the name of an
-- 'IfaceDecl').
type IfaceTopBndr = Name
94 95
  -- It's convenient to have a Name in the Iface syntax, although in each
  -- case the namespace is implied by the context. However, having a
96 97 98 99
  -- 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]
100 101
  --
  -- We don't serialise the namespace onto the disk though; rather we
102 103
  -- drop it when serialising and add it back in when deserialising.

104 105 106 107 108 109 110 111 112 113
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
114
data IfaceDecl
115
  = IfaceId { ifName      :: IfaceTopBndr,
dterei's avatar
dterei committed
116 117 118 119
              ifType      :: IfaceType,
              ifIdDetails :: IfaceIdDetails,
              ifIdInfo    :: IfaceIdInfo }

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

133 134
  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor
                   ifRoles   :: [Role],            -- Roles
135 136
                   ifBinders :: [IfaceTyConBinder],
                   ifResKind :: IfaceKind,         -- Kind of the *result*
137 138 139
                   ifSynRhs  :: IfaceType }

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

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

155
  | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name
156
                 ifTyCon      :: IfaceTyCon,     -- LHS TyCon
157
                 ifRole       :: Role,           -- Role of axiom
158 159
                 ifAxBranches :: [IfaceAxBranch] -- Branches
    }
160

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

175 176 177 178 179 180 181 182 183 184 185
-- 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
186

187 188
data IfaceTyConParent
  = IfNoParent
189 190
  | IfDataInstance
       IfExtName     -- Axiom name
191 192
       IfaceTyCon    -- Family TyCon (pretty-printing only, not used in GHC.IfaceToCore)
                     -- see Note [Pretty printing via Iface syntax] in PprTyThing
193
       IfaceAppArgs  -- Arguments of the family TyCon
194

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

205 206 207 208 209
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
210
                 -- and the default method, are *not* quantified
211
                 -- over the class variables
212

213 214 215 216
data IfaceAT = IfaceAT  -- See Class.ClassATItem
                  IfaceDecl          -- The associated type declaration
                  (Maybe IfaceType)  -- Default associated type instance, if any

217

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

228
data IfaceConDecls
229
  = IfAbstractTyCon     -- c.f TyCon.AbstractTyCon
230 231
  | IfDataTyCon [IfaceConDecl] -- Data type decls
  | IfNewTyCon  IfaceConDecl   -- Newtype decls
Adam Gundry's avatar
Adam Gundry committed
232 233 234

-- For IfDataTyCon and IfNewTyCon we store:
--  * the data constructor(s);
235 236 237
-- 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)
238

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

        -- 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
251
        ifConExTCvs   :: [IfaceBndr],  -- Existential ty/covars
252 253 254
        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
255 256 257
          --            set of tyvars (*not* covars) of ifConExTCvs, unioned
          --            with the set of ifBinders (from the parent IfaceDecl)
          --            whose tyvars do not appear in ifConEqSpec
258
          -- See Note [DataCon user type variable binders] in DataCon
259 260 261
        ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints
        ifConCtxt    :: IfaceContext,       -- Non-stupid context
        ifConArgTys  :: [IfaceType],        -- Arg types
262
        ifConFields  :: [FieldLabel],  -- ...ditto... (field labels)
263 264 265 266 267
        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
268

269
type IfaceEqSpec = [(IfLclName,IfaceType)]
270

271 272 273
-- | This corresponds to an HsImplBang; that is, the final
-- implementation decision about the data constructor arg
data IfaceBang
274 275
  = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion

276 277 278 279
-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

280 281 282 283 284
data IfaceClsInst
  = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
                   ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
                   ifDFun     :: IfExtName,                -- The dfun
                   ifOFlag    :: OverlapFlag,              -- Overlap flag
285
                   ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv
dterei's avatar
dterei committed
286 287 288 289 290 291
        -- 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
292

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

302
data IfaceRule
dterei's avatar
dterei committed
303 304 305 306 307 308 309 310
  = 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,
311
        ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst
312 313
    }

314 315 316
data IfaceAnnotation
  = IfaceAnnotation {
        ifAnnotatedTarget :: IfaceAnnTarget,
317
        ifAnnotatedValue  :: AnnPayload
318 319 320 321
  }

type IfaceAnnTarget = AnnTarget OccName

322 323
data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName

324 325 326 327
instance Outputable IfaceCompleteMatch where
  ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls
                                                    <+> dcolon <+> ppr ty

328 329 330



331
-- Here's a tricky case:
332 333
--   * Compile with -O module A, and B which imports A.f
--   * Change function f in A, and recompile without -O
334
--   * When we read in old A.hi we read in its IdInfo (as a thunk)
dterei's avatar
dterei committed
335 336 337
--      (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
338
--   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
dterei's avatar
dterei committed
339
--      and so gives a new version.
340

341 342 343 344
data IfaceIdInfo
  = NoInfo                      -- When writing interface file without -O
  | HasInfo [IfaceInfoItem]     -- Has info, and here it is

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

355 356 357
-- 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
358
data IfaceUnfolding
359
  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
360 361
                                -- Possibly could eliminate the Bool here, the information
                                -- is also in the InlinePragma.
362

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

365
  | IfInlineRule Arity          -- INLINE pragmas
dterei's avatar
dterei committed
366 367 368
                 Bool           -- OK to inline even if *un*-saturated
                 Bool           -- OK to inline even if context is boring
                 IfaceExpr
369

370
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
371

372

373 374 375 376
-- 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
377

378 379
data IfaceIdDetails
  = IfVanillaId
Matthew Pickering's avatar
Matthew Pickering committed
380
  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
381
  | IfDFunId
382

Austin Seipp's avatar
Austin Seipp committed
383
{-
384 385
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
386
See [https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance#instances]
387

388

Austin Seipp's avatar
Austin Seipp committed
389 390
************************************************************************
*                                                                      *
391
                Functions over declarations
Austin Seipp's avatar
Austin Seipp committed
392 393 394
*                                                                      *
************************************************************************
-}
395 396

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
397
visibleIfConDecls IfAbstractTyCon  = []
398
visibleIfConDecls (IfDataTyCon cs) = cs
399
visibleIfConDecls (IfNewTyCon c)   = [c]
400

401
ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
402 403 404
--  *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
405
-- See Note [Implicit TyThings] in HscTypes
406

407 408 409
-- 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.
410
-- This invariant is used in GHC.Iface.Load.loadDecl (see note [Tricky iface loop])
411
-- The order of the list does not matter.
412

413
ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })
414
  = case cons of
415
      IfAbstractTyCon -> []
416 417
      IfNewTyCon  cd  -> mkNewTyCoOcc (occName tc_name) : ifaceConDeclImplicitBndrs cd
      IfDataTyCon cds -> concatMap ifaceConDeclImplicitBndrs cds
418

419 420 421 422 423 424 425 426 427
ifaceDeclImplicitBndrs (IfaceClass { ifBody = IfAbstractClass })
  = []

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

450
ifaceDeclImplicitBndrs _ = []
451

452
ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
453 454
ifaceConDeclImplicitBndrs (IfCon {
        ifConWrapper = has_wrapper, ifConName = con_name })
455
  = [occName con_name, work_occ] ++ wrap_occs
456
  where
457
    con_occ = occName con_name
458 459 460 461
    work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace
    wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace
              | otherwise   = []

462 463 464 465 466 467 468 469 470
-- -----------------------------------------------------------------------------
-- 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
471
  = (getOccName decl, hash) :
472 473 474 475 476 477
    [ (occ, computeFingerprint' (hash,occ))
    | occ <- ifaceDeclImplicitBndrs decl ]
  where
     computeFingerprint' =
       unsafeDupablePerformIO
        . computeFingerprint (panic "ifaceDeclFingerprints")
478

Austin Seipp's avatar
Austin Seipp committed
479 480 481
{-
************************************************************************
*                                                                      *
482
                Expressions
Austin Seipp's avatar
Austin Seipp committed
483 484 485
*                                                                      *
************************************************************************
-}
486 487 488 489 490 491

data IfaceExpr
  = IfaceLcl    IfLclName
  | IfaceExt    IfExtName
  | IfaceType   IfaceType
  | IfaceCo     IfaceCoercion
492
  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
493
  | IfaceLam    IfaceLamBndr IfaceExpr
494 495
  | IfaceApp    IfaceExpr IfaceExpr
  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
496
  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
497
  | IfaceLet    IfaceBinding  IfaceExpr
498 499 500 501 502 503 504 505
  | 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
506
  | IfaceSource  RealSrcSpan String        -- from SourceNote
507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524
  -- 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
525 526 527 528
data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo

data IfaceJoinInfo = IfaceNotJoinPoint
                   | IfaceJoinPoint JoinArity
529

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

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

554 555 556 557 558 559 560 561 562 563 564 565 566 567 568
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
569 570 571 572 573
    {- #0 -} (==) (f a) (g b) = (f == g) && (a == b)
    {- #1 -} (==) a a = 'True
          -- incompatible with: #0
    {- #2 -} (==) _1 _2 = 'False
          -- incompatible with: #1, #0
574 575
The comment after an equation refers to all previous equations (0-indexed)
that are incompatible with it.
576

Austin Seipp's avatar
Austin Seipp committed
577 578
************************************************************************
*                                                                      *
579
              Printing IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
580 581 582
*                                                                      *
************************************************************************
-}
583

584
pprAxBranch :: SDoc -> BranchIndex -> IfaceAxBranch -> SDoc
585 586 587
-- 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
588 589 590 591 592 593
--
-- 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
594 595 596 597 598
pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs
                                     , ifaxbCoVars = _cvs
                                     , ifaxbLHS = pat_tys
                                     , ifaxbRHS = rhs
                                     , ifaxbIncomps = incomps })
599
  = ASSERT2( null _cvs, pp_tc $$ ppr _cvs )
600
    hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))
601
    $+$
602
    nest 4 maybe_incomps
603
  where
604
    -- See Note [Printing foralls in type family instances] in GHC.Iface.Type
605 606
    ppr_binders = maybe_index <+>
      pprUserIfaceForAll (map (mkIfaceForAllTvBndr Specified) tvs)
607
    pp_lhs = hang pp_tc 2 (pprParendIfaceAppArgs pat_tys)
608 609

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

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

623 624 625
instance NamedThing IfaceClassOp where
  getName (IfaceClassOp n _ _) = n

626
instance HasOccName IfaceClassOp where
627 628 629 630
  occName = getOccName

instance NamedThing IfaceConDecl where
  getName = ifConName
631

632
instance HasOccName IfaceConDecl where
633 634 635 636
  occName = getOccName

instance NamedThing IfaceDecl where
  getName = ifName
637

638
instance HasOccName IfaceDecl where
639
  occName = getOccName
640

641
instance Outputable IfaceDecl where
642
  ppr = pprIfaceDecl showToIface
643

644 645 646 647 648 649 650 651 652
{-
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.
-}

653 654
data ShowSub
  = ShowSub
655 656 657 658 659 660
      { 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))
661 662

data ShowHowMuch
663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685
  = 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.
-}
686

687
instance Outputable ShowHowMuch where
688 689 690 691 692 693 694
  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 }
695

696 697 698
showToIface :: ShowSub
showToIface = ShowSub { ss_how_much = ShowIface
                      , ss_forall = ShowForAllWhen }
699 700 701

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

704 705
-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
706 707 708
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc
ppShowAllSubs _                                         _   = Outputable.empty
709

710
ppShowRhs :: ShowSub -> SDoc -> SDoc
711 712
ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty
ppShowRhs _                                        doc = doc
713 714

showSub :: HasOccName n => ShowSub -> n -> Bool
715 716
showSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
717
showSub (ShowSub { ss_how_much = _ })              _     = True
718

719 720 721 722 723 724 725
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)
726
    go Nothing    (False, so_far) = (True, text "..." : so_far)
727 728 729 730 731

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

732 733 734 735 736 737 738
pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
pprClassRoles ss clas binders roles =
    pprRoles (== Nominal)
             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
             binders
             roles

739 740 741 742 743 744 745 746
pprClassStandaloneKindSig :: ShowSub -> IfaceTopBndr -> IfaceKind -> SDoc
pprClassStandaloneKindSig ss clas =
  pprStandaloneKindSig (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))

constraintIfaceKind :: IfaceKind
constraintIfaceKind =
  IfaceTyConApp (IfaceTyCon constraintKindTyConName (IfaceTyConInfo NotPromoted IfaceNormalTyCon)) IA_Nil

747
pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
748 749
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
750
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
Edward Z. Yang's avatar
Edward Z. Yang committed
751
                             ifCtxt = context, ifResKind = kind,
752
                             ifRoles = roles, ifCons = condecls,
Edward Z. Yang's avatar
Edward Z. Yang committed
753
                             ifParent = parent,
754
                             ifGadtSyntax = gadt,
755
                             ifBinders = binders })
756

757
  | gadt      = vcat [ pp_roles
758
                     , pp_ki_sig
Edward Z. Yang's avatar
Edward Z. Yang committed
759
                     , pp_nd <+> pp_lhs <+> pp_kind <+> pp_where
760 761 762
                     , nest 2 (vcat pp_cons)
                     , nest 2 $ ppShowIface ss pp_extra ]
  | otherwise = vcat [ pp_roles
763
                     , pp_ki_sig
764
                     , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
765
                     , nest 2 $ ppShowIface ss pp_extra ]
766 767
  where
    is_data_instance = isIfaceDataInstance parent
768
    -- See Note [Printing foralls in type family instances] in GHC.Iface.Type
769 770 771 772 773
    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]
774 775

    cons       = visibleIfConDecls condecls
776
    pp_where   = ppWhen (gadt && not (null cons)) $ text "where"
777
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]
778 779 780 781 782 783 784
    pp_kind    = ppUnless (if ki_sig_printable
                              then isIfaceTauType kind
                                      -- Even in the presence of a standalone kind signature, a non-tau
                                      -- result kind annotation cannot be discarded as it determines the arity.
                                      -- See Note [Arity inference in kcDeclHeader_sig] in TcHsType
                              else isIfaceLiftedTypeKind kind)
                          (dcolon <+> ppr kind)
785 786

    pp_lhs = case parent of
787
               IfNoParent -> pprIfaceDeclHead suppress_bndr_sig context ss tycon binders
788 789 790
               IfDataInstance{}
                          -> text "instance" <+> pp_data_inst_forall
                                             <+> pprIfaceTyConParent parent
791 792

    pp_roles
793
      | is_data_instance = empty
794
      | otherwise        = pprRoles (== Representational) name_doc binders roles
795
            -- Don't display roles for data family instances (yet)
796
            -- See discussion on #8672.
797

798 799 800 801 802 803 804 805 806 807 808 809 810 811
    ki_sig_printable =
      -- If we print a standalone kind signature for a data instance, we leak
      -- the internal constructor name:
      --
      --    type T15827.R:Dka :: forall k. k -> *
      --    data instance forall k (a :: k). D a = MkD (Proxy a)
      --
      -- This T15827.R:Dka is a compiler-generated type constructor for the
      -- data instance.
      not is_data_instance

    pp_ki_sig = ppWhen ki_sig_printable $
                pprStandaloneKindSig name_doc (mkIfaceTyConKind binders kind)

812
    -- See Note [Suppressing binder signatures] in GHC.Iface.Type
813 814 815 816
    suppress_bndr_sig = SuppressBndrSig ki_sig_printable

    name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tycon)

817
    add_bars []     = Outputable.empty
818
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
819

820
    ok_con dc = showSub ss dc || any (showSub ss . flSelector) (ifConFields dc)
821 822

    show_con dc
823
      | ok_con dc = Just $ pprIfaceConDecl ss gadt tycon binders parent dc
824
      | otherwise = Nothing
825

826
    pp_nd = case condecls of
827
              IfAbstractTyCon{} -> text "data"
828 829
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
830

Edward Z. Yang's avatar
Edward Z. Yang committed
831
    pp_extra = vcat [pprCType ctype]
832

833
pprIfaceDecl ss (IfaceClass { ifName  = clas
834
                            , ifRoles = roles
835 836 837 838
                            , ifFDs    = fds
                            , ifBinders = binders
                            , ifBody = IfAbstractClass })
  = vcat [ pprClassRoles ss clas binders roles
839 840 841
         , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind)
         , text "class" <+> pprIfaceDeclHead suppress_bndr_sig [] ss clas binders <+> pprFundeps fds ]
  where
842
    -- See Note [Suppressing binder signatures] in GHC.Iface.Type
843
    suppress_bndr_sig = SuppressBndrSig True
844 845 846 847 848 849 850 851 852 853 854 855

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
856 857
         , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind)
         , text "class" <+> pprIfaceDeclHead suppress_bndr_sig context ss clas binders <+> pprFundeps fds <+> pp_where
Edward Z. Yang's avatar
Edward Z. Yang committed
858
         , nest 2 (vcat [ vcat asocs, vcat dsigs
859
                        , ppShowAllSubs ss (pprMinDef minDef)])]
860
    where
861
      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
862 863 864 865 866 867 868 869 870 871 872 873 874 875

      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

876 877
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
878
        text "{-# MINIMAL" <+>
879 880
        pprBooleanFormula
          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
881
        text "#-}"
882

883
      -- See Note [Suppressing binder signatures] in GHC.Iface.Type
884 885
      suppress_bndr_sig = SuppressBndrSig True

886
pprIfaceDecl ss (IfaceSynonym { ifName    = tc
887
                              , ifBinders = binders
888
                              , ifSynRhs  = mono_ty
889
                              , ifResKind = res_kind})
890 891 892 893 894
  = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind)
         , hang (text "type" <+> pprIfaceDeclHead suppress_bndr_sig [] ss tc binders <+> equals)
           2 (sep [ pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau
                  , ppUnless (isIfaceLiftedTypeKind res_kind) (dcolon <+> ppr res_kind) ])
         ]
895
  where
896
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
897 898
    name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tc)