IfaceSyn.hs 77.5 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 19 20
        IfaceBang(..),
        IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),
        IfaceAxBranch(..),
21
        IfaceTyConParent(..),
22
        IfaceCompleteMatch(..),
23

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

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

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

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

#include "HsVersions.h"

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

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

74 75
infixl 3 &&&

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

84 85 86 87
-- | 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
88
  -- case the namespace is implied by the context. However, having an
89 90 91 92
  -- 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]
93 94
  --
  -- We don't serialise the namespace onto the disk though; rather we
95 96
  -- drop it when serialising and add it back in when deserialising.

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

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

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

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

141
  | IfaceClass { ifCtxt    :: IfaceContext,             -- Superclasses
142 143
                 ifName    :: IfaceTopBndr,             -- Name of the class TyCon
                 ifRoles   :: [Role],                   -- Roles
144
                 ifBinders :: [IfaceTyConBinder],
Edward Z. Yang's avatar
Edward Z. Yang committed
145
                 ifFDs     :: [FunDep IfLclName],      -- Functional dependencies
146 147
                 ifATs     :: [IfaceAT],                -- Associated type families
                 ifSigs    :: [IfaceClassOp],           -- Method signatures
Edward Z. Yang's avatar
Edward Z. Yang committed
148
                 ifMinDef  :: BooleanFormula IfLclName  -- Minimal complete definition
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
data IfaceTyConParent
  = IfNoParent
  | IfDataInstance IfExtName
                   IfaceTyCon
                   IfaceTcArgs
177

178
data IfaceFamTyConFlav
179 180
  = IfaceDataFamilyTyCon                      -- Data family
  | IfaceOpenSynFamilyTyCon
181 182 183
  | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))
    -- ^ Name of associated axiom and branches for pretty printing purposes,
    -- or 'Nothing' for an empty closed family without an axiom
184
  | IfaceAbstractClosedSynFamilyTyCon
185
  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
186

187 188 189 190 191
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
192
                 -- and the default method, are *not* quantified
193
                 -- over the class variables
194

195 196 197 198
data IfaceAT = IfaceAT  -- See Class.ClassATItem
                  IfaceDecl          -- The associated type declaration
                  (Maybe IfaceType)  -- Default associated type instance, if any

199

200
-- This is just like CoAxBranch
201 202 203 204 205 206
data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars   :: [IfaceTvBndr]
                                   , ifaxbCoVars   :: [IfaceIdBndr]
                                   , ifaxbLHS      :: IfaceTcArgs
                                   , ifaxbRoles    :: [Role]
                                   , ifaxbRHS      :: IfaceType
                                   , ifaxbIncomps  :: [BranchIndex] }
207
                                     -- See Note [Storing compatibility] in CoAxiom
208

209
data IfaceConDecls
210
  = IfAbstractTyCon     -- c.f TyCon.AbstractTyCon
211 212
  | IfDataTyCon [IfaceConDecl] -- Data type decls
  | IfNewTyCon  IfaceConDecl   -- Newtype decls
Adam Gundry's avatar
Adam Gundry committed
213 214 215

-- For IfDataTyCon and IfNewTyCon we store:
--  * the data constructor(s);
216 217 218
-- 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)
219

dterei's avatar
dterei committed
220
data IfaceConDecl
221
  = IfCon {
222
        ifConName    :: IfaceTopBndr,                -- Constructor name
dterei's avatar
dterei committed
223 224
        ifConWrapper :: Bool,                   -- True <=> has a wrapper
        ifConInfix   :: Bool,                   -- True <=> declared infix
225 226 227 228 229 230 231

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

232
        ifConExTvs   :: [IfaceForAllBndr],  -- Existential tyvars (w/ visibility)
233 234 235
        ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints
        ifConCtxt    :: IfaceContext,       -- Non-stupid context
        ifConArgTys  :: [IfaceType],        -- Arg types
236
        ifConFields  :: [FieldLabel],  -- ...ditto... (field labels)
237 238 239 240 241
        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
242

243
type IfaceEqSpec = [(IfLclName,IfaceType)]
244

245 246 247
-- | This corresponds to an HsImplBang; that is, the final
-- implementation decision about the data constructor arg
data IfaceBang
248 249
  = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion

250 251 252 253
-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

254 255 256 257 258
data IfaceClsInst
  = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
                   ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
                   ifDFun     :: IfExtName,                -- The dfun
                   ifOFlag    :: OverlapFlag,              -- Overlap flag
259
                   ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv
dterei's avatar
dterei committed
260 261 262 263 264 265
        -- 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
266

267
-- The ifFamInstTys field of IfaceFamInst contains a list of the rough
268
-- match types
269
data IfaceFamInst
270
  = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name
271
                 , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above
272
                 , ifFamInstAxiom    :: IfExtName            -- The axiom
273
                 , ifFamInstOrph     :: IsOrphan             -- Just like IfaceClsInst
dterei's avatar
dterei committed
274
                 }
