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 Var( TyVarBndr(..) )
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
  | IfaceData { ifName       :: IfaceTopBndr,   -- Type constructor
98 99
                ifBinders    :: [IfaceTyConBinder],
                ifResKind    :: IfaceType,      -- Result kind of type constructor
100
                ifCType      :: Maybe CType,    -- C type for CAPI FFI
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
  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor
                   ifRoles   :: [Role],            -- Roles
113 114
                   ifBinders :: [IfaceTyConBinder],
                   ifResKind :: IfaceKind,         -- Kind of the *result*
115 116 117
                   ifSynRhs  :: IfaceType }

  | IfaceFamily  { ifName    :: IfaceTopBndr,      -- Type constructor
Jan Stolarek's avatar
Jan Stolarek committed
118 119 120
                   ifResVar  :: Maybe IfLclName,   -- Result variable name, used
                                                   -- only for pretty-printing
                                                   -- with --show-iface
121 122
                   ifBinders :: [IfaceTyConBinder],
                   ifResKind :: 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
                 ifName    :: IfaceTopBndr,             -- Name of the class TyCon
                 ifRoles   :: [Role],                   -- Roles
129
                 ifBinders :: [IfaceTyConBinder],
130
                 ifFDs     :: [FunDep FastString],      -- Functional dependencies
131 132 133
                 ifATs     :: [IfaceAT],                -- Associated type families
                 ifSigs    :: [IfaceClassOp],           -- Method signatures
                 ifMinDef  :: BooleanFormula IfLclName, -- Minimal complete definition
134 135
                 ifRec     :: RecFlag                   -- Is newtype/datatype associated
                                                        --   with the class recursive?
136 137
    }

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

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


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

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

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

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

186

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

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

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

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

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

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

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

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

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

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

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

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

type IfaceAnnTarget = AnnTarget OccName

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

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

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

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

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

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

320
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
321

322

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

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

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

338

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

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

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

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

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

401
ifaceDeclImplicitBndrs _ = []
402

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

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

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

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

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

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

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

537 538
instance HasOccName IfaceConDecl where
  occName = ifConOcc
539

540 541 542
instance HasOccName IfaceDecl where
  occName = ifName

543
instance Outputable IfaceDecl where
544 545
  ppr = pprIfaceDecl showAll

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

555 556 557 558 559 560 561 562 563 564 565 566 567 568
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)

569 570 571 572 573
instance Outputable ShowHowMuch where
  ppr ShowHeader      = text "ShowHeader"
  ppr ShowIface       = text "ShowIface"
  ppr (ShowSome occs) = text "ShowSome" <+> ppr occs

574 575 576 577 578
showAll :: ShowSub
showAll = ShowSub { ss_how_much = ShowIface, ss_ppr_bndr = ppr }

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

581 582 583 584 585 586
-- 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

587
ppShowRhs :: ShowSub -> SDoc -> SDoc
588
ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _   = Outputable.empty
589 590 591 592 593 594
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
595

Austin Seipp's avatar
Austin Seipp committed
596
{-
597 598 599 600 601 602 603
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.
604

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

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)
616
    go Nothing    (False, so_far) = (True, text "..." : so_far)
617 618 619 620 621 622

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

pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
623 624
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
625
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
626
                             ifCtxt = context,
627 628 629
                             ifRoles = roles, ifCons = condecls,
                             ifParent = parent, ifRec = isrec,
                             ifGadtSyntax = gadt,
630
                             ifBinders = binders })
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
644
    pp_where   = ppWhen (gadt_style && not (null cons)) $ text "where"
645 646 647
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]

    pp_lhs = case parent of
648
               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing
649
               _          -> text "instance" <+> pprIfaceTyConParent parent
650 651

    pp_roles
652 653 654
      | is_data_instance = empty
      | otherwise        = pprRoles (== Representational)
                                    (pprPrefixIfDeclBndr ss tycon)
655
                                    binders roles
656 657 658
            -- Don't display roles for data family instances (yet)
            -- See discussion on Trac #8672.

659
    add_bars []     = Outputable.empty
660
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
661 662 663 664

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

    show_con dc
665
      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style fls tycon binders parent dc
666
      | otherwise = Nothing
Adam Gundry's avatar
Adam Gundry committed
667
    fls = ifaceConDeclFields condecls
668

669
    pp_nd = case condecls of
