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 )
60
import HsBinds
Jan Stolarek's avatar
Jan Stolarek committed
61
import TyCon ( Role (..), Injectivity(..) )
62
import StaticFlags (opt_PprStyle_Debug)
Jan Stolarek's avatar
Jan Stolarek committed
63
import Util( filterOut, filterByList )
64
import DataCon (SrcStrictness(..), SrcUnpackedness(..))
65
import Lexeme (isLexSym)
66

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

72 73
infixl 3 &&&

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

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

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

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

111 112 113
  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor
                   ifTyVars  :: [IfaceTvBndr],     -- Type variables
                   ifRoles   :: [Role],            -- Roles
114
                   ifSynKind :: IfaceKind,         -- Kind of the *tycon*
115 116 117 118
                   ifSynRhs  :: IfaceType }

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

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

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

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


160 161 162 163 164
data IfaceTyConParent
  = IfNoParent
  | IfDataInstance IfExtName
                   IfaceTyCon
                   IfaceTcArgs
165

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

175 176 177 178 179 180 181
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
182

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

187

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

197
data IfaceConDecls
Adam Gundry's avatar
Adam Gundry committed
198 199 200 201 202 203 204 205 206
  = 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.
207

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

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

220 221 222 223 224 225 226 227 228 229
        ifConExTvs   :: [IfaceTvBndr],      -- Existential tyvars
        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
230

231
type IfaceEqSpec = [(IfLclName,IfaceType)]
232

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

238 239 240 241
-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

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

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

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

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

type IfaceAnnTarget = AnnTarget OccName

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

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

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

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

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

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

321
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
322

323

324 325 326 327
-- 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
328

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

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

339

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

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls (IfAbstractTyCon {}) = []
Adam Gundry's avatar
Adam Gundry committed
349 350 351 352 353 354 355 356 357 358 359
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!"
360

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

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

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

402
ifaceDeclImplicitBndrs _ = []
403

404 405 406 407 408 409 410 411
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   = []

412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427
-- -----------------------------------------------------------------------------
-- 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")
428

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

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

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

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

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

538 539
instance HasOccName IfaceConDecl where
  occName = ifConOcc
540

541 542 543
instance HasOccName IfaceDecl where
  occName = ifName

544
instance Outputable IfaceDecl where
545 546
  ppr = pprIfaceDecl showAll

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

556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574
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
575
ppShowIface _                                     _   = Outputable.empty
576

577 578 579 580 581 582
-- 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

583
ppShowRhs :: ShowSub -> SDoc -> SDoc
584
ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _   = Outputable.empty
585 586 587 588 589 590
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
591

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

601 602
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
603
-}
604 605 606 607 608 609 610 611 612 613 614 615 616 617 618

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)
    go Nothing    (False, so_far) = (True, ptext (sLit "...") : so_far)

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

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

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

    pp_lhs = case parent of
644
               IfNoParent -> pprIfaceDeclHead context ss tycon kind tc_tyvars
645 646 647
               _          -> ptext (sLit "instance") <+> pprIfaceTyConParent parent

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

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

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

    show_con dc
Adam Gundry's avatar
Adam Gundry committed
661
      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style mk_user_con_res_ty fls dc
662
      | otherwise = Nothing
Adam Gundry's avatar
Adam Gundry committed
663
    fls = ifaceConDeclFields condecls
664

665 666 667 668 669 670 671
    mk_user_con_res_ty :: IfaceEqSpec -> ([IfaceTvBndr], SDoc)
    -- See Note [Result type of a data family GADT]
    mk_user_con_res_ty eq_spec
      | IfDataInstance _ tc tys <- parent
      = (con_univ_tvs, pprIfaceType (IfaceTyConApp tc (substIfaceTcArgs gadt_subst tys)))
      | otherwise
      = (con_univ_tvs, sdocWithDynFlags (ppr_tc_app gadt_subst))
672
      where
673 674 675
        gadt_subst = mkFsEnv eq_spec
        done_univ_tv (tv,_) = isJust (lookupFsEnv gadt_subst tv)
        con_univ_tvs = filterOut done_univ_tv tc_tyvars
676