275

276
data IfaceRule
dterei's avatar
dterei committed
277 278 279 280 281 282 283 284
  = 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,
285
        ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst
286 287
    }

288 289 290
data IfaceAnnotation
  = IfaceAnnotation {
        ifAnnotatedTarget :: IfaceAnnTarget,
291
        ifAnnotatedValue  :: AnnPayload
292 293 294 295
  }

type IfaceAnnTarget = AnnTarget OccName

296 297
data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName

298 299 300 301
instance Outputable IfaceCompleteMatch where
  ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls
                                                    <+> dcolon <+> ppr ty

302 303 304



305
-- Here's a tricky case:
306 307
--   * Compile with -O module A, and B which imports A.f
--   * Change function f in A, and recompile without -O
308
--   * When we read in old A.hi we read in its IdInfo (as a thunk)
dterei's avatar
dterei committed
309 310 311
--      (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
312
--   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
dterei's avatar
dterei committed
313
--      and so gives a new version.
314

315 316 317 318
data IfaceIdInfo
  = NoInfo                      -- When writing interface file without -O
  | HasInfo [IfaceInfoItem]     -- Has info, and here it is

319
data IfaceInfoItem
320 321 322 323 324
  = HsArity         Arity
  | HsStrictness    StrictSig
  | HsInline        InlinePragma
  | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true
                    IfaceUnfolding   -- See Note [Expose recursive functions]
325
  | HsNoCafRefs
Richard Eisenberg's avatar
Richard Eisenberg committed
326
  | HsLevity                         -- Present <=> never levity polymorphic
327

328 329 330
-- 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
331
data IfaceUnfolding
332
  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
333 334
                                -- Possibly could eliminate the Bool here, the information
                                -- is also in the InlinePragma.
335

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

338
  | IfInlineRule Arity          -- INLINE pragmas
dterei's avatar
dterei committed
339 340 341
                 Bool           -- OK to inline even if *un*-saturated
                 Bool           -- OK to inline even if context is boring
                 IfaceExpr
342

343
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
344

345

346 347 348 349
-- 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
350

351 352
data IfaceIdDetails
  = IfVanillaId
Matthew Pickering's avatar
Matthew Pickering committed
353
  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
354
  | IfDFunId
355

Austin Seipp's avatar
Austin Seipp committed
356
{-
357 358
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
359
See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
360

361

Austin Seipp's avatar
Austin Seipp committed
362 363
************************************************************************
*                                                                      *
364
                Functions over declarations
Austin Seipp's avatar
Austin Seipp committed
365 366 367
*                                                                      *
************************************************************************
-}
368 369

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
370
visibleIfConDecls IfAbstractTyCon  = []
371
visibleIfConDecls (IfDataTyCon cs) = cs
372
visibleIfConDecls (IfNewTyCon c)   = [c]
373

374
ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
375 376 377
--  *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
378
-- See Note [Implicit TyThings] in HscTypes
379

380 381 382 383 384
-- 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.
385

386
ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })
387
  = case cons of
388
      IfAbstractTyCon -> []
389 390
      IfNewTyCon  cd  -> mkNewTyCoOcc (occName tc_name) : ifaceConDeclImplicitBndrs cd
      IfDataTyCon cds -> concatMap ifaceConDeclImplicitBndrs cds
391

392 393 394 395
ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt
                                   , ifName = cls_tc_name
                                   , ifSigs = sigs
                                   , ifATs = ats })
batterseapower's avatar
batterseapower committed
396
  = --   (possibly) newtype coercion
397 398 399 400 401 402
    co_occs ++
    --    data constructor (DataCon namespace)
    --    data worker (Id namespace)
    --    no wrapper (class dictionaries never have a wrapper)
    [dc_occ, dcww_occ] ++
    -- associated types
403
    [occName (ifName at) | IfaceAT at _ <- ats ] ++
404
    -- superclass selectors