670 671 672
              IfAbstractTyCon d -> text "abstract" <> ppShowIface ss (parens (ppr d))
              IfDataTyCon{}     -> text "data"
              IfNewTyCon{}      -> text "newtype"
673

674
    pp_extra = vcat [pprCType ctype, pprRec isrec]
675

676

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

      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

704 705
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
706
        text "{-# MINIMAL" <+>
707 708
        pprBooleanFormula
          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
709
        text "#-}"
710

711
pprIfaceDecl ss (IfaceSynonym { ifName    = tc
712
                              , ifBinders = binders
713
                              , ifSynRhs  = mono_ty
714 715 716 717
                              , 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) ])
718
  where
719
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
720

721 722 723
pprIfaceDecl ss (IfaceFamily { ifName = tycon
                             , ifFamFlav = rhs, ifBinders = binders
                             , ifResKind = res_kind
Jan Stolarek's avatar
Jan Stolarek committed
724
                             , ifResVar = res_var, ifFamInj = inj })
725
  | IfaceDataFamilyTyCon <- rhs
726
  = text "data family" <+> pprIfaceDeclHead [] ss tycon binders Nothing
727 728

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

740
    pp_inj_cond res inj = case filterByList inj binders of
Jan Stolarek's avatar
Jan Stolarek committed
741
       []  -> empty
742
       tvs -> hsep [vbar, ppr res, text "->", interppSP (map ifTyConBinderName tvs)]
Jan Stolarek's avatar
Jan Stolarek committed
743

744
    pp_rhs IfaceDataFamilyTyCon
745
      = ppShowIface ss (text "data")
746
    pp_rhs IfaceOpenSynFamilyTyCon
747
      = ppShowIface ss (text "open")
748
    pp_rhs IfaceAbstractClosedSynFamilyTyCon
749
      = ppShowIface ss (text "closed, abstract")
750
    pp_rhs (IfaceClosedSynFamilyTyCon {})
751
      = empty  -- see pp_branches
752
    pp_rhs IfaceBuiltInSynFamTyCon
753
      = ppShowIface ss (text "built-in")
754 755

    pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
756 757
      = hang (text "where")
           2 (vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs)
758
              $$ ppShowIface ss (text "axiom" <+> ppr ax))
759
    pp_branches _ = Outputable.empty
760

761
pprIfaceDecl _ (IfacePatSyn { ifName = name,
762
                              ifPatUnivBndrs = univ_bndrs, ifPatExBndrs = ex_bndrs,
763
                              ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
764 765
                              ifPatArgs = arg_tys,
                              ifPatTy = pat_ty} )
766
  = sdocWithDynFlags mk_msg
Gergő Érdi's avatar
Gergő Érdi committed
767
  where
768 769 770 771 772 773 774
    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
775 776
        univ_msg = pprUserIfaceForAll univ_bndrs
        ex_msg   = pprUserIfaceForAll ex_bndrs
777 778 779

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

781 782
pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
                              ifIdDetails = details, ifIdInfo = info })
783
  = vcat [ hang (pprPrefixIfDeclBndr ss var <+> dcolon)
784 785
              2 (pprIfaceSigmaType ty)
         , ppShowIface ss (ppr details)
786
         , ppShowIface ss (ppr info) ]
787 788 789

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


794
pprCType :: Maybe CType -> SDoc
795
pprCType Nothing      = Outputable.empty
796
pprCType (Just cType) = text "C type:" <+> ppr cType
797

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

Ian Lynagh's avatar
Ian Lynagh committed
808
pprRec :: RecFlag -> SDoc
809
pprRec NonRecursive = Outputable.empty
810
pprRec Recursive    = text "RecFlag: Recursive"
Ian Lynagh's avatar
Ian Lynagh committed
811

812
pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
813
pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
814 815 816
  = pprInfixVar (isSymOcc occ) (ppr_bndr occ)
pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
  = parenSymOcc occ (ppr_bndr occ)
817

818
instance Outputable IfaceClassOp where
819 820 821
   ppr = pprIfaceClassOp showAll

pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
822 823 824 825
pprIfaceClassOp ss (IfaceClassOp n ty dm)
  = pp_sig n ty $$ generic_dm
  where
   generic_dm | Just (GenericDM dm_ty) <- dm
826
              =  text "default" <+> pp_sig n dm_ty
827 828 829
              | otherwise
              = empty
   pp_sig n ty = pprPrefixIfDeclBndr