IfaceSyn.hs 83.2 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-}
5

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 Demand
Simon Marlow's avatar
Simon Marlow committed
51
import Class
Adam Gundry's avatar
Adam Gundry committed
52
import FieldLabel
dterei's avatar
dterei committed
53
import NameSet
Adam Gundry's avatar
Adam Gundry committed
54
import CoAxiom ( BranchIndex )
Simon Marlow's avatar
Simon Marlow committed
55 56 57 58
import Name
import CostCentre
import Literal
import ForeignCall
59
import Annotations( AnnPayload, AnnTarget )
60
import BasicTypes
61
import Outputable
62
import Module
Peter Wortmann's avatar
Peter Wortmann committed
63
import SrcLoc
64 65
import Fingerprint
import Binary
66
import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
67
import Var( TyVarBndr(..) )
68
import TyCon ( Role (..), Injectivity(..) )
Jan Stolarek's avatar
Jan Stolarek committed
69
import Util( filterOut, filterByList )
70
import DataCon (SrcStrictness(..), SrcUnpackedness(..))
71
import Lexeme (isLexSym)
72
import DynFlags
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 90
-- | 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
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
Gergő Érdi's avatar
Gergő Érdi 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],
Gergő Érdi's avatar
Gergő Érdi committed
165 166
                  ifPatProvCtxt   :: IfaceContext,
                  ifPatReqCtxt    :: IfaceContext,
167
                  ifPatArgs       :: [IfaceType],
Matthew Pickering's avatar
Matthew Pickering committed
168 169
                  ifPatTy         :: IfaceType,
                  ifFieldLabels   :: [FieldLabel] }
Gergő Érdi's avatar
Gergő Érdi 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
    }
Gergő Érdi's avatar
Gergő Érdi committed
182

183 184 185 186 187
data IfaceTyConParent
  = IfNoParent
  | IfDataInstance IfExtName
                   IfaceTyCon
                   IfaceTcArgs
188

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

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

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

210

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

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

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

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

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

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

254
type IfaceEqSpec = [(IfLclName,IfaceType)]
255

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

261 262 263 264
-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

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

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

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

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

type IfaceAnnTarget = AnnTarget OccName

307 308
data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName

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

313 314 315



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

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

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

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

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

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

354
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
355

356

357 358 359 360
-- 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
361

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

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

372

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

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

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

391 392 393 394 395
-- 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.
396

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

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

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

434
ifaceDeclImplicitBndrs _ = []
435

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

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

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

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

data IfaceJoinInfo = IfaceNotJoinPoint
                   | IfaceJoinPoint JoinArity
513

Austin Seipp's avatar
Austin Seipp committed
514
{-
515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538
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
539 540
************************************************************************
*                                                                      *
541
              Printing IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
542 543 544
*                                                                      *
************************************************************************
-}
545 546 547 548 549 550

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
551 552 553 554 555
                                 , ifaxbCoVars = cvs
                                 , ifaxbLHS = pat_tys
                                 , ifaxbRHS = rhs
                                 , ifaxbIncomps = incomps })
  = hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))
556 557 558
    $+$
    nest 2 maybe_incomps
  where
559 560 561 562
    ppr_binders = sdocWithDynFlags $ \dflags ->
                  ppWhen (gopt Opt_PrintExplicitForalls dflags) ppr_binders'

    ppr_binders'
563
      | null tvs && null cvs = empty
Ben Gamari's avatar
Ben Gamari committed
564 565
      | null cvs
      = brackets (pprWithCommas (pprIfaceTvBndr True) tvs)
566
      | otherwise
Ben Gamari's avatar
Ben Gamari committed
567
      = brackets (pprWithCommas (pprIfaceTvBndr True) tvs <> semi <+>
568
                  pprWithCommas pprIfaceIdBndr cvs)
569 570
    pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
    maybe_incomps = ppUnless (null incomps) $ parens $
571
                    text "incompatible indices:" <+> ppr incomps
572 573 574 575

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

576 577 578
instance NamedThing IfaceClassOp where
  getName (IfaceClassOp n _ _) = n

579
instance HasOccName IfaceClassOp where
580 581 582 583
  occName = getOccName

instance NamedThing IfaceConDecl where
  getName = ifConName
584

585
instance HasOccName IfaceConDecl where
586 587 588 589
  occName = getOccName

instance NamedThing IfaceDecl where
  getName = ifName
590

591
instance HasOccName IfaceDecl where
592
  occName = getOccName
593

594
instance Outputable IfaceDecl where
595
  ppr = pprIfaceDecl showToIface
596

597 598 599 600 601 602 603 604 605
{-
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.
-}

606 607
data ShowSub
  = ShowSub
608 609 610 611 612 613
      { 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))
614 615

data ShowHowMuch
616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638
  = 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.
-}
639

640
instance Outputable ShowHowMuch where
641 642 643 644 645 646 647
  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 }
648

649 650 651
showToIface :: ShowSub
showToIface = ShowSub { ss_how_much = ShowIface
                      , ss_forall = ShowForAllWhen }
652 653 654

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

657 658
-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
659 660 661
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc
ppShowAllSubs _                                         _   = Outputable.empty
662

663
ppShowRhs :: ShowSub -> SDoc -> SDoc
664 665
ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty
ppShowRhs _                                        doc = doc
666 667

showSub :: HasOccName n => ShowSub -> n -> Bool
668 669
showSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
670
showSub (ShowSub { ss_how_much = _ })              _     = True
671

672 673 674 675 676 677 678
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)
679
    go Nothing    (False, so_far) = (True, text "..." : so_far)
680 681 682 683 684

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

685 686 687 688 689 690 691
pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
pprClassRoles ss clas binders roles =
    pprRoles (== Nominal)
             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
             binders
             roles

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

702 703 704 705 706 707 708
  | gadt      = 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 ]
709 710 711 712
  where
    is_data_instance = isIfaceDataInstance parent

    cons       = visibleIfConDecls condecls
713
    pp_where   = ppWhen (gadt && not (null cons)) $ text "where"
714 715 716
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]

    pp_lhs = case parent of
717
               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing
718
               _          -> text "instance" <+> pprIfaceTyConParent parent
719 720

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

730
    add_bars []     = Outputable.empty
731
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
732

733
    ok_con dc = showSub ss dc || any (showSub ss . flSelector) (ifConFields dc)
734 735

    show_con dc
736
      | ok_con dc = Just $ pprIfaceConDecl ss gadt tycon binders parent dc
737
      | otherwise = Nothing
738

739
    pp_nd = case condecls of
740
              IfAbstractTyCon{} -> text "data"
741 742
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
743

Edward Z. Yang's avatar
Edward Z. Yang committed
744
    pp_extra = vcat [pprCType ctype]
745

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

      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

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

793
pprIfaceDecl ss (IfaceSynonym { ifName    = tc
794
                              , ifBinders = binders
795
                              , ifSynRhs  = mono_ty
796 797 798 799
                              , 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) ])
800
  where
801
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
802

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

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

822
    pp_inj_cond res inj = case filterByList inj binders of
Jan Stolarek's avatar
Jan Stolarek committed
823
       []  -> empty