IfaceSyn.hs 75 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

dterei's avatar
dterei committed
23
        -- Misc
24
        ifaceDeclImplicitBndrs, visibleIfConDecls,
Adam Gundry's avatar
Adam Gundry committed
25
        ifaceConDeclFields,
26
        ifaceDeclFingerprints,
27

28
        -- Free Names
29
        freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
30

dterei's avatar
dterei committed
31
        -- Pretty printing
32 33 34
        pprIfaceExpr,
        pprIfaceDecl,
        ShowSub(..), ShowHowMuch(..)
35 36 37 38 39
    ) where

#include "HsVersions.h"

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

66
import Control.Monad
67
import System.IO.Unsafe
Adam Gundry's avatar
Adam Gundry committed
68
import Data.List (find)
69
import Data.Maybe (isJust)
70

71 72
infixl 3 &&&

Austin Seipp's avatar
Austin Seipp committed
73 74 75
{-
************************************************************************
*                                                                      *
76
                    Declarations
Austin Seipp's avatar
Austin Seipp committed
77 78 79
*                                                                      *
************************************************************************
-}
80

81
type IfaceTopBndr = OccName
Herbert Valerio Riedel's avatar
Herbert Valerio Riedel committed
82
  -- It's convenient to have an OccName in the IfaceSyn, although in each
83 84
  -- case the namespace is implied by the context. However, having an
  -- OccNames makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
85 86 87
  -- very convenient.
  --
  -- We don't serialise the namespace onto the disk though; rather we
88 89
  -- drop it when serialising and add it back in when deserialising.

dterei's avatar
dterei committed
90
data IfaceDecl
91
  = IfaceId { ifName      :: IfaceTopBndr,
dterei's avatar
dterei committed
92 93 94 95
              ifType      :: IfaceType,
              ifIdDetails :: IfaceIdDetails,
              ifIdInfo    :: IfaceIdInfo }

96
  | IfaceData { ifName       :: IfaceTopBndr,   -- Type constructor
97 98
                ifBinders    :: [IfaceTyConBinder],
                ifResKind    :: IfaceType,      -- Result kind of type constructor
99
                ifCType      :: Maybe CType,    -- C type for CAPI FFI
100
                ifRoles      :: [Role],         -- Roles
dterei's avatar
dterei committed
101
                ifCtxt       :: IfaceContext,   -- The "stupid theta"
102
                ifCons       :: IfaceConDecls,  -- Includes new/data/data family info
dterei's avatar
dterei committed
103 104 105
                ifRec        :: RecFlag,        -- Recursive or not?
                ifGadtSyntax :: Bool,           -- True <=> declared using
                                                -- GADT syntax
106 107
                ifParent     :: IfaceTyConParent -- The axiom, for a newtype,
                                                 -- or data/newtype family instance
108
    }
109

110 111
  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor
                   ifRoles   :: [Role],            -- Roles
112 113
                   ifBinders :: [IfaceTyConBinder],
                   ifResKind :: IfaceKind,         -- Kind of the *result*
114 115 116
                   ifSynRhs  :: IfaceType }

  | IfaceFamily  { ifName    :: IfaceTopBndr,      -- Type constructor
Jan Stolarek's avatar
Jan Stolarek committed
117 118 119
                   ifResVar  :: Maybe IfLclName,   -- Result variable name, used
                                                   -- only for pretty-printing
                                                   -- with --show-iface
120 121
                   ifBinders :: [IfaceTyConBinder],
                   ifResKind :: IfaceKind,         -- Kind of the *tycon*
Jan Stolarek's avatar
Jan Stolarek committed
122 123
                   ifFamFlav :: IfaceFamTyConFlav,
                   ifFamInj  :: Injectivity }      -- injectivity information
124

125
  | IfaceClass { ifCtxt    :: IfaceContext,             -- Superclasses
126 127
                 ifName    :: IfaceTopBndr,             -- Name of the class TyCon
                 ifRoles   :: [Role],                   -- Roles
128
                 ifBinders :: [IfaceTyConBinder],
129
                 ifFDs     :: [FunDep FastString],      -- Functional dependencies
130 131 132
                 ifATs     :: [IfaceAT],                -- Associated type families
                 ifSigs    :: [IfaceClassOp],           -- Method signatures
                 ifMinDef  :: BooleanFormula IfLclName, -- Minimal complete definition
133 134
                 ifRec     :: RecFlag                   -- Is newtype/datatype associated
                                                        --   with the class recursive?
135 136
    }

