IfaceSyn.hs 77.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,
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
        IfaceCompleteMatch(..),
23

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

dterei's avatar
dterei committed
28
        -- Misc
29
        ifaceDeclImplicitBndrs, visibleIfConDecls,
Adam Gundry's avatar
Adam Gundry committed
30
        ifaceConDeclFields,
31
        ifaceDeclFingerprints,
32

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

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

#include "HsVersions.h"

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

72
import Control.Monad
73
import System.IO.Unsafe
Adam Gundry's avatar
Adam Gundry committed
74
import Data.List (find)
75
import Data.Maybe (isJust)
76

77 78
infixl 3 &&&

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

87 88 89 90
-- | A binding top-level 'Name' in an interface file (e.g. the name of an
-- 'IfaceDecl').
type IfaceTopBndr = Name
  -- It's convenient to have an Name in the IfaceSyn, although in each
91
  -- case the namespace is implied by the context. However, having an
92 93 94 95
  -- Name makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
  -- very convenient. Moreover, having the key of the binder means that
  -- we can encode known-key things cleverly in the symbol table. See Note
  -- [Symbol table representation of Names]
96 97
  --
  -- We don't serialise the namespace onto the disk though; rather we
98 99
  -- drop it when serialising and add it back in when deserialising.

100 101 102 103 104 105 106 107 108 109
getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr
getIfaceTopBndr bh = get bh

putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr bh name =
    case getUserData bh of
      UserData{ ud_put_binding_name = put_binding_name } ->
          --pprTrace "putIfaceTopBndr" (ppr name) $
          put_binding_name bh name

dterei's avatar
dterei committed
110
data IfaceDecl
111
  = IfaceId { ifName      :: IfaceTopBndr,
dterei's avatar
dterei committed
112 113 114 115
              ifType      :: IfaceType,
              ifIdDetails :: IfaceIdDetails,
              ifIdInfo    :: IfaceIdInfo }

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

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

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

144
  | IfaceClass { ifCtxt    :: IfaceContext,             -- Superclasses
145 146
                 ifName    :: IfaceTopBndr,             -- Name of the class TyCon
                 ifRoles   :: [Role],                   -- Roles
147
                 ifBinders :: [IfaceTyConBinder],
Edward Z. Yang's avatar
Edward Z. Yang committed
148
                 ifFDs     :: [FunDep IfLclName],      -- Functional dependencies
149 150
                 ifATs     :: [IfaceAT],                -- Associated type families
                 ifSigs    :: [IfaceClassOp],           -- Method signatures
Edward Z. Yang's avatar
Edward Z. Yang committed
151
                 ifMinDef  :: BooleanFormula IfLclName  -- Minimal complete definition
152 153
    }

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

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


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

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

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

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

202

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

212
data IfaceConDecls
213
  = IfAbstractTyCon HowAbstract                   -- c.f TyCon.AbstractTyCon
Adam Gundry's avatar
Adam Gundry committed
214 215 216 217 218 219 220 221
  | 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.
222

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

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

235
        ifConExTvs   :: [IfaceForAllBndr],  -- Existential tyvars (w/ visibility)
236 237 238 239 240 241 242 243 244
        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
245

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

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

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

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

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

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

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

type IfaceAnnTarget = AnnTarget OccName

299 300
data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName

301 302 303 304
instance Outputable IfaceCompleteMatch where
  ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls
                                                    <+> dcolon <+> ppr ty

305 306 307



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

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

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

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

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

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

346
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
347

348

349 350 351 352
-- 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
353

354 355
data IfaceIdDetails
  = IfVanillaId
Matthew Pickering's avatar
Matthew Pickering committed
356
  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
357
  | IfDFunId
358

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

364

Austin Seipp's avatar
Austin Seipp committed
365 366
************************************************************************
*                                                                      *
367
                Functions over declarations