batterseapower's avatar
batterseapower committed
405
    [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
406
    -- operation selectors
407
    [occName op | IfaceClassOp op  _ _ <- sigs]
408
  where
409
    cls_tc_occ = occName cls_tc_name
410 411
    n_ctxt = length sc_ctxt
    n_sigs = length sigs
batterseapower's avatar
batterseapower committed
412
    co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
dterei's avatar
dterei committed
413
            | otherwise  = []
414
    dcww_occ = mkDataConWorkerOcc dc_occ
batterseapower's avatar
batterseapower committed
415
    dc_occ = mkClassDataConOcc cls_tc_occ
dterei's avatar
dterei committed
416
    is_newtype = n_sigs + n_ctxt == 1 -- Sigh
417

418
ifaceDeclImplicitBndrs _ = []
419

420
ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
421 422
ifaceConDeclImplicitBndrs (IfCon {
        ifConWrapper = has_wrapper, ifConName = con_name })
423
  = [occName con_name, work_occ] ++ wrap_occs
424
  where
425
    con_occ = occName con_name
426 427 428 429
    work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace
    wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace
              | otherwise   = []

430 431 432 433 434 435 436 437 438
-- -----------------------------------------------------------------------------
-- 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
439
  = (getOccName decl, hash) :
440 441 442 443 444 445
    [ (occ, computeFingerprint' (hash,occ))
    | occ <- ifaceDeclImplicitBndrs decl ]
  where
     computeFingerprint' =
       unsafeDupablePerformIO
        . computeFingerprint (panic "ifaceDeclFingerprints")
446

Austin Seipp's avatar
Austin Seipp committed
447 448 449
{-
************************************************************************
*                                                                      *
450
                Expressions
Austin Seipp's avatar
Austin Seipp committed
451 452 453
*                                                                      *
************************************************************************
-}
454 455 456 457 458 459

data IfaceExpr
  = IfaceLcl    IfLclName
  | IfaceExt    IfExtName
  | IfaceType   IfaceType
  | IfaceCo     IfaceCoercion
460
  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
461
  | IfaceLam    IfaceLamBndr IfaceExpr
462 463
  | IfaceApp    IfaceExpr IfaceExpr
  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
464
  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
465
  | IfaceLet    IfaceBinding  IfaceExpr
466 467 468 469 470 471 472 473
  | 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
474
  | IfaceSource  RealSrcSpan String        -- from SourceNote
475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492
  -- 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
493 494 495 496
data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo

data IfaceJoinInfo = IfaceNotJoinPoint
                   | IfaceJoinPoint JoinArity
497

Austin Seipp's avatar
Austin Seipp committed
498
{-
499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522
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
523 524
************************************************************************
*                                                                      *
525
              Printing IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
526 527 528
*                                                                      *
************************************************************************
-}
529 530 531 532 533 534

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
535 536 537 538 539
                                 , ifaxbCoVars = cvs
                                 , ifaxbLHS = pat_tys
                                 , ifaxbRHS = rhs
                                 , ifaxbIncomps = incomps })
  = hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))
540 541 542
    $+$
    nest 2 maybe_incomps
  where
543 544
    ppr_binders
      | null tvs && null cvs = empty
Ben Gamari's avatar
Ben Gamari committed
545 546
      | null cvs
      = brackets (pprWithCommas (pprIfaceTvBndr True) tvs)
547
      | otherwise
Ben Gamari's avatar
Ben Gamari committed
548
      = brackets (pprWithCommas (pprIfaceTvBndr True) tvs <> semi <+>
549
                  pprWithCommas pprIfaceIdBndr cvs)
550 551
    pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
    maybe_incomps = ppUnless (null incomps) $ parens $
552
                    text "incompatible indices:" <+> ppr incomps
553 554 555 556

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

557 558 559
instance NamedThing IfaceClassOp where
  getName (IfaceClassOp n _ _) = n

560
instance HasOccName IfaceClassOp where
561 562 563 564
  occName = getOccName

instance NamedThing IfaceConDecl where
  getName = ifConName
565

566
instance HasOccName IfaceConDecl where
567 568 569 570
  occName = getOccName

instance NamedThing IfaceDecl where
  getName = ifName
571

572
instance HasOccName IfaceDecl where
573
  occName = getOccName
574

575
instance Outputable IfaceDecl where
576
  ppr = pprIfaceDecl showToIface
577

578 579 580 581 582 583 584 585 586
{-
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.
-}

587 588
data ShowSub
  = ShowSub
589 590 591 592 593 594
      { 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))
595 596

data ShowHowMuch
597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619
  = 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.
-}
620

621
instance Outputable ShowHowMuch where
622 623 624 625 626 627 628
  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 }
629

630 631 632
showToIface :: ShowSub
showToIface = ShowSub { ss_how_much = ShowIface
                      , ss_forall = ShowForAllWhen }
633 634 635

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

638 639
-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
640 641 642
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc
ppShowAllSubs _                                         _   = Outputable.empty
643

644
ppShowRhs :: ShowSub -> SDoc -> SDoc
645 646
ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty
ppShowRhs _                                        doc = doc
647 648

showSub :: HasOccName n => ShowSub -> n -> Bool
649 650
showSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
651
showSub (ShowSub { ss_how_much = _ })              _     = True
652

653 654 655 656 657 658 659
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)
660
    go Nothing    (False, so_far) = (True, text "..." : so_far)