677 678 679
    ppr_tc_app gadt_subst dflags
       = pprPrefixIfDeclBndr ss tycon
         <+> sep [ pprParendIfaceType (substIfaceTyVar gadt_subst tv)
680 681 682
                 | (tv,_kind)
                     <- suppressIfaceInvisibles dflags tc_bndrs tc_tyvars ]
    (tc_bndrs, _, _) = splitIfaceSigmaTy kind
683 684 685

    pp_nd = case condecls of
              IfAbstractTyCon d -> ptext (sLit "abstract") <> ppShowIface ss (parens (ppr d))
Adam Gundry's avatar
Adam Gundry committed
686 687
              IfDataTyCon{}     -> ptext (sLit "data")
              IfNewTyCon{}      -> ptext (sLit "newtype")
688

689
    pp_extra = vcat [pprCType ctype, pprRec isrec, text "Kind:" <+> ppr kind]
690

691

692 693 694
pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
                            , ifCtxt   = context, ifName  = clas
                            , ifTyVars = tyvars,  ifRoles = roles
695 696 697 698
                            , ifFDs    = fds, ifMinDef = minDef
                            , ifKind   = kind })
  = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) bndrs roles
         , ptext (sLit "class") <+> pprIfaceDeclHead context ss clas kind tyvars
699
                                <+> pprFundeps fds <+> pp_where
700 701
         , nest 2 (vcat [ vcat asocs, vcat dsigs, pprec
                        , ppShowAllSubs ss (pprMinDef minDef)])]
702
    where
703 704
      (bndrs, _, _) = splitIfaceSigmaTy kind

705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720
      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (ptext (sLit "where"))

      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

721 722 723 724 725 726 727
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
        ptext (sLit "{-# MINIMAL") <+>
        pprBooleanFormula
          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
        ptext (sLit "#-}")

728 729 730 731 732
pprIfaceDecl ss (IfaceSynonym { ifName    = tc
                              , ifTyVars  = tv
                              , ifSynRhs  = mono_ty
                              , ifSynKind = kind})
  = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] ss tc kind tv <+> equals)
733
       2 (sep [pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau])
734
  where
735
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
736

737
pprIfaceDecl ss (IfaceFamily { ifName = tycon, ifTyVars = tyvars
Jan Stolarek's avatar
Jan Stolarek committed
738 739
                             , ifFamFlav = rhs, ifFamKind = kind
                             , ifResVar = res_var, ifFamInj = inj })
740
  | IfaceDataFamilyTyCon <- rhs
741
  = ptext (sLit "data family") <+> pprIfaceDeclHead [] ss tycon kind tyvars
742 743

  | otherwise
744 745 746 747 748
  = hang (text "type family" <+> pprIfaceDeclHead [] ss tycon kind tyvars)
       2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
    $$
    nest 2 ( vcat [ text "Kind:" <+> ppr kind
                  , ppShowRhs ss (pp_branches rhs) ] )
749
  where
750
    pp_inj Nothing    _   = empty
Jan Stolarek's avatar
Jan Stolarek committed
751
    pp_inj (Just res) inj
752
       | Injective injectivity <- inj = hsep [ equals, ppr res
Jan Stolarek's avatar
Jan Stolarek committed
753
                                             , pp_inj_cond res injectivity]
754
       | otherwise = hsep [ equals, ppr res ]
Jan Stolarek's avatar
Jan Stolarek committed
755 756 757

    pp_inj_cond res inj = case filterByList inj tyvars of
       []  -> empty
758
       tvs -> hsep [vbar, ppr res, text "->", interppSP (map fst tvs)]
Jan Stolarek's avatar
Jan Stolarek committed
759

760 761
    pp_rhs IfaceDataFamilyTyCon
      = ppShowIface ss (ptext (sLit "data"))
762 763 764 765
    pp_rhs IfaceOpenSynFamilyTyCon
      = ppShowIface ss (ptext (sLit "open"))
    pp_rhs IfaceAbstractClosedSynFamilyTyCon
      = ppShowIface ss (ptext (sLit "closed, abstract"))
766
    pp_rhs (IfaceClosedSynFamilyTyCon {})
767
      = empty  -- see pp_branches
768 769 770 771
    pp_rhs IfaceBuiltInSynFamTyCon
      = ppShowIface ss (ptext (sLit "built-in"))

    pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
772 773 774
      = hang (text "where")
           2 (vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs)
              $$ ppShowIface ss (ptext (sLit "axiom") <+> ppr ax))
775
    pp_branches _ = Outputable.empty
776