137
  | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name
138
                 ifTyCon      :: IfaceTyCon,     -- LHS TyCon
139
                 ifRole       :: Role,           -- Role of axiom
140 141
                 ifAxBranches :: [IfaceAxBranch] -- Branches
    }
142

143
  | IfacePatSyn { ifName          :: IfaceTopBndr,           -- Name of the pattern synonym
Gergő Érdi's avatar
Gergő Érdi committed
144
                  ifPatIsInfix    :: Bool,
145 146
                  ifPatMatcher    :: (IfExtName, Bool),
                  ifPatBuilder    :: Maybe (IfExtName, Bool),
147 148
                  -- Everything below is redundant,
                  -- but needed to implement pprIfaceDecl
149 150
                  ifPatUnivBndrs  :: [IfaceForAllBndr],
                  ifPatExBndrs    :: [IfaceForAllBndr],
Gergő Érdi's avatar
Gergő Érdi committed
151 152
                  ifPatProvCtxt   :: IfaceContext,
                  ifPatReqCtxt    :: IfaceContext,
153
                  ifPatArgs       :: [IfaceType],
Matthew Pickering's avatar
Matthew Pickering committed
154 155
                  ifPatTy         :: IfaceType,
                  ifFieldLabels   :: [FieldLabel] }
Gergő Érdi's avatar
Gergő Érdi committed
156 157


158 159 160 161 162
data IfaceTyConParent
  = IfNoParent
  | IfDataInstance IfExtName
                   IfaceTyCon
                   IfaceTcArgs
163

164
data IfaceFamTyConFlav
165 166
  = IfaceDataFamilyTyCon                      -- Data family
  | IfaceOpenSynFamilyTyCon
167 168 169
  | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))
    -- ^ Name of associated axiom and branches for pretty printing purposes,
    -- or 'Nothing' for an empty closed family without an axiom
170
  | IfaceAbstractClosedSynFamilyTyCon
171
  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
172

173 174 175 176 177 178 179
data IfaceClassOp
  = IfaceClassOp IfaceTopBndr
                 IfaceType                         -- Class op type
                 (Maybe (DefMethSpec IfaceType))   -- Default method
                 -- The types of both the class op itself,
                 -- and the default method, are *not* quantifed
                 -- over the class variables
180

181 182 183 184
data IfaceAT = IfaceAT  -- See Class.ClassATItem
                  IfaceDecl          -- The associated type declaration
                  (Maybe IfaceType)  -- Default associated type instance, if any

185

186
-- This is just like CoAxBranch
187 188 189 190 191 192
data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars   :: [IfaceTvBndr]
                                   , ifaxbCoVars   :: [IfaceIdBndr]
                                   , ifaxbLHS      :: IfaceTcArgs
                                   , ifaxbRoles    :: [Role]
                                   , ifaxbRHS      :: IfaceType
                                   , ifaxbIncomps  :: [BranchIndex] }
193
                                     -- See Note [Storing compatibility] in CoAxiom
194

195
data IfaceConDecls
Adam Gundry's avatar
Adam Gundry committed
196 197 198 199 200 201 202 203 204
  = IfAbstractTyCon Bool                          -- c.f TyCon.AbstractTyCon
  | 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.
205

dterei's avatar
dterei committed
206
data IfaceConDecl
207
  = IfCon {
208
        ifConOcc     :: IfaceTopBndr,                -- Constructor name
dterei's avatar
dterei committed
209 210
        ifConWrapper :: Bool,                   -- True <=> has a wrapper
        ifConInfix   :: Bool,                   -- True <=> declared infix
211 212 213 214 215 216 217

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

218
        ifConExTvs   :: [IfaceForAllBndr],  -- Existential tyvars (w/ visibility)
219 220 221 222 223 224 225 226 227
        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
228

229
type IfaceEqSpec = [(IfLclName,IfaceType)]
230

231 232 233
-- | This corresponds to an HsImplBang; that is, the final
-- implementation decision about the data constructor arg
data IfaceBang
234 235
  = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion

236 237 238 239
-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

240 241 242 243 244
data IfaceClsInst
  = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
                   ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
                   ifDFun     :: IfExtName,                -- The dfun
                   ifOFlag    :: OverlapFlag,              -- Overlap flag
245
                   ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv
dterei's avatar
dterei committed
246 247 248 249 250 251
        -- 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
252

253
-- The ifFamInstTys field of IfaceFamInst contains a list of the rough
254
-- match types
255
data IfaceFamInst
256
  = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name
257
                 , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above
258
                 , ifFamInstAxiom    :: IfExtName            -- The axiom
259
                 , ifFamInstOrph     :: IsOrphan             -- Just like IfaceClsInst
dterei's avatar
dterei committed
260
                 }