Austin Seipp's avatar
Austin Seipp committed
368 369 370
*                                                                      *
************************************************************************
-}
371 372 373

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls (IfAbstractTyCon {}) = []
Adam Gundry's avatar
Adam Gundry committed
374 375 376 377 378 379 380 381 382
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
383 384
    help (dc:_) is_over lbl =
        mkFieldLabelOccs lbl (occName $ ifConName dc) is_over
Adam Gundry's avatar
Adam Gundry committed
385
    help [] _ _ = error "ifaceConDeclFields: data type has no constructors!"
386

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

393 394 395 396 397
-- 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.
398

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

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

431
ifaceDeclImplicitBndrs _ = []
432

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

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

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

data IfaceExpr
  = IfaceLcl    IfLclName
  | IfaceExt    IfExtName
  | IfaceType   IfaceType
  | IfaceCo     IfaceCoercion
472
  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
473
  | IfaceLam    IfaceLamBndr IfaceExpr
474 475
  | IfaceApp    IfaceExpr IfaceExpr
  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
476
  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
477
  | IfaceLet    IfaceBinding  IfaceExpr
478 479 480 481 482 483 484 485
  | 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
486
  | IfaceSource  RealSrcSpan String        -- from SourceNote
487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506
  -- no breakpoints: we never export these into interface files

type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
        -- Note: IfLclName, not IfaceBndr (and same with the case binder)
        -- We reconstruct the kind/type of the thing from the context
        -- thus saving bulk in interface files

data IfaceConAlt = IfaceDefault
                 | IfaceDataAlt IfExtName
                 | IfaceLitAlt Literal

data IfaceBinding
  = IfaceNonRec IfaceLetBndr IfaceExpr
  | IfaceRec    [(IfaceLetBndr, IfaceExpr)]

-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
-- It's used for *non-top-level* let/rec binders
-- See Note [IdInfo on nested let-bindings]
data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo

Austin Seipp's avatar
Austin Seipp committed
507
{-
508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531
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
532 533
************************************************************************
*                                                                      *
534
              Printing IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
535 536 537
*                                                                      *
************************************************************************
-}
538 539 540 541 542 543

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

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

566 567 568
instance NamedThing IfaceClassOp where
  getName (IfaceClassOp n _ _) = n

569
instance HasOccName IfaceClassOp where
570 571 572 573
  occName = getOccName

instance NamedThing IfaceConDecl where
  getName = ifConName
574

575
instance HasOccName IfaceConDecl where
576 577 578 579
  occName = getOccName

instance NamedThing IfaceDecl where
  getName = ifName
580

581
instance HasOccName IfaceDecl where
582
  occName = getOccName
583

584
instance Outputable IfaceDecl where
585
  ppr = pprIfaceDecl showToIface
586

587 588 589 590 591 592 593 594 595
{-
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.
-}

596 597
data ShowSub
  = ShowSub
598 599 600 601 602 603
      { 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))
604 605

data ShowHowMuch
606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628
  = 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.
-}
629

630
instance Outputable ShowHowMuch where
631 632 633 634 635 636 637
  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 }
638

639 640 641
showToIface :: ShowSub
showToIface = ShowSub { ss_how_much = ShowIface
                      , ss_forall = ShowForAllWhen }
642 643 644

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

647 648
-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
649 650 651
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc
ppShowAllSubs _                                         _   = Outputable.empty
652

653
ppShowRhs :: ShowSub -> SDoc -> SDoc
654 655
ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty
ppShowRhs _                                        doc = doc
656 657

showSub :: HasOccName n => ShowSub -> n -> Bool
658 659
showSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
660
showSub (ShowSub { ss_how_much = _ })              _     = True
661

662 663 664 665 666 667 668
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)
669
    go Nothing    (False, so_far) = (True, text "..." : so_far)
670 671 672 673 674 675

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

pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
676 677
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
678
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
679
                             ifCtxt = context,
680
                             ifRoles = roles, ifCons = condecls,
Edward Z. Yang's avatar
Edward Z. Yang committed
681
                             ifParent = parent,
