IfaceSyn.hs 86.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
    ) 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( VarBndr(..), binderVar )
68
import TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )
69
import Util( dropList, filterByList )
70
import DataCon (SrcStrictness(..), SrcUnpackedness(..))
71
import Lexeme (isLexSym)
72

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

76 77
infixl 3 &&&

Austin Seipp's avatar
Austin Seipp committed
78 79 80
{-
************************************************************************
*                                                                      *
81
                    Declarations
Austin Seipp's avatar
Austin Seipp committed
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
Gabor Greif's avatar
Gabor Greif committed
89
  -- It's convenient to have a Name in the IfaceSyn, although in each
90
  -- case the namespace is implied by the context. However, having an
91 92 93 94
  -- 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]
95 96
  --
  -- We don't serialise the namespace onto the disk though; rather we
97 98
  -- drop it when serialising and add it back in when deserialising.

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

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

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

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

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

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

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

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

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

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

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

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

212

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

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

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

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

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

Ningning Xie's avatar
Ningning Xie committed
246
        ifConExTCvs   :: [IfaceBndr],  -- Existential ty/covars
247 248 249
        ifConUserTvBinders :: [IfaceForAllBndr],
          -- The tyvars, in the order the user wrote them
          -- INVARIANT: the set of tyvars in ifConUserTvBinders is exactly the
Ningning Xie's avatar
Ningning Xie committed
250 251 252
          --            set of tyvars (*not* covars) of ifConExTCvs, unioned
          --            with the set of ifBinders (from the parent IfaceDecl)
          --            whose tyvars do not appear in ifConEqSpec
253
          -- See Note [DataCon user type variable binders] in DataCon
254 255 256
        ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints
        ifConCtxt    :: IfaceContext,       -- Non-stupid context
        ifConArgTys  :: [IfaceType],        -- Arg types
257
        ifConFields  :: [FieldLabel],  -- ...ditto... (field labels)
258 259 260 261 262
        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
263

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

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

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

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

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

297
data IfaceRule
dterei's avatar
dterei committed
298 299 300 301 302 303 304 305
  = 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,
306
        ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst
307 308
    }

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

type IfaceAnnTarget = AnnTarget OccName

317 318
data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName

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

323 324 325



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

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

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

349 350 351
-- 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
352
data IfaceUnfolding
353
  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
354 355
                                -- Possibly could eliminate the Bool here, the information
                                -- is also in the InlinePragma.
356

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

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

364
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
365

366

367 368 369 370
-- 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
371

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

Austin Seipp's avatar
Austin Seipp committed
377
{-
378 379
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
380
See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
381

382

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

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

395
ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
396 397 398
--  *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
399
-- See Note [Implicit TyThings] in HscTypes
400

401 402 403 404 405
-- 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.
406

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

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

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

444
ifaceDeclImplicitBndrs _ = []
445

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

456 457 458 459 460 461 462 463 464
-- -----------------------------------------------------------------------------
-- 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
465
  = (getOccName decl, hash) :
466 467 468 469 470 471
    [ (occ, computeFingerprint' (hash,occ))
    | occ <- ifaceDeclImplicitBndrs decl ]
  where
     computeFingerprint' =
       unsafeDupablePerformIO
        . computeFingerprint (panic "ifaceDeclFingerprints")
472

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

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

data IfaceJoinInfo = IfaceNotJoinPoint
                   | IfaceJoinPoint JoinArity
523

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

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

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

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


Austin Seipp's avatar
Austin Seipp committed
549 550
************************************************************************
*                                                                      *
551
              Printing IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
552 553 554
*                                                                      *
************************************************************************
-}
555 556 557 558 559

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
560 561 562 563 564 565
--
-- This function is used
--    to print interface files,
--    in debug messages
--    in :info F for GHCi, which goes via toConToIfaceDecl on the family tycon
-- For user error messages we use Coercion.pprCoAxiom and friends
566
pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
567
                                 , ifaxbCoVars = _cvs
568 569 570
                                 , ifaxbLHS = pat_tys
                                 , ifaxbRHS = rhs
                                 , ifaxbIncomps = incomps })
571 572
  = WARN( not (null _cvs), pp_tc $$ ppr _cvs )
    hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))
573 574 575
    $+$
    nest 2 maybe_incomps
  where
576 577
    -- See Note [Printing foralls in type family instances] in IfaceType
    ppr_binders = pprUserIfaceForAll $ map (mkIfaceForAllTvBndr Specified) tvs
578
    pp_lhs = hang pp_tc 2 (pprParendIfaceAppArgs pat_tys)
579
    maybe_incomps = ppUnless (null incomps) $ parens $
580
                    text "incompatible indices:" <+> ppr incomps
581 582 583 584

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

585 586 587
instance NamedThing IfaceClassOp where
  getName (IfaceClassOp n _ _) = n

588
instance HasOccName IfaceClassOp where
589 590 591 592
  occName = getOccName

instance NamedThing IfaceConDecl where
  getName = ifConName
593

594
instance HasOccName IfaceConDecl where
595 596 597 598
  occName = getOccName

instance NamedThing IfaceDecl where
  getName = ifName
599

600
instance HasOccName IfaceDecl where
601
  occName = getOccName
602

603
instance Outputable IfaceDecl where
604
  ppr = pprIfaceDecl showToIface
605

606 607 608 609 610 611 612 613 614
{-
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.
-}

615 616
data ShowSub
  = ShowSub
617 618 619 620 621 622
      { 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))
623 624

data ShowHowMuch
625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647
  = 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.
-}
648

649
instance Outputable ShowHowMuch where
650 651 652 653 654 655 656
  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 }
657

658 659 660
showToIface :: ShowSub
showToIface = ShowSub { ss_how_much = ShowIface
                      , ss_forall = ShowForAllWhen }
661 662 663

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

666 667
-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
668 669 670
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc
ppShowAllSubs _                                         _   = Outputable.empty
671

672
ppShowRhs :: ShowSub -> SDoc -> SDoc
673 674
ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty
ppShowRhs _                                        doc = doc
675 676

showSub :: HasOccName n => ShowSub -> n -> Bool
677 678
showSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
679
showSub (ShowSub { ss_how_much = _ })              _     = True
680

681 682 683 684 685 686 687
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)
688
    go Nothing    (False, so_far) = (True, text "..." : so_far)
689 690 691 692 693

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

694 695 696 697 698 699 700
pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
pprClassRoles ss clas binders roles =
    pprRoles (== Nominal)
             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
             binders
             roles

701
pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
702 703
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
704
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
Edward Z. Yang's avatar
Edward Z. Yang committed
705
                             ifCtxt = context, ifResKind = kind,
706
                             ifRoles = roles, ifCons = condecls,
Edward Z. Yang's avatar
Edward Z. Yang committed
707
                             ifParent = parent,
708
                             ifGadtSyntax = gadt,
709
                             ifBinders = binders })
710

711
  | gadt      = vcat [ pp_roles
Edward Z. Yang's avatar
Edward Z. Yang committed
712
                     , pp_nd <+> pp_lhs <+> pp_kind <+> pp_where
713 714 715
                     , nest 2 (vcat pp_cons)
                     , nest 2 $ ppShowIface ss pp_extra ]
  | otherwise = vcat [ pp_roles
716
                     , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
717
                     , nest 2 $ ppShowIface ss pp_extra ]
718 719
  where
    is_data_instance = isIfaceDataInstance parent
720 721 722 723 724 725
    -- See Note [Printing foralls in type family instances] in IfaceType
    pp_data_inst_forall :: SDoc
    pp_data_inst_forall = pprUserIfaceForAll forall_bndrs

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

    cons       = visibleIfConDecls condecls
728
    pp_where   = ppWhen (gadt && not (null cons)) $ text "where"
729
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]
Edward Z. Yang's avatar
Edward Z. Yang committed
730 731 732
    pp_kind
      | isIfaceLiftedTypeKind kind = empty
      | otherwise = dcolon <+> ppr kind
733 734

    pp_lhs = case parent of
735
               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing
736 737 738
               IfDataInstance{}
                          -> text "instance" <+> pp_data_inst_forall
                                             <+> pprIfaceTyConParent parent
739 740

    pp_roles
741 742
      | is_data_instance = empty
      | otherwise        = pprRoles (== Representational)
743 744 745
                                    (pprPrefixIfDeclBndr
                                        (ss_how_much ss)
                                        (occName tycon))
746
                                    binders roles
747
            -- Don't display roles for data family instances (yet)
748
            -- See discussion on #8672.
749

750
    add_bars []     = Outputable.empty
751
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
752

753
    ok_con dc = showSub ss dc || any (showSub ss . flSelector) (ifConFields dc)
754 755

    show_con dc
756
      | ok_con dc = Just $ pprIfaceConDecl ss gadt tycon binders parent dc
757
      | otherwise = Nothing
758

759
    pp_nd = case condecls of
760
              IfAbstractTyCon{} -> text "data"
761 762
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
763

Edward Z. Yang's avatar
Edward Z. Yang committed
764
    pp_extra = vcat [pprCType ctype]
765

766
pprIfaceDecl ss (IfaceClass { ifName  = clas
767
                            , ifRoles = roles
768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785
                            , 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
786
         , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
787
                                <+> pprFundeps fds <+> pp_where
Edward Z. Yang's avatar
Edward Z. Yang committed
788
         , nest 2 (vcat [ vcat asocs, vcat dsigs
789
                        , ppShowAllSubs ss (pprMinDef minDef)])]
790
    where
791
      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
792 793 794 795 796 797 798 799 800 801 802 803 804 805

      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

806 807
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
808
        text "{-# MINIMAL" <+>
809 810
        pprBooleanFormula
          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
811
        text "#-}"
812

813
pprIfaceDecl ss (IfaceSynonym { ifName    = tc
814
                              , ifBinders = binders
815
                              , ifSynRhs  = mono_ty
816 817 818 819
                              , 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) ])
820
  where
821
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
822

823 824 825
pprIfaceDecl ss (IfaceFamily { ifName = tycon
                             , ifFamFlav = rhs, ifBinders = binders
                             , ifResKind = res_kind
Jan Stolarek's avatar
Jan Stolarek committed
826
                             , ifResVar = res_var, ifFamInj = inj })