261

262
data IfaceRule
dterei's avatar
dterei committed
263 264 265 266 267 268 269 270
  = 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,
271
        ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst
272 273
    }

274 275 276
data IfaceAnnotation
  = IfaceAnnotation {
        ifAnnotatedTarget :: IfaceAnnTarget,
277
        ifAnnotatedValue  :: AnnPayload
278 279 280 281
  }

type IfaceAnnTarget = AnnTarget OccName

282
-- Here's a tricky case:
283 284
--   * Compile with -O module A, and B which imports A.f
--   * Change function f in A, and recompile without -O
285
--   * When we read in old A.hi we read in its IdInfo (as a thunk)
dterei's avatar
dterei committed
286 287 288
--      (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
289
--   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
dterei's avatar
dterei committed
290
--      and so gives a new version.
291

292 293 294 295
data IfaceIdInfo
  = NoInfo                      -- When writing interface file without -O
  | HasInfo [IfaceInfoItem]     -- Has info, and here it is

296
data IfaceInfoItem
297 298 299 300 301
  = HsArity         Arity
  | HsStrictness    StrictSig
  | HsInline        InlinePragma
  | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true
                    IfaceUnfolding   -- See Note [Expose recursive functions]
302
  | HsNoCafRefs
303

304 305 306
-- 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
307
data IfaceUnfolding
308
  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
309 310
                                -- Possibly could eliminate the Bool here, the information
                                -- is also in the InlinePragma.
311

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

314
  | IfInlineRule Arity          -- INLINE pragmas
dterei's avatar
dterei committed
315 316 317
                 Bool           -- OK to inline even if *un*-saturated
                 Bool           -- OK to inline even if context is boring
                 IfaceExpr
318

319
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
320

321

322 323 324 325
-- 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
326

327 328
data IfaceIdDetails
  = IfVanillaId
Matthew Pickering's avatar
Matthew Pickering committed
329
  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
330
  | IfDFunId
331

Austin Seipp's avatar
Austin Seipp committed
332
{-
333 334
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
335
See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
336

337

Austin Seipp's avatar
Austin Seipp committed
338 339
************************************************************************
*                                                                      *
340
                Functions over declarations
Austin Seipp's avatar
Austin Seipp committed
341 342 343
*                                                                      *
************************************************************************
-}
344 345 346

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls (IfAbstractTyCon {}) = []
Adam Gundry's avatar
Adam Gundry committed
347 348 349 350 351 352 353 354 355 356 357
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
    help (dc:_) is_over lbl = mkFieldLabelOccs lbl (ifConOcc dc) is_over
    help [] _ _ = error "ifaceConDeclFields: data type has no constructors!"
358

359
ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
360 361 362
--  *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
363
-- See Note [Implicit TyThings] in HscTypes
364

365 366 367 368 369
-- 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.
370 371 372 373 374 375 376 377 378

ifaceDeclImplicitBndrs (IfaceData {ifName = tc_occ, ifCons = cons })
  = case cons of
      IfAbstractTyCon {}  -> []
      IfNewTyCon  cd  _ _ -> mkNewTyCoOcc tc_occ : ifaceConDeclImplicitBndrs cd
      IfDataTyCon cds _ _ -> concatMap ifaceConDeclImplicitBndrs cds

ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt, ifName = cls_tc_occ
                                   , ifSigs = sigs, ifATs = ats })
batterseapower's avatar
batterseapower committed
379
  = --   (possibly) newtype coercion
380 381 382 383 384 385
    co_occs ++
    --    data constructor (DataCon namespace)
    --    data worker (Id namespace)
    --    no wrapper (class dictionaries never have a wrapper)
    [dc_occ, dcww_occ] ++
    -- associated types
386
    [ifName at | IfaceAT at _ <- ats ] ++
387
    -- superclass selectors