682
                             ifGadtSyntax = gadt,
683
                             ifBinders = binders })
684 685 686 687 688 689 690 691 692 693 694 695 696

  | 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
697
    pp_where   = ppWhen (gadt_style && not (null cons)) $ text "where"
698 699 700
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]

    pp_lhs = case parent of
701
               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing
702
               _          -> text "instance" <+> pprIfaceTyConParent parent
703 704

    pp_roles
705 706
      | is_data_instance = empty
      | otherwise        = pprRoles (== Representational)
707 708 709
                                    (pprPrefixIfDeclBndr
                                        (ss_how_much ss)
                                        (occName tycon))
710
                                    binders roles
711 712 713
            -- Don't display roles for data family instances (yet)
            -- See discussion on Trac #8672.

714
    add_bars []     = Outputable.empty
715
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
716 717 718 719

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

    show_con dc
720
      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style fls tycon binders parent dc
721
      | otherwise = Nothing
Adam Gundry's avatar
Adam Gundry committed
722
    fls = ifaceConDeclFields condecls
723

724
    pp_nd = case condecls of
725 726 727 728
              IfAbstractTyCon how ->
                case how of
                  DistinctNominalAbstract           -> text "abstract"
                  SkolemAbstract                    -> text "skolem"
729 730
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
731

Edward Z. Yang's avatar
Edward Z. Yang committed
732
    pp_extra = vcat [pprCType ctype]
733

734

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

      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

765 766
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
767
        text "{-# MINIMAL" <+>
768 769
        pprBooleanFormula
          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
770
        text "#-}"
771

772
pprIfaceDecl ss (IfaceSynonym { ifName    = tc
773
                              , ifBinders = binders
774
                              , ifSynRhs  = mono_ty
775 776 777 778
                              , 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) ])
779
  where
780
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
781

782 783 784
pprIfaceDecl ss (IfaceFamily { ifName = tycon
                             , ifFamFlav = rhs, ifBinders = binders
                             , ifResKind = res_kind
Jan Stolarek's avatar
Jan Stolarek committed
785
                             , ifResVar = res_var, ifFamInj = inj })
786
  | IfaceDataFamilyTyCon <- rhs
787
  = text "data family" <+> pprIfaceDeclHead [] ss tycon binders Nothing
788 789

  | otherwise
790
  = hang (text "type family" <+> pprIfaceDeclHead [] ss tycon binders (Just res_kind))
791 792
       2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
    $$
793
    nest 2 (ppShowRhs ss (pp_branches rhs))
794
  where
795
    pp_inj Nothing    _   = empty
Jan Stolarek's avatar
Jan Stolarek committed
796
    pp_inj (Just res) inj
797
       | Injective injectivity <- inj = hsep [ equals, ppr res
Jan Stolarek's avatar
Jan Stolarek committed
798
                                             , pp_inj_cond res injectivity]
799
       | otherwise = hsep [ equals, ppr res ]
Jan Stolarek's avatar
Jan Stolarek committed
800

801
    pp_inj_cond res inj = case filterByList inj binders of
Jan Stolarek's avatar
Jan Stolarek committed
802
       []  -> empty
803
       tvs -> hsep [vbar, ppr res, text "->", interppSP (map ifTyConBinderName tvs)]
Jan Stolarek's avatar
Jan Stolarek committed
804

805
    pp_rhs IfaceDataFamilyTyCon
806
      = ppShowIface ss (text "data")
807
    pp_rhs IfaceOpenSynFamilyTyCon
808
      = ppShowIface ss (text "open")
809
    pp_rhs IfaceAbstractClosedSynFamilyTyCon
810
      = ppShowIface ss (text "closed, abstract")
811
    pp_rhs (IfaceClosedSynFamilyTyCon {})
812
      = empty  -- see pp_branches
813
    pp_rhs IfaceBuiltInSynFamTyCon
814
      = ppShowIface ss (text "built-in")