777
pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatBuilder = builder,
778
                              ifPatUnivTvs = univ_tvs, ifPatExTvs = ex_tvs,
779
                              ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
780 781 782
                              ifPatArgs = arg_tys,
                              ifPatTy = pat_ty} )
  = pprPatSynSig name is_bidirectional
783
                 (pprUserIfaceForAll (map tv_to_forall_bndr tvs))
784
                 (pprIfaceContextMaybe req_ctxt)
785
                 (pprIfaceContextMaybe prov_ctxt)
786
                 (pprIfaceType ty)
Gergő Érdi's avatar
Gergő Érdi committed
787
  where
788
    is_bidirectional = isJust builder
789 790
    tvs = univ_tvs ++ ex_tvs
    ty = foldr IfaceFunTy pat_ty arg_tys
Gergő Érdi's avatar
Gergő Érdi committed
791

792 793
pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
                              ifIdDetails = details, ifIdInfo = info })
794
  = vcat [ hang (pprPrefixIfDeclBndr ss var <+> dcolon)
795 796
              2 (pprIfaceSigmaType ty)
         , ppShowIface ss (ppr details)
797
         , ppShowIface ss (ppr info) ]
798 799 800 801 802 803 804

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


805
pprCType :: Maybe CType -> SDoc
806
pprCType Nothing      = Outputable.empty
807 808
pprCType (Just cType) = ptext (sLit "C type:") <+> ppr cType

809 810
-- if, for each role, suppress_if role is True, then suppress the role
-- output
811 812 813
pprRoles :: (Role -> Bool) -> SDoc -> [IfaceForAllBndr]
         -> [Role] -> SDoc
pprRoles suppress_if tyCon bndrs roles
814
  = sdocWithDynFlags $ \dflags ->
815
      let froles = suppressIfaceInvisibles dflags bndrs roles
816 817
      in ppUnless (all suppress_if roles || null froles) $
         ptext (sLit "type role") <+> tyCon <+> hsep (map ppr froles)
818

Ian Lynagh's avatar
Ian Lynagh committed
819
pprRec :: RecFlag -> SDoc
820
pprRec NonRecursive = Outputable.empty
821
pprRec Recursive    = ptext (sLit "RecFlag: Recursive")
Ian Lynagh's avatar
Ian Lynagh committed
822

823
pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
824
pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
825 826 827
  = pprInfixVar (isSymOcc occ) (ppr_bndr occ)
pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
  = parenSymOcc occ (ppr_bndr occ)
828

829
instance Outputable IfaceClassOp where
830 831 832
   ppr = pprIfaceClassOp showAll

pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
833 834 835 836 837 838 839 840
pprIfaceClassOp ss (IfaceClassOp n ty dm)
  = pp_sig n ty $$ generic_dm
  where
   generic_dm | Just (GenericDM dm_ty) <- dm
              =  ptext (sLit "default") <+> pp_sig n dm_ty
              | otherwise
              = empty
   pp_sig n ty = pprPrefixIfDeclBndr ss n <+> dcolon <+> pprIfaceSigmaType ty
841

842
instance Outputable IfaceAT where
843 844 845
   ppr = pprIfaceAT showAll

pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
846
pprIfaceAT ss (IfaceAT d mb_def)
847
  = vcat [ pprIfaceDecl ss d
848
         , case mb_def of
849
              Nothing  -> Outputable.empty
850 851
              Just rhs -> nest 2 $
                          ptext (sLit "Default:") <+> ppr rhs ]
852 853 854 855 856 857

instance Outputable IfaceTyConParent where
  ppr p = pprIfaceTyConParent p

pprIfaceTyConParent :: IfaceTyConParent -> SDoc
pprIfaceTyConParent IfNoParent
858
  = Outputable.empty
859 860
pprIfaceTyConParent (IfDataInstance _ tc tys)
  = sdocWithDynFlags $ \dflags ->
861
    let ftys = stripInvisArgs dflags tys
862 863
    in pprIfaceTypeApp tc ftys

864 865 866 867
pprIfaceDeclHead :: IfaceContext -> ShowSub -> OccName
                 -> IfaceType   -- of the tycon, for invisible-suppression
                 -> [IfaceTvBndr] -> SDoc
pprIfaceDeclHead context ss tc_occ kind tyvars
868
  = sdocWithDynFlags $ \ dflags ->