batterseapower's avatar
batterseapower committed
388
    [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
389 390 391 392 393
    -- operation selectors
    [op | IfaceClassOp op  _ _ <- sigs]
  where
    n_ctxt = length sc_ctxt
    n_sigs = length sigs
batterseapower's avatar
batterseapower committed
394
    co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
dterei's avatar
dterei committed
395
            | otherwise  = []
396
    dcww_occ = mkDataConWorkerOcc dc_occ
batterseapower's avatar
batterseapower committed
397
    dc_occ = mkClassDataConOcc cls_tc_occ
dterei's avatar
dterei committed
398
    is_newtype = n_sigs + n_ctxt == 1 -- Sigh
399

400
ifaceDeclImplicitBndrs _ = []
401

402 403 404 405 406 407 408 409
ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
ifaceConDeclImplicitBndrs (IfCon { ifConWrapper = has_wrapper, ifConOcc = con_occ })
  = [con_occ, work_occ] ++ wrap_occs
  where
    work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace
    wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace
              | otherwise   = []

410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425
-- -----------------------------------------------------------------------------
-- 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
  = (ifName decl, hash) :
    [ (occ, computeFingerprint' (hash,occ))
    | occ <- ifaceDeclImplicitBndrs decl ]
  where
     computeFingerprint' =
       unsafeDupablePerformIO
        . computeFingerprint (panic "ifaceDeclFingerprints")
426

Austin Seipp's avatar
Austin Seipp committed
427 428 429
{-
************************************************************************
*                                                                      *
430
                Expressions
Austin Seipp's avatar
Austin Seipp committed
431 432 433
*                                                                      *
************************************************************************
-}
434 435 436 437 438 439

data IfaceExpr
  = IfaceLcl    IfLclName
  | IfaceExt    IfExtName
  | IfaceType   IfaceType
  | IfaceCo     IfaceCoercion
440
  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
441
  | IfaceLam    IfaceLamBndr IfaceExpr
442 443
  | IfaceApp    IfaceExpr IfaceExpr
  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
444
  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
445
  | IfaceLet    IfaceBinding  IfaceExpr
446 447 448 449 450 451 452 453
  | 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
454
  | IfaceSource  RealSrcSpan String        -- from SourceNote
455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474
  -- 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
475
{-
476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499
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
500 501
************************************************************************
*                                                                      *
502
              Printing IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
503 504 505
*                                                                      *
************************************************************************
-}
506 507 508 509 510 511

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
512 513 514 515 516
                                 , ifaxbCoVars = cvs
                                 , ifaxbLHS = pat_tys
                                 , ifaxbRHS = rhs
                                 , ifaxbIncomps = incomps })
  = hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))
517 518 519
    $+$
    nest 2 maybe_incomps
  where
520 521 522 523 524 525
    ppr_binders
      | null tvs && null cvs = empty
      | null cvs             = brackets (pprWithCommas pprIfaceTvBndr tvs)
      | otherwise
      = brackets (pprWithCommas pprIfaceTvBndr tvs <> semi <+>
                  pprWithCommas pprIfaceIdBndr cvs)
526 527
    pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
    maybe_incomps = ppUnless (null incomps) $ parens $
528
                    text "incompatible indices:" <+> ppr incomps
529 530 531 532 533 534

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

instance HasOccName IfaceClassOp where
  occName (IfaceClassOp n _ _) = n
535

536 537
instance HasOccName IfaceConDecl where
  occName = ifConOcc
538

539 540 541
instance HasOccName IfaceDecl where
  occName = ifName

542
instance Outputable IfaceDecl where
543 544
  ppr = pprIfaceDecl showAll

545 546 547 548 549 550 551 552 553
{-
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.
-}

554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572
data ShowSub
  = ShowSub
      { ss_ppr_bndr :: OccName -> SDoc  -- Pretty-printer for binders in IfaceDecl
                                        -- See Note [Printing IfaceDecl binders]
      , ss_how_much :: ShowHowMuch }

data ShowHowMuch
  = ShowHeader   -- Header information only, not rhs
  | ShowSome [OccName]    -- []     <=> 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)

showAll :: ShowSub
showAll = ShowSub { ss_how_much = ShowIface, ss_ppr_bndr = ppr }

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

575 576 577 578 579 580
-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc
ppShowAllSubs _                                      _   = Outputable.empty

581
ppShowRhs :: ShowSub -> SDoc -> SDoc
582
ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _   = Outputable.empty
583 584 585 586 587 588
ppShowRhs _                                      doc = doc

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

Austin Seipp's avatar
Austin Seipp committed
590
{-
591 592 593 594 595 596 597
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.
598

599 600
When printing an interface file (--show-iface), we want to print
everything unqualified, so we can just print the OccName directly.
Austin Seipp's avatar
Austin Seipp committed
601
-}
602 603 604 605 606 607 608 609

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)
610
    go Nothing    (False, so_far) = (True, text "..." : so_far)
611 612 613 614 615 616

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

pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
617 618
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
619
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
620
                             ifCtxt = context,
621 622 623
                             ifRoles = roles, ifCons = condecls,
                             ifParent = parent, ifRec = isrec,
                             ifGadtSyntax = gadt,
624
                             ifBinders = binders })
625 626 627 628 629 630 631 632 633 634 635 636 637

  | 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
638
    pp_where   = ppWhen (gadt_style && not (null cons)) $ text "where"
639 640 641
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]

    pp_lhs = case parent of
642
               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing
643
               _          -> text "instance" <+> pprIfaceTyConParent parent
644 645

    pp_roles
646 647 648
      | is_data_instance = empty
      | otherwise        = pprRoles (== Representational)
                                    (pprPrefixIfDeclBndr ss tycon)
649
                                    binders roles
650 651 652
            -- Don't display roles for data family instances (yet)
            -- See discussion on Trac #8672.

653
    add_bars []     = Outputable.empty
654
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
655 656 657 658

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

    show_con dc
659
      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style fls tycon binders parent dc
660
      | otherwise = Nothing
Adam Gundry's avatar
Adam Gundry committed
661
    fls = ifaceConDeclFields condecls
662

663
    pp_nd = case condecls of
664 665 666
              IfAbstractTyCon d -> text "abstract" <> ppShowIface ss (parens (ppr d))
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
667

668
    pp_extra = vcat [pprCType ctype, pprRec isrec]
669

670

671 672
pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
                            , ifCtxt   = context, ifName  = clas
673
                            , ifRoles = roles
674
                            , ifFDs    = fds, ifMinDef = minDef
675 676 677
                            , ifBinders = binders })
  = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) binders roles
         , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
678
                                <+> pprFundeps fds <+> pp_where
679 680
         , nest 2 (vcat [ vcat asocs, vcat dsigs, pprec
                        , ppShowAllSubs ss (pprMinDef minDef)])]
681
    where
682
      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
683 684 685 686 687 688 689 690 691 692 693 694 695 696 697

      asocs = ppr_trim $ map maybeShowAssoc ats
      dsigs = ppr_trim $ map maybeShowSig sigs
      pprec = ppShowIface ss (pprRec isrec)

      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

698 699
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
700
        text "{-# MINIMAL" <+>
701 702
        pprBooleanFormula
          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
703
        text "#-}"
704

705
pprIfaceDecl ss (IfaceSynonym { ifName    = tc
706
                              , ifBinders = binders
707
                              , ifSynRhs  = mono_ty
708 709 710 711
                              , 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) ])
712
  where
713
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
714

715 716 717
pprIfaceDecl ss (IfaceFamily { ifName = tycon
                             , ifFamFlav = rhs, ifBinders = binders
                             , ifResKind = res_kind
Jan Stolarek's avatar
Jan Stolarek committed
718
                             , ifResVar = res_var, ifFamInj = inj })
719
  | IfaceDataFamilyTyCon <- rhs
720
  = text "data family" <+> pprIfaceDeclHead [] ss tycon binders Nothing
721 722

  | otherwise
723
  = hang (text "type family" <+> pprIfaceDeclHead [] ss tycon binders (Just res_kind))
724 725
       2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
    $$
726
    nest 2 (ppShowRhs ss (pp_branches rhs))
727
  where
728
    pp_inj Nothing    _   = empty
Jan Stolarek's avatar
Jan Stolarek committed
729
    pp_inj (Just res) inj
730
       | Injective injectivity <- inj = hsep [ equals, ppr res
Jan Stolarek's avatar
Jan Stolarek committed
731
                                             , pp_inj_cond res injectivity]
732
       | otherwise = hsep [ equals, ppr res ]
Jan Stolarek's avatar
Jan Stolarek committed
733

734
    pp_inj_cond res inj = case filterByList inj binders of
Jan Stolarek's avatar
Jan Stolarek committed
735
       []  -> empty
736
       tvs -> hsep [vbar, ppr res, text "->", interppSP (map ifTyConBinderName tvs)]
Jan Stolarek's avatar
Jan Stolarek committed
737

738
    pp_rhs IfaceDataFamilyTyCon
739
      = ppShowIface ss (text "data")
740
    pp_rhs IfaceOpenSynFamilyTyCon
741
      = ppShowIface ss (text "open")
742
    pp_rhs IfaceAbstractClosedSynFamilyTyCon
743
      = ppShowIface ss (text "closed, abstract")
744
    pp_rhs (IfaceClosedSynFamilyTyCon {})
745
      = empty  -- see pp_branches
746
    pp_rhs IfaceBuiltInSynFamTyCon
747
      = ppShowIface ss (text "built-in")
748 749

    pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
750 751
      = hang (text "where")
           2 (vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs)
752
              $$ ppShowIface ss (text "axiom" <+> ppr ax))
753
    pp_branches _ = Outputable.empty
754

755
pprIfaceDecl _ (IfacePatSyn { ifName = name,
756
                              ifPatUnivBndrs = univ_bndrs, ifPatExBndrs = ex_bndrs,
757
                              ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
758 759
                              ifPatArgs = arg_tys,
                              ifPatTy = pat_ty} )
760
  = sdocWithDynFlags mk_msg
Gergő Érdi's avatar
Gergő Érdi committed
761
  where
762 763 764 765 766 767 768
    mk_msg dflags
      = hsep [ text "pattern", pprPrefixOcc name, dcolon
             , univ_msg, pprIfaceContextArr req_ctxt
             , ppWhen insert_empty_ctxt $ parens empty <+> darrow
             , ex_msg, pprIfaceContextArr prov_ctxt
             , pprIfaceType $ foldr IfaceFunTy pat_ty arg_tys]
      where
769 770
        univ_msg = pprUserIfaceForAll univ_bndrs
        ex_msg   = pprUserIfaceForAll ex_bndrs
771 772 773

        insert_empty_ctxt = null req_ctxt
            && not (null prov_ctxt && isEmpty dflags ex_msg)
Gergő Érdi's avatar
Gergő Érdi committed
774

775 776
pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
                              ifIdDetails = details, ifIdInfo = info })
777
  = vcat [ hang (pprPrefixIfDeclBndr ss var <+> dcolon)
778 779
              2 (pprIfaceSigmaType ty)
         , ppShowIface ss (ppr details)
780
         , ppShowIface ss (ppr info) ]
781 782 783

pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon
                           , ifAxBranches = branches })
784
  = hang (text "axiom" <+> ppr name <> dcolon)
785 786 787
       2 (vcat $ map (pprAxBranch (ppr tycon)) branches)


788
pprCType :: Maybe CType -> SDoc
789
pprCType Nothing      = Outputable.empty
790
pprCType (Just cType) = text "C type:" <+> ppr cType
791

792 793
-- if, for each role, suppress_if role is True, then suppress the role
-- output
794
pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTyConBinder]
795 796
         -> [Role] -> SDoc
pprRoles suppress_if tyCon bndrs roles
797
  = sdocWithDynFlags $ \dflags ->
798
      let froles = suppressIfaceInvisibles dflags bndrs roles
799
      in ppUnless (all suppress_if roles || null froles) $
800
         text "type role" <+> tyCon <+> hsep (map ppr froles)
801

Ian Lynagh's avatar
Ian Lynagh committed
802
pprRec :: RecFlag -> SDoc
803
pprRec NonRecursive = Outputable.empty
804
pprRec Recursive    = text "RecFlag: Recursive"
Ian Lynagh's avatar
Ian Lynagh committed
805

806
pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
807
pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
808 809 810
  = pprInfixVar (isSymOcc occ) (ppr_bndr occ)
pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
  = parenSymOcc occ (ppr_bndr occ)
811

812
instance Outputable IfaceClassOp where
813 814 815
   ppr = pprIfaceClassOp showAll

pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
816 817 818 819
pprIfaceClassOp ss (IfaceClassOp n ty dm)
  = pp_sig n ty $$ generic_dm
  where
   generic_dm | Just (GenericDM dm_ty) <- dm
820
              =  text "default" <+> pp_sig n dm_ty
821 822 823
              | otherwise
              = empty
   pp_sig n ty = pprPrefixIfDeclBndr ss n <+> dcolon <+> pprIfaceSigmaType ty
824

825
instance Outputable IfaceAT where
826 827 828
   ppr = pprIfaceAT showAll

pprIfaceAT :: ShowSub -> IfaceAT -> SDoc