IfaceSyn.hs 81.7 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 44
    ) where

#include "HsVersions.h"

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

71
import Control.Monad
72
import System.IO.Unsafe
73
import Data.Maybe (isJust)
74

75 76
infixl 3 &&&

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

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

98 99 100 101 102 103 104 105 106 107
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
108
data IfaceDecl
109
  = IfaceId { ifName      :: IfaceTopBndr,
dterei's avatar
dterei committed
110 111 112 113
              ifType      :: IfaceType,
              ifIdDetails :: IfaceIdDetails,
              ifIdInfo    :: IfaceIdInfo }

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

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

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

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

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

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

169 170 171 172 173 174 175 176 177 178 179
-- 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
180

181 182 183 184 185
data IfaceTyConParent
  = IfNoParent
  | IfDataInstance IfExtName
                   IfaceTyCon
                   IfaceTcArgs
186

187
data IfaceFamTyConFlav
188 189
  = IfaceDataFamilyTyCon                      -- Data family
  | IfaceOpenSynFamilyTyCon
190 191 192
  | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))
    -- ^ Name of associated axiom and branches for pretty printing purposes,
    -- or 'Nothing' for an empty closed family without an axiom
193
  | IfaceAbstractClosedSynFamilyTyCon
194
  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
195

196 197 198 199 200
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
201
                 -- and the default method, are *not* quantified
202
                 -- over the class variables
203

204 205 206 207
data IfaceAT = IfaceAT  -- See Class.ClassATItem
                  IfaceDecl          -- The associated type declaration
                  (Maybe IfaceType)  -- Default associated type instance, if any

208

209
-- This is just like CoAxBranch
210 211 212 213 214 215
data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars   :: [IfaceTvBndr]
                                   , ifaxbCoVars   :: [IfaceIdBndr]
                                   , ifaxbLHS      :: IfaceTcArgs
                                   , ifaxbRoles    :: [Role]
                                   , ifaxbRHS      :: IfaceType
                                   , ifaxbIncomps  :: [BranchIndex] }
216
                                     -- See Note [Storing compatibility] in CoAxiom
217

218
data IfaceConDecls
219
  = IfAbstractTyCon     -- c.f TyCon.AbstractTyCon
220 221
  | IfDataTyCon [IfaceConDecl] -- Data type decls
  | IfNewTyCon  IfaceConDecl   -- Newtype decls
Adam Gundry's avatar
Adam Gundry committed
222 223 224

-- For IfDataTyCon and IfNewTyCon we store:
--  * the data constructor(s);
225 226 227
-- 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)
228

dterei's avatar
dterei committed
229
data IfaceConDecl
230
  = IfCon {
231
        ifConName    :: IfaceTopBndr,                -- Constructor name
dterei's avatar
dterei committed
232 233
        ifConWrapper :: Bool,                   -- True <=> has a wrapper
        ifConInfix   :: Bool,                   -- True <=> declared infix
234 235 236 237 238 239 240

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

241
        ifConExTvs   :: [IfaceForAllBndr],  -- Existential tyvars (w/ visibility)
242 243 244
        ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints
        ifConCtxt    :: IfaceContext,       -- Non-stupid context
        ifConArgTys  :: [IfaceType],        -- Arg types
245
        ifConFields  :: [FieldLabel],  -- ...ditto... (field labels)
246 247 248 249 250
        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
251

252
type IfaceEqSpec = [(IfLclName,IfaceType)]
253

254 255 256
-- | This corresponds to an HsImplBang; that is, the final
-- implementation decision about the data constructor arg
data IfaceBang
257 258
  = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion

259 260 261 262
-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

263 264 265 266 267
data IfaceClsInst
  = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
                   ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
                   ifDFun     :: IfExtName,                -- The dfun
                   ifOFlag    :: OverlapFlag,              -- Overlap flag
268
                   ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv
dterei's avatar
dterei committed
269 270 271 272 273 274
        -- 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
275

276
-- The ifFamInstTys field of IfaceFamInst contains a list of the rough
277
-- match types
278
data IfaceFamInst
279
  = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name
280
                 , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above
281
                 , ifFamInstAxiom    :: IfExtName            -- The axiom
282
                 , ifFamInstOrph     :: IsOrphan             -- Just like IfaceClsInst
dterei's avatar
dterei committed
283
                 }
284

285
data IfaceRule
dterei's avatar
dterei committed
286 287 288 289 290 291 292 293
  = 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,
294
        ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst
295 296
    }

297 298 299
data IfaceAnnotation
  = IfaceAnnotation {
        ifAnnotatedTarget :: IfaceAnnTarget,
300
        ifAnnotatedValue  :: AnnPayload
301 302 303 304
  }

type IfaceAnnTarget = AnnTarget OccName

305 306
data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName

307 308 309 310
instance Outputable IfaceCompleteMatch where
  ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls
                                                    <+> dcolon <+> ppr ty

311 312 313



314
-- Here's a tricky case:
315 316
--   * Compile with -O module A, and B which imports A.f
--   * Change function f in A, and recompile without -O
317
--   * When we read in old A.hi we read in its IdInfo (as a thunk)
dterei's avatar
dterei committed
318 319 320
--      (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
321
--   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
dterei's avatar
dterei committed
322
--      and so gives a new version.
323

324 325 326 327
data IfaceIdInfo
  = NoInfo                      -- When writing interface file without -O
  | HasInfo [IfaceInfoItem]     -- Has info, and here it is

328
data IfaceInfoItem
329 330 331 332 333
  = HsArity         Arity
  | HsStrictness    StrictSig
  | HsInline        InlinePragma
  | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true
                    IfaceUnfolding   -- See Note [Expose recursive functions]
334
  | HsNoCafRefs
Richard Eisenberg's avatar
Richard Eisenberg committed
335
  | HsLevity                         -- Present <=> never levity polymorphic
336

337 338 339
-- 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
340
data IfaceUnfolding
341
  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
342 343
                                -- Possibly could eliminate the Bool here, the information
                                -- is also in the InlinePragma.
344

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

347
  | IfInlineRule Arity          -- INLINE pragmas
dterei's avatar
dterei committed
348 349 350
                 Bool           -- OK to inline even if *un*-saturated
                 Bool           -- OK to inline even if context is boring
                 IfaceExpr
351

352
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
353

354

355 356 357 358
-- 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
359

360 361
data IfaceIdDetails
  = IfVanillaId
Matthew Pickering's avatar
Matthew Pickering committed
362
  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
363
  | IfDFunId
364

Austin Seipp's avatar
Austin Seipp committed
365
{-
366 367
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
368
See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
369

370

Austin Seipp's avatar
Austin Seipp committed
371 372
************************************************************************
*                                                                      *
373
                Functions over declarations
Austin Seipp's avatar
Austin Seipp committed
374 375 376
*                                                                      *
************************************************************************
-}
377 378

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
379
visibleIfConDecls IfAbstractTyCon  = []
380
visibleIfConDecls (IfDataTyCon cs) = cs
381
visibleIfConDecls (IfNewTyCon c)   = [c]
382

383
ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
384 385 386
--  *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
387
-- See Note [Implicit TyThings] in HscTypes
388

389 390 391 392 393
-- 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.
394

395
ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })
396
  = case cons of
397
      IfAbstractTyCon -> []
398 399
      IfNewTyCon  cd  -> mkNewTyCoOcc (occName tc_name) : ifaceConDeclImplicitBndrs cd
      IfDataTyCon cds -> concatMap ifaceConDeclImplicitBndrs cds
400

401 402 403 404 405 406 407 408 409
ifaceDeclImplicitBndrs (IfaceClass { ifBody = IfAbstractClass })
  = []

ifaceDeclImplicitBndrs (IfaceClass { ifName = cls_tc_name
                                   , ifBody = IfConcreteClass {
                                        ifClassCtxt = sc_ctxt,
                                        ifSigs      = sigs,
                                        ifATs       = ats
                                     }})
batterseapower's avatar
batterseapower committed
410
  = --   (possibly) newtype coercion
411 412 413 414 415 416
    co_occs ++
    --    data constructor (DataCon namespace)
    --    data worker (Id namespace)
    --    no wrapper (class dictionaries never have a wrapper)
    [dc_occ, dcww_occ] ++
    -- associated types
417
    [occName (ifName at) | IfaceAT at _ <- ats ] ++
418
    -- superclass selectors