661 662 663 664 665 666

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

pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
667 668
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
669
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
670
                             ifCtxt = context,
671
                             ifRoles = roles, ifCons = condecls,
Edward Z. Yang's avatar
Edward Z. Yang committed
672
                             ifParent = parent,
673
                             ifGadtSyntax = gadt,
674
                             ifBinders = binders })
675 676 677 678 679 680 681 682 683 684 685 686 687

  | 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
688
    pp_where   = ppWhen (gadt_style && not (null cons)) $ text "where"
689 690 691
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]

    pp_lhs = case parent of
692
               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing
693
               _          -> text "instance" <+> pprIfaceTyConParent parent
694 695

    pp_roles
696 697
      | is_data_instance = empty
      | otherwise        = pprRoles (== Representational)
698 699 700
                                    (pprPrefixIfDeclBndr
                                        (ss_how_much ss)
                                        (occName tycon))
701
                                    binders roles
702 703 704
            -- Don't display roles for data family instances (yet)
            -- See discussion on Trac #8672.

705
    add_bars []     = Outputable.empty
706
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
707

708
    ok_con dc = showSub ss dc || any (showSub ss . flSelector) (ifConFields dc)
709 710

    show_con dc
711
      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style tycon binders parent dc
712
      | otherwise = Nothing
713

714
    pp_nd = case condecls of
715
              IfAbstractTyCon{} -> text "data"
716 717
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
718

Edward Z. Yang's avatar
Edward Z. Yang committed
719
    pp_extra = vcat [pprCType ctype]
720

721

Edward Z. Yang's avatar
Edward Z. Yang committed
722
pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs
723
                            , ifCtxt   = context, ifName  = clas
724
                            , ifRoles = roles
725
                            , ifFDs    = fds, ifMinDef = minDef
726
                            , ifBinders = binders })
727 728 729 730 731
  = vcat [ pprRoles
             (== Nominal)
             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
             binders
             roles
732
         , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
733
                                <+> pprFundeps fds <+> pp_where
Edward Z. Yang's avatar
Edward Z. Yang committed
734
         , nest 2 (vcat [ vcat asocs, vcat dsigs
735
                        , ppShowAllSubs ss (pprMinDef minDef)])]
736
    where
737
      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
738 739 740 741 742 743 744 745 746 747 748 749 750 751

      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

752 753
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
754
        text "{-# MINIMAL" <+>
755 756
        pprBooleanFormula
          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
757
        text "#-}"
758

759
pprIfaceDecl ss (IfaceSynonym { ifName    = tc
760
                              , ifBinders = binders
761
                              , ifSynRhs  = mono_ty
762 763 764 765
                              , 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) ])
766
  where
767
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
768

769 770 771
pprIfaceDecl ss (IfaceFamily { ifName = tycon
                             , ifFamFlav = rhs, ifBinders = binders
                             , ifResKind = res_kind
Jan Stolarek's avatar
Jan Stolarek committed
772
                             , ifResVar = res_var, ifFamInj = inj })
773
  | IfaceDataFamilyTyCon <- rhs
774
  = text "data family" <+> pprIfaceDeclHead [] ss tycon binders Nothing
775 776

  | otherwise
777
  = hang (text "type family" <+> pprIfaceDeclHead [] ss tycon binders (Just res_kind))
778 779
       2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
    $$
780
    nest 2 (ppShowRhs ss (pp_branches rhs))
781
  where
782
    pp_inj Nothing    _   = empty
Jan Stolarek's avatar
Jan Stolarek committed
783
    pp_inj (Just res) inj
784
       | Injective injectivity <- inj = hsep [ equals, ppr res
Jan Stolarek's avatar
Jan Stolarek committed
785
                                             , pp_inj_cond res injectivity]
786
       | otherwise = hsep [ equals, ppr res ]
Jan Stolarek's avatar
Jan Stolarek committed
787

788
    pp_inj_cond res inj = case filterByList inj binders of
Jan Stolarek's avatar
Jan Stolarek committed
789
       []  -> empty
790
       tvs -> hsep [vbar, ppr res, text "->", interppSP (map ifTyConBinderName tvs)]
Jan Stolarek's avatar
Jan Stolarek committed
791

792
    pp_rhs IfaceDataFamilyTyCon
793
      = ppShowIface ss (text "data")
794
    pp_rhs IfaceOpenSynFamilyTyCon
795
      = ppShowIface ss (text "open")
796
    pp_rhs IfaceAbstractClosedSynFamilyTyCon
797
      = ppShowIface ss (text "closed, abstract")
798
    pp_rhs (IfaceClosedSynFamilyTyCon {})
799
      = empty  -- see pp_branches
800
    pp_rhs IfaceBuiltInSynFamTyCon
801