IfaceSyn.hs 77.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,
13
        IfaceExpr(..), IfaceAlt, IfaceLetBndr(..),
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

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

dterei's avatar
dterei committed
27
        -- Misc
28
        ifaceDeclImplicitBndrs, visibleIfConDecls,
Adam Gundry's avatar
Adam Gundry committed
29
        ifaceConDeclFields,
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
Simon Peyton Jones's avatar
Simon Peyton Jones committed
45
import CoreSyn( 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(..), HowAbstract(..) )
66
import StaticFlags (opt_PprStyle_Debug)
Jan Stolarek's avatar
Jan Stolarek committed
67
import Util( filterOut, filterByList )
68
import DataCon (SrcStrictness(..), SrcUnpackedness(..))
69
import Lexeme (isLexSym)
70

71
import Control.Monad
72
import System.IO.Unsafe
Adam Gundry's avatar
Adam Gundry committed
73
import Data.List (find)
74
import Data.Maybe (isJust)
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 89
-- | 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
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 { ifCtxt    :: IfaceContext,             -- Superclasses
144 145
                 ifName    :: IfaceTopBndr,             -- Name of the class TyCon
                 ifRoles   :: [Role],                   -- Roles
146
                 ifBinders :: [IfaceTyConBinder],
Edward Z. Yang's avatar
Edward Z. Yang committed
147
                 ifFDs     :: [FunDep IfLclName],      -- Functional dependencies
148 149
                 ifATs     :: [IfaceAT],                -- Associated type families
                 ifSigs    :: [IfaceClassOp],           -- Method signatures
Edward Z. Yang's avatar
Edward Z. Yang committed
150
                 ifMinDef  :: BooleanFormula IfLclName  -- Minimal complete definition
151 152
    }

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

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


174 175 176 177 178
data IfaceTyConParent
  = IfNoParent
  | IfDataInstance IfExtName
                   IfaceTyCon
                   IfaceTcArgs
179

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

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

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

201

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

211
data IfaceConDecls
212
  = IfAbstractTyCon HowAbstract                   -- c.f TyCon.AbstractTyCon
Adam Gundry's avatar
Adam Gundry committed
213 214 215 216 217 218 219 220
  | IfDataTyCon [IfaceConDecl] Bool [FieldLabelString] -- Data type decls
  | IfNewTyCon  IfaceConDecl   Bool [FieldLabelString] -- Newtype decls

-- For IfDataTyCon and IfNewTyCon we store:
--  * the data constructor(s);
--  * a boolean indicating whether DuplicateRecordFields was enabled
--    at the definition site; and
--  * a list of field labels.
221

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

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

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

245
type IfaceEqSpec = [(IfLclName,IfaceType)]
246

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

252 253 254 255
-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

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

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

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

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

type IfaceAnnTarget = AnnTarget OccName

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

308 309 310 311
data IfaceIdInfo
  = NoInfo                      -- When writing interface file without -O
  | HasInfo [IfaceInfoItem]     -- Has info, and here it is

312
data IfaceInfoItem
313 314 315 316 317
  = HsArity         Arity
  | HsStrictness    StrictSig
  | HsInline        InlinePragma
  | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true
                    IfaceUnfolding   -- See Note [Expose recursive functions]
318
  | HsNoCafRefs
Richard Eisenberg's avatar
Richard Eisenberg committed
319
  | HsLevity                         -- Present <=> never levity polymorphic
320

321 322 323
-- 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
324
data IfaceUnfolding
325
  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
326 327
                                -- Possibly could eliminate the Bool here, the information
                                -- is also in the InlinePragma.
328

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

331
  | IfInlineRule Arity          -- INLINE pragmas
dterei's avatar
dterei committed
332 333 334
                 Bool           -- OK to inline even if *un*-saturated
                 Bool           -- OK to inline even if context is boring
                 IfaceExpr
335

336
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
337

338

339 340 341 342
-- 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
343

344 345
data IfaceIdDetails
  = IfVanillaId
Matthew Pickering's avatar
Matthew Pickering committed
346
  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
347
  | IfDFunId
348

Austin Seipp's avatar
Austin Seipp committed
349
{-
350 351
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
352
See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
353

354

Austin Seipp's avatar
Austin Seipp committed
355 356
************************************************************************
*                                                                      *
357
                Functions over declarations
Austin Seipp's avatar
Austin Seipp committed
358 359 360
*                                                                      *
************************************************************************
-}
361 362 363

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls (IfAbstractTyCon {}) = []
Adam Gundry's avatar
Adam Gundry committed
364 365 366 367 368 369 370 371 372
visibleIfConDecls (IfDataTyCon cs _ _) = cs
visibleIfConDecls (IfNewTyCon c   _ _) = [c]

ifaceConDeclFields :: IfaceConDecls -> [FieldLbl OccName]
ifaceConDeclFields x = case x of
    IfAbstractTyCon {}              -> []
    IfDataTyCon cons is_over labels -> map (help cons  is_over) labels
    IfNewTyCon  con  is_over labels -> map (help [con] is_over) labels
  where
373 374
    help (dc:_) is_over lbl =
        mkFieldLabelOccs lbl (occName $ ifConName dc) is_over
Adam Gundry's avatar
Adam Gundry committed
375
    help [] _ _ = error "ifaceConDeclFields: data type has no constructors!"
376

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

383 384 385 386 387
-- 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.
388

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

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

421
ifaceDeclImplicitBndrs _ = []
422

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

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

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

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

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

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

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

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

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

instance NamedThing IfaceConDecl where
  getName = ifConName
564

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

instance NamedThing IfaceDecl where
  getName = ifName
570

571
instance HasOccName IfaceDecl where
572
  occName = getOccName
573

574
instance Outputable IfaceDecl where
575
  ppr = pprIfaceDecl showToIface
576

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    ok_con dc = showSub ss dc || any (showSub ss) (ifConFields dc)

    show_con dc
710
      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style fls tycon binders parent dc
711
      | otherwise = Nothing
Adam Gundry's avatar
Adam Gundry committed
712
    fls = ifaceConDeclFields condecls
713

714
    pp_nd = case condecls of
715 716 717 718
              IfAbstractTyCon how ->
                case how of
                  DistinctNominalAbstract           -> text "abstract"
                  SkolemAbstract                    -> text "skolem"
719 720
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
721

Edward Z. Yang's avatar
Edward Z. Yang committed
722
    pp_extra = vcat [pprCType ctype]
723

724

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

      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

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

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

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

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

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

795
    pp_rhs IfaceDataFamilyTyCon
796
      = ppShowIface ss (text "data")
797
    pp_rhs IfaceOpenSynFamilyTyCon
798
      = ppShowIface ss (text "open")
799
    pp_rhs IfaceAbstractClosedSynFamilyTyCon
800
      = ppShowIface ss (text "closed, abstract")
801
    pp_rhs (IfaceClosedSynFamilyTyCon {})
802
      = empty  -- see pp_branches
803
    pp_rhs IfaceBuiltInSynFamTyCon
804
      = ppShowIface ss (text "built-in")
805 806

    pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
807
      = hang (text "where")
808 809 810 811 812
           2 (vcat (map (pprAxBranch
                           (pprPrefixIfDeclBndr
                             (ss_how_much ss)
                             (occName tycon))
                        ) brs)
813
              $$ ppShowIface ss (text "axiom" <+> ppr ax))