batterseapower's avatar
batterseapower committed
419
    [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
420
    -- operation selectors
421
    [occName op | IfaceClassOp op  _ _ <- sigs]
422
  where
423
    cls_tc_occ = occName cls_tc_name
424 425
    n_ctxt = length sc_ctxt
    n_sigs = length sigs
batterseapower's avatar
batterseapower committed
426
    co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
dterei's avatar
dterei committed
427
            | otherwise  = []
428
    dcww_occ = mkDataConWorkerOcc dc_occ
batterseapower's avatar
batterseapower committed
429
    dc_occ = mkClassDataConOcc cls_tc_occ
430
    is_newtype = n_sigs + n_ctxt == 1 -- Sigh (keep this synced with buildClass)
431

432
ifaceDeclImplicitBndrs _ = []
433

434
ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
435 436
ifaceConDeclImplicitBndrs (IfCon {
        ifConWrapper = has_wrapper, ifConName = con_name })
437
  = [occName con_name, work_occ] ++ wrap_occs
438
  where
439
    con_occ = occName con_name
440 441 442 443
    work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace
    wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace
              | otherwise   = []

444 445 446 447 448 449 450 451 452
-- -----------------------------------------------------------------------------
-- 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
453
  = (getOccName decl, hash) :
454 455 456 457 458 459
    [ (occ, computeFingerprint' (hash,occ))
    | occ <- ifaceDeclImplicitBndrs decl ]
  where
     computeFingerprint' =
       unsafeDupablePerformIO
        . computeFingerprint (panic "ifaceDeclFingerprints")
460

Austin Seipp's avatar
Austin Seipp committed
461 462 463
{-
************************************************************************
*                                                                      *
464
                Expressions
Austin Seipp's avatar
Austin Seipp committed
465 466 467
*                                                                      *
************************************************************************
-}
468 469 470 471 472 473

data IfaceExpr
  = IfaceLcl    IfLclName
  | IfaceExt    IfExtName
  | IfaceType   IfaceType
  | IfaceCo     IfaceCoercion
474
  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
475
  | IfaceLam    IfaceLamBndr IfaceExpr
476 477
  | IfaceApp    IfaceExpr IfaceExpr
  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
478
  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
479
  | IfaceLet    IfaceBinding  IfaceExpr
480 481 482 483 484 485 486 487
  | 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
488
  | IfaceSource  RealSrcSpan String        -- from SourceNote
489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506
  -- 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
507 508 509 510
data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo

data IfaceJoinInfo = IfaceNotJoinPoint
                   | IfaceJoinPoint JoinArity
511

Austin Seipp's avatar
Austin Seipp committed
512
{-
513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536
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


Austin Seipp's avatar
Austin Seipp committed
537 538
************************************************************************
*                                                                      *
539
              Printing IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
540 541 542
*                                                                      *
************************************************************************
-}
543 544 545 546 547 548

pprAxBranch :: SDoc -> IfaceAxBranch -> SDoc
-- 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
pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
549 550 551 552 553
                                 , ifaxbCoVars = cvs
                                 , ifaxbLHS = pat_tys
                                 , ifaxbRHS = rhs
                                 , ifaxbIncomps = incomps })
  = hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))
554 555 556
    $+$
    nest 2 maybe_incomps
  where
557 558
    ppr_binders
      | null tvs && null cvs = empty
Ben Gamari's avatar
Ben Gamari committed
559 560
      | null cvs
      = brackets (pprWithCommas (pprIfaceTvBndr True) tvs)
561
      | otherwise
Ben Gamari's avatar
Ben Gamari committed
562
      = brackets (pprWithCommas (pprIfaceTvBndr True) tvs <> semi <+>
563
                  pprWithCommas pprIfaceIdBndr cvs)
564 565
    pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
    maybe_incomps = ppUnless (null incomps) $ parens $
566
                    text "incompatible indices:" <+> ppr incomps
567 568 569 570

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

571 572 573
instance NamedThing IfaceClassOp where
  getName (IfaceClassOp n _ _) = n

574
instance HasOccName IfaceClassOp where
575 576 577 578
  occName = getOccName

instance NamedThing IfaceConDecl where
  getName = ifConName
579

580
instance HasOccName IfaceConDecl where
581 582 583 584
  occName = getOccName

instance NamedThing IfaceDecl where
  getName = ifName
585

586
instance HasOccName IfaceDecl where
587
  occName = getOccName
588

589
instance Outputable IfaceDecl where
590
  ppr = pprIfaceDecl showToIface
591

592 593 594 595 596 597 598 599 600
{-
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.
-}

601 602
data ShowSub
  = ShowSub
603 604 605 606 607 608
      { 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))
609 610

data ShowHowMuch
611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633
  = 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.
-}
634

635
instance Outputable ShowHowMuch where
636 637 638 639 640 641 642
  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 }
643

644 645 646
showToIface :: ShowSub
showToIface = ShowSub { ss_how_much = ShowIface
                      , ss_forall = ShowForAllWhen }
647 648 649

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

652 653
-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
654 655 656
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc
ppShowAllSubs _                                         _   = Outputable.empty
657

658
ppShowRhs :: ShowSub -> SDoc -> SDoc
659 660
ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty
ppShowRhs _                                        doc = doc
661 662

showSub :: HasOccName n => ShowSub -> n -> Bool
663 664
showSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
665
showSub (ShowSub { ss_how_much = _ })              _     = True
666

667 668 669 670 671 672 673
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)
674
    go Nothing    (False, so_far) = (True, text "..." : so_far)
675 676 677 678 679

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

680 681 682 683 684 685 686
pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
pprClassRoles ss clas binders roles =
    pprRoles (== Nominal)
             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
             binders
             roles

687
pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
688 689
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
690
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
691
                             ifCtxt = context,
692
                             ifRoles = roles, ifCons = condecls,
Edward Z. Yang's avatar
Edward Z. Yang committed
693
                             ifParent = parent,
694
                             ifGadtSyntax = gadt,
695
                             ifBinders = binders })
696 697 698 699 700 701 702 703 704 705 706 707 708

  | gadt_style = vcat [ pp_roles
                      , pp_nd <+> pp_lhs <+> pp_where
                      , nest 2 (vcat pp_cons)
                      , nest 2 $ ppShowIface ss pp_extra ]
  | otherwise  = vcat [ pp_roles
                      , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
                      , nest 2 $ ppShowIface ss pp_extra ]
  where
    is_data_instance = isIfaceDataInstance parent

    gadt_style = gadt || any (not . isVanillaIfaceConDecl) cons
    cons       = visibleIfConDecls condecls
709
    pp_where   = ppWhen (gadt_style && not (null cons)) $ text "where"
710 711 712
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]

    pp_lhs = case parent of
713
               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing
714
               _          -> text "instance" <+> pprIfaceTyConParent parent
715 716

    pp_roles
717 718
      | is_data_instance = empty
      | otherwise        = pprRoles (== Representational)
719 720 721
                                    (pprPrefixIfDeclBndr
                                        (ss_how_much ss)
                                        (occName tycon))
722
                                    binders roles
723 724 725
            -- Don't display roles for data family instances (yet)
            -- See discussion on Trac #8672.

726
    add_bars []     = Outputable.empty
727
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
728

729
    ok_con dc = showSub ss dc || any (showSub ss . flSelector) (ifConFields dc)
730 731

    show_con dc
732
      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style tycon binders parent dc
733
      | otherwise = Nothing
734

735
    pp_nd = case condecls of
736
              IfAbstractTyCon{} -> text "data"
737 738
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
739

Edward Z. Yang's avatar
Edward Z. Yang committed
740
    pp_extra = vcat [pprCType ctype]
741

742
pprIfaceDecl ss (IfaceClass { ifName  = clas
743
                            , ifRoles = roles
744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761
                            , 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
762
         , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
763
                                <+> pprFundeps fds <+> pp_where
Edward Z. Yang's avatar
Edward Z. Yang committed
764
         , nest 2 (vcat [ vcat asocs, vcat dsigs
765
                        , ppShowAllSubs ss (pprMinDef minDef)])]
766
    where
767
      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
768 769 770 771 772 773 774 775 776 777 778 779 780 781

      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

782 783
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
784
        text "{-# MINIMAL" <+>
785 786
        pprBooleanFormula
          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
787
        text "#-}"
788

789
pprIfaceDecl ss (IfaceSynonym { ifName    = tc
790
                              , ifBinders = binders
791
                              , ifSynRhs  = mono_ty
792 793 794 795
                              , ifResKind = res_kind})
  = hang (text "type" <+> pprIfaceDeclHead [] ss tc binders Nothing <+> equals)
       2 (sep [ pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau
              , ppUnless (isIfaceLiftedTypeKind res_kind) (dcolon <+> ppr res_kind) ])
796
  where
797
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
798

799 800 801
pprIfaceDecl ss (IfaceFamily { ifName = tycon
                             , ifFamFlav = rhs, ifBinders = binders
                             , ifResKind = res_kind
Jan Stolarek's avatar
Jan Stolarek committed
802
                             , ifResVar = res_var, ifFamInj = inj })
803
  | IfaceDataFamilyTyCon <- rhs
804
  = text "data family" <+> pprIfaceDeclHead [] ss tycon binders Nothing
805 806

  | otherwise
807
  = hang (text "type family" <+> pprIfaceDeclHead [] ss tycon binders (Just res_kind))
808 809
       2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
    $$
810
    nest 2 (ppShowRhs ss (pp_branches rhs))
811
  where
812
    pp_inj Nothing    _   = empty
Jan Stolarek's avatar
Jan Stolarek committed
813
    pp_inj (Just res) inj
814
       | Injective injectivity <- inj = hsep [ equals, ppr res
Jan Stolarek's avatar
Jan Stolarek committed
815
                                             , pp_inj_cond res injectivity]
816
       | otherwise = hsep [ equals, ppr res ]
Jan Stolarek's avatar
Jan Stolarek committed
817

818
    pp_inj_cond res inj = case filterByList inj binders of
Jan Stolarek's avatar
Jan Stolarek committed
819
       []  -> empty
820
       tvs -> hsep [vbar, ppr res, text "->", interppSP (map ifTyConBinderName tvs)]
Jan Stolarek's avatar
Jan Stolarek committed
821

822
    pp_rhs IfaceDataFamilyTyCon
823
      = ppShowIface ss (text "data")
824
    pp_rhs IfaceOpenSynFamilyTyCon