compiler/iface/IfaceSyn.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   4 %
   5
   6 \begin{code}
   7 module IfaceSyn (
   8         module IfaceType,               -- Re-export all this
   9
  10         IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
  11         IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
  12         IfaceBinding(..), IfaceConAlt(..),
  13         IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
  14         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
  15         IfaceInst(..), IfaceFamInst(..),
  16
  17         -- Misc
  18         ifaceDeclSubBndrs, visibleIfConDecls,
  19
  20         -- Free Names
  21         freeNamesIfDecl, freeNamesIfRule,
  22
  23         -- Pretty printing
  24         pprIfaceExpr, pprIfaceDeclHead
  25     ) where
  26
  27 #include "HsVersions.h"
  28
  29 import IfaceType
  30 import CoreSyn( DFunArg, dfunArgExprs )
  31 import PprCore()            -- Printing DFunArgs
  32 import Demand
  33 import Annotations
  34 import Class
  35 import NameSet
  36 import Name
  37 import CostCentre
  38 import Literal
  39 import ForeignCall
  40 import Serialized
  41 import BasicTypes
  42 import Outputable
  43 import FastString
  44 import Module
  45
  46 infixl 3 &&&
  47 \end{code}
  48
  49
  50 %************************************************************************
  51 %*                                                                      *
  52                 Data type declarations
  53 %*                                                                      *
  54 %************************************************************************
  55
  56 \begin{code}
  57 data IfaceDecl
  58   = IfaceId { ifName      :: OccName,
  59               ifType      :: IfaceType,
  60               ifIdDetails :: IfaceIdDetails,
  61               ifIdInfo    :: IfaceIdInfo }
  62
  63   | IfaceData { ifName       :: OccName,        -- Type constructor
  64                 ifTyVars     :: [IfaceTvBndr],  -- Type variables
  65                 ifCtxt       :: IfaceContext,   -- The "stupid theta"
  66                 ifCons       :: IfaceConDecls,  -- Includes new/data info
  67                 ifRec        :: RecFlag,        -- Recursive or not?
  68                 ifGadtSyntax :: Bool,           -- True <=> declared using
  69                                                 -- GADT syntax
  70                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
  71                                                 -- Just <=> instance of family
  72                                                 -- Invariant:
  73                                                 --   ifCons /= IfOpenDataTyCon
  74                                                 --   for family instances
  75     }
  76
  77   | IfaceSyn  { ifName    :: OccName,           -- Type constructor
  78                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
  79                 ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
  80                 ifSynRhs  :: Maybe IfaceType,   -- Just rhs for an ordinary synonyn
  81                                                 -- Nothing for an open family
  82                 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
  83                                                 -- Just <=> instance of family
  84                                                 -- Invariant: ifOpenSyn == False
  85                                                 --   for family instances
  86     }
  87
  88   | IfaceClass { ifCtxt    :: IfaceContext,     -- Context...
  89                  ifName    :: OccName,          -- Name of the class
  90                  ifTyVars  :: [IfaceTvBndr],    -- Type variables
  91                  ifFDs     :: [FunDep FastString], -- Functional dependencies
  92                  ifATs     :: [IfaceDecl],      -- Associated type families
  93                  ifSigs    :: [IfaceClassOp],   -- Method signatures
  94                  ifRec     :: RecFlag           -- Is newtype/datatype associated with the class recursive?
  95     }
  96
  97   | IfaceForeign { ifName :: OccName,           -- Needs expanding when we move
  98                                                 -- beyond .NET
  99                    ifExtName :: Maybe FastString }
 100
 101 data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
 102         -- Nothing    => no default method
 103         -- Just False => ordinary polymorphic default method
 104         -- Just True  => generic default method
 105
 106 data IfaceConDecls
 107   = IfAbstractTyCon             -- No info
 108   | IfOpenDataTyCon             -- Open data family
 109   | IfDataTyCon [IfaceConDecl]  -- data type decls
 110   | IfNewTyCon  IfaceConDecl    -- newtype decls
 111
 112 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
 113 visibleIfConDecls IfAbstractTyCon  = []
 114 visibleIfConDecls IfOpenDataTyCon  = []
 115 visibleIfConDecls (IfDataTyCon cs) = cs
 116 visibleIfConDecls (IfNewTyCon c)   = [c]
 117
 118 data IfaceConDecl
 119   = IfCon {
 120         ifConOcc     :: OccName,                -- Constructor name
 121         ifConWrapper :: Bool,                   -- True <=> has a wrapper
 122         ifConInfix   :: Bool,                   -- True <=> declared infix
 123         ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
 124         ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
 125         ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality contraints
 126         ifConCtxt    :: IfaceContext,           -- Non-stupid context
 127         ifConArgTys  :: [IfaceType],            -- Arg types
 128         ifConFields  :: [OccName],              -- ...ditto... (field labels)
 129         ifConStricts :: [HsBang]}               -- Empty (meaning all lazy),
 130                                                 -- or 1-1 corresp with arg tys
 131
 132 data IfaceInst
 133   = IfaceInst { ifInstCls  :: IfExtName,                -- See comments with
 134                 ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
 135                 ifDFun     :: IfExtName,                -- The dfun
 136                 ifOFlag    :: OverlapFlag,              -- Overlap flag
 137                 ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
 138         -- There's always a separate IfaceDecl for the DFun, which gives
 139         -- its IdInfo with its full type and version number.
 140         -- The instance declarations taken together have a version number,
 141         -- and we don't want that to wobble gratuitously
 142         -- If this instance decl is *used*, we'll record a usage on the dfun;
 143         -- and if the head does not change it won't be used if it wasn't before
 144
 145 data IfaceFamInst
 146   = IfaceFamInst { ifFamInstFam   :: IfExtName                -- Family tycon
 147                  , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
 148                  , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
 149                  }
 150
 151 data IfaceRule
 152   = IfaceRule {
 153         ifRuleName   :: RuleName,
 154         ifActivation :: Activation,
 155         ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
 156         ifRuleHead   :: IfExtName,      -- Head of lhs
 157         ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
 158         ifRuleRhs    :: IfaceExpr,
 159         ifRuleAuto   :: Bool,
 160         ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
 161     }
 162
 163 data IfaceAnnotation
 164   = IfaceAnnotation {
 165         ifAnnotatedTarget :: IfaceAnnTarget,
 166         ifAnnotatedValue :: Serialized
 167   }
 168
 169 type IfaceAnnTarget = AnnTarget OccName
 170
 171 -- We only serialise the IdDetails of top-level Ids, and even then
 172 -- we only need a very limited selection.  Notably, none of the
 173 -- implicit ones are needed here, becuase they are not put it
 174 -- interface files
 175
 176 data IfaceIdDetails
 177   = IfVanillaId
 178   | IfRecSelId IfaceTyCon Bool
 179   | IfDFunId Int          -- Number of silent args
 180
 181 data IfaceIdInfo
 182   = NoInfo                      -- When writing interface file without -O
 183   | HasInfo [IfaceInfoItem]     -- Has info, and here it is
 184
 185 -- Here's a tricky case:
 186 --   * Compile with -O module A, and B which imports A.f
 187 --   * Change function f in A, and recompile without -O
 188 --   * When we read in old A.hi we read in its IdInfo (as a thunk)
 189 --      (In earlier GHCs we used to drop IdInfo immediately on reading,
 190 --       but we do not do that now.  Instead it's discarded when the
 191 --       ModIface is read into the various decl pools.)
 192 --   * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
 193 --      and so gives a new version.
 194
 195 data IfaceInfoItem
 196   = HsArity      Arity
 197   | HsStrictness StrictSig
 198   | HsInline     InlinePragma
 199   | HsUnfold     Bool             -- True <=> isNonRuleLoopBreaker is true
 200                  IfaceUnfolding   -- See Note [Expose recursive functions]
 201   | HsNoCafRefs
 202
 203 -- NB: Specialisations and rules come in separately and are
 204 -- only later attached to the Id.  Partial reason: some are orphans.
 205
 206 data IfaceUnfolding
 207   = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
 208                                 -- Possibly could eliminate the Bool here, the information
 209                                 -- is also in the InlinePragma.
 210
 211   | IfCompulsory IfaceExpr      -- Only used for default methods, in fact
 212
 213   | IfInlineRule Arity          -- INLINE pragmas
 214                  Bool           -- OK to inline even if *un*-saturated
 215                  Bool           -- OK to inline even if context is boring
 216                  IfaceExpr
 217
 218   | IfExtWrapper Arity IfExtName  -- NB: sometimes we need a IfExtName (not just IfLclName)
 219   | IfLclWrapper Arity IfLclName  --     because the worker can simplify to a function in
 220                                   --     another module.
 221
 222   | IfDFunUnfold [DFunArg IfaceExpr]
 223
 224 --------------------------------
 225 data IfaceExpr
 226   = IfaceLcl    IfLclName
 227   | IfaceExt    IfExtName
 228   | IfaceType   IfaceType
 229   | IfaceTuple  Boxity [IfaceExpr]              -- Saturated; type arguments omitted
 230   | IfaceLam    IfaceBndr IfaceExpr
 231   | IfaceApp    IfaceExpr IfaceExpr
 232   | IfaceCase   IfaceExpr IfLclName IfaceType [IfaceAlt]
 233   | IfaceLet    IfaceBinding  IfaceExpr
 234   | IfaceNote   IfaceNote IfaceExpr
 235   | IfaceCast   IfaceExpr IfaceCoercion
 236   | IfaceLit    Literal
 237   | IfaceFCall  ForeignCall IfaceType
 238   | IfaceTick   Module Int
 239
 240 data IfaceNote = IfaceSCC CostCentre
 241                | IfaceCoreNote String
 242
 243 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
 244         -- Note: IfLclName, not IfaceBndr (and same with the case binder)
 245         -- We reconstruct the kind/type of the thing from the context
 246         -- thus saving bulk in interface files
 247
 248 data IfaceConAlt = IfaceDefault
 249                  | IfaceDataAlt IfExtName
 250                  | IfaceTupleAlt Boxity
 251                  | IfaceLitAlt Literal
 252
 253 data IfaceBinding
 254   = IfaceNonRec IfaceLetBndr IfaceExpr
 255   | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
 256
 257 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 258 -- It's used for *non-top-level* let/rec binders
 259 -- See Note [IdInfo on nested let-bindings]
 260 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
 261 \end{code}
 262
 263 Note [Expose recursive functions]
 264 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 265 For supercompilation we want to put *all* unfoldings in the interface
 266 file, even for functions that are recursive (or big).  So we need to
 267 know when an unfolding belongs to a loop-breaker so that we can refrain
 268 from inlining it (except during supercompilation).
 269
 270 Note [IdInfo on nested let-bindings]
 271 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 272 Occasionally we want to preserve IdInfo on nested let bindings. The one
 273 that came up was a NOINLINE pragma on a let-binding inside an INLINE
 274 function.  The user (Duncan Coutts) really wanted the NOINLINE control
 275 to cross the separate compilation boundary.
 276
 277 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
 278 that is what is seen by importing module with --make
 279
 280 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
 281 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 282 If a module contains any "orphans", then its interface file is read
 283 regardless, so that its instances are not missed.
 284
 285 Roughly speaking, an instance is an orphan if its head (after the =>)
 286 mentions nothing defined in this module.  Functional dependencies
 287 complicate the situation though. Consider
 288
 289   module M where { class C a b | a -> b }
 290
 291 and suppose we are compiling module X:
 292
 293   module X where
 294         import M
 295         data T = ...
 296         instance C Int T where ...
 297
 298 This instance is an orphan, because when compiling a third module Y we
 299 might get a constraint (C Int v), and we'd want to improve v to T.  So
 300 we must make sure X's instances are loaded, even if we do not directly
 301 use anything from X.
 302
 303 More precisely, an instance is an orphan iff
 304
 305   If there are no fundeps, then at least of the names in
 306   the instance head is locally defined.
 307
 308   If there are fundeps, then for every fundep, at least one of the
 309   names free in a *non-determined* part of the instance head is
 310   defined in this module.
 311
 312 (Note that these conditions hold trivially if the class is locally
 313 defined.)
 314
 315 Note [Versioning of instances]
 316 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 317 Now consider versioning.  If we *use* an instance decl in one compilation,
 318 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
 319 But suppose we *don't* (currently) use an instance!  We must recompile if
 320 the instance is changed in such a way that it becomes important.  (This would
 321 only matter with overlapping instances, else the importing module wouldn't have
 322 compiled before and the recompilation check is irrelevant.)
 323
 324 The is_orph field is set to (Just n) if the instance is not an orphan.
 325 The 'n' is *any* of the locally-defined names mentioned anywhere in the
 326 instance head.  This name is used for versioning; the instance decl is
 327 considered part of the defn of this 'n'.
 328
 329 I'm worried about whether this works right if we pick a name from
 330 a functionally-dependent part of the instance decl.  E.g.
 331
 332   module M where { class C a b | a -> b }
 333
 334 and suppose we are compiling module X:
 335
 336   module X where
 337         import M
 338         data S  = ...
 339         data T = ...
 340         instance C S T where ...
 341
 342 If we base the instance verion on T, I'm worried that changing S to S'
 343 would change T's version, but not S or S'.  But an importing module might
 344 not depend on T, and so might not be recompiled even though the new instance
 345 (C S' T) might be relevant.  I have not been able to make a concrete example,
 346 and it seems deeply obscure, so I'm going to leave it for now.
 347
 348
 349 Note [Versioning of rules]
 350 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 351 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
 352 n appears on the LHS of the rule; any change in the rule changes the version of n.
 353
 354
 355 \begin{code}
 356 -- -----------------------------------------------------------------------------
 357 -- Utils on IfaceSyn
 358
 359 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
 360 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
 361 -- Deeply revolting, because it has to predict what gets bound,
 362 -- especially the question of whether there's a wrapper for a datacon
 363
 364 -- N.B. the set of names returned here *must* match the set of
 365 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
 366 -- TyThing.getOccName should define a bijection between the two lists.
 367 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
 368 -- The order of the list does not matter.
 369 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}  = []
 370
 371 -- Newtype
 372 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 373                               ifCons = IfNewTyCon (
 374                                         IfCon { ifConOcc = con_occ }),
 375                               ifFamInst = famInst})
 376   =   -- implicit coerion and (possibly) family instance coercion
 377     (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
 378       -- data constructor and worker (newtypes don't have a wrapper)
 379     [con_occ, mkDataConWorkerOcc con_occ]
 380
 381
 382 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 383                               ifCons = IfDataTyCon cons,
 384                               ifFamInst = famInst})
 385   =   -- (possibly) family instance coercion;
 386       -- there is no implicit coercion for non-newtypes
 387     famInstCo famInst tc_occ
 388       -- for each data constructor in order,
 389       --    data constructor, worker, and (possibly) wrapper
 390     ++ concatMap dc_occs cons
 391   where
 392     dc_occs con_decl
 393         | has_wrapper = [con_occ, work_occ, wrap_occ]
 394         | otherwise   = [con_occ, work_occ]
 395         where
 396           con_occ  = ifConOcc con_decl                  -- DataCon namespace
 397           wrap_occ = mkDataConWrapperOcc con_occ        -- Id namespace
 398           work_occ = mkDataConWorkerOcc con_occ         -- Id namespace
 399           has_wrapper = ifConWrapper con_decl           -- This is the reason for
 400                                                         -- having the ifConWrapper field!
 401
 402 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
 403                                ifSigs = sigs, ifATs = ats })
 404   = -- dictionary datatype:
 405     --   type constructor
 406     tc_occ :
 407     --   (possibly) newtype coercion
 408     co_occs ++
 409     --    data constructor (DataCon namespace)
 410     --    data worker (Id namespace)
 411     --    no wrapper (class dictionaries never have a wrapper)
 412     [dc_occ, dcww_occ] ++
 413     -- associated types
 414     [ifName at | at <- ats ] ++
 415     -- superclass selectors
 416     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
 417     -- operation selectors
 418     [op | IfaceClassOp op  _ _ <- sigs]
 419   where
 420     n_ctxt = length sc_ctxt
 421     n_sigs = length sigs
 422     tc_occ  = mkClassTyConOcc cls_occ
 423     dc_occ  = mkClassDataConOcc cls_occ
 424     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
 425             | otherwise  = []
 426     dcww_occ = mkDataConWorkerOcc dc_occ
 427     is_newtype = n_sigs + n_ctxt == 1                   -- Sigh
 428
 429 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
 430                              ifFamInst = famInst})
 431   = famInstCo famInst tc_occ
 432
 433 ifaceDeclSubBndrs _ = []
 434
 435 -- coercion for data/newtype family instances
 436 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
 437 famInstCo Nothing  _       = []
 438 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
 439
 440 ----------------------------- Printing IfaceDecl ------------------------------
 441
 442 instance Outputable IfaceDecl where
 443   ppr = pprIfaceDecl
 444
 445 pprIfaceDecl :: IfaceDecl -> SDoc
 446 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
 447                        ifIdDetails = details, ifIdInfo = info})
 448   = sep [ ppr var <+> dcolon <+> ppr ty,
 449           nest 2 (ppr details),
 450           nest 2 (ppr info) ]
 451
 452 pprIfaceDecl (IfaceForeign {ifName = tycon})
 453   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 454
 455 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 456                         ifSynRhs = Just mono_ty,
 457                         ifFamInst = mbFamInst})
 458   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
 459        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 460
 461 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 462                         ifSynRhs = Nothing, ifSynKind = kind })
 463   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
 464        4 (dcolon <+> ppr kind)
 465
 466 pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
 467                          ifTyVars = tyvars, ifCons = condecls,
 468                          ifRec = isrec, ifFamInst = mbFamInst})
 469   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
 470        4 (vcat [pprRec isrec, pp_condecls tycon condecls,
 471                 pprFamily mbFamInst])
 472   where
 473     pp_nd = case condecls of
 474                 IfAbstractTyCon -> ptext (sLit "data")
 475                 IfOpenDataTyCon -> ptext (sLit "data family")
 476                 IfDataTyCon _   -> ptext (sLit "data")
 477                 IfNewTyCon _    -> ptext (sLit "newtype")
 478
 479 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
 480                           ifFDs = fds, ifATs = ats, ifSigs = sigs,
 481                           ifRec = isrec})
 482   = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
 483        4 (vcat [pprRec isrec,
 484                 sep (map ppr ats),
 485                 sep (map ppr sigs)])
 486
 487 pprRec :: RecFlag -> SDoc
 488 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
 489
 490 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
 491 pprFamily Nothing        = ptext (sLit "FamilyInstance: none")
 492 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
 493
 494 instance Outputable IfaceClassOp where
 495    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
 496
 497 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
 498 pprIfaceDeclHead context thing tyvars
 499   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
 500           pprIfaceTvBndrs tyvars]
 501
 502 pp_condecls :: OccName -> IfaceConDecls -> SDoc
 503 pp_condecls _  IfAbstractTyCon  = ptext (sLit "{- abstract -}")
 504 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
 505 pp_condecls _  IfOpenDataTyCon  = empty
 506 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
 507                                                              (map (pprIfaceConDecl tc) cs))
 508
 509 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 510 pprIfaceConDecl tc
 511         (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
 512                  ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
 513                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
 514                  ifConStricts = strs, ifConFields = fields })
 515   = sep [main_payload,
 516          if is_infix then ptext (sLit "Infix") else empty,
 517          if has_wrap then ptext (sLit "HasWrapper") else empty,
 518          ppUnless (null strs) $
 519             nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
 520          ppUnless (null fields) $
 521             nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
 522   where
 523     ppr_bang HsNoBang = char '_'        -- Want to see these
 524     ppr_bang bang     = ppr bang
 525
 526     main_payload = ppr name <+> dcolon <+>
 527                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 528
 529     eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
 530               | (tv,ty) <- eq_spec]
 531
 532         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
 533         -- because we don't have a Name for the tycon, only an OccName
 534     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
 535                 (t:ts) -> fsep (t : map (arrow <+>) ts)
 536                 []     -> panic "pp_con_taus"
 537
 538     pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
 539
 540 instance Outputable IfaceRule where
 541   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 542                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
 543     = sep [hsep [doubleQuotes (ftext name), ppr act,
 544                  ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
 545            nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
 546                         ptext (sLit "=") <+> ppr rhs])
 547       ]
 548
 549 instance Outputable IfaceInst where
 550   ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
 551                   ifInstCls = cls, ifInstTys = mb_tcs})
 552     = hang (ptext (sLit "instance") <+> ppr flag
 553                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
 554          2 (equals <+> ppr dfun_id)
 555
 556 instance Outputable IfaceFamInst where
 557   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
 558                      ifFamInstTyCon = tycon_id})
 559     = hang (ptext (sLit "family instance") <+>
 560             ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
 561          2 (equals <+> ppr tycon_id)
 562
 563 ppr_rough :: Maybe IfaceTyCon -> SDoc
 564 ppr_rough Nothing   = dot
 565 ppr_rough (Just tc) = ppr tc
 566 \end{code}
 567
 568
 569 ----------------------------- Printing IfaceExpr ------------------------------------
 570
 571 \begin{code}
 572 instance Outputable IfaceExpr where
 573     ppr e = pprIfaceExpr noParens e
 574
 575 pprParendIfaceExpr :: IfaceExpr -> SDoc
 576 pprParendIfaceExpr = pprIfaceExpr parens
 577
 578 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
 579         -- The function adds parens in context that need
 580         -- an atomic value (e.g. function args)
 581
 582 pprIfaceExpr _       (IfaceLcl v)       = ppr v
 583 pprIfaceExpr _       (IfaceExt v)       = ppr v
 584 pprIfaceExpr _       (IfaceLit l)       = ppr l
 585 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 586 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 587 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 588
 589 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 590 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 591
 592 pprIfaceExpr add_par e@(IfaceLam _ _)
 593   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
 594                   pprIfaceExpr noParens body])
 595   where
 596     (bndrs,body) = collect [] e
 597     collect bs (IfaceLam b e) = collect (b:bs) e
 598     collect bs e              = (reverse bs, e)
 599
 600 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
 601   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 602                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 603                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
 604                   pprIfaceExpr noParens rhs <+> char '}'])
 605
 606 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
 607   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 608                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 609                         <+> ppr bndr <+> char '{',
 610                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 611
 612 pprIfaceExpr _       (IfaceCast expr co)
 613   = sep [pprParendIfaceExpr expr,
 614          nest 2 (ptext (sLit "`cast`")),
 615          pprParendIfaceType co]
 616
 617 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
 618   = add_par (sep [ptext (sLit "let {"),
 619                   nest 2 (ppr_bind (b, rhs)),
 620                   ptext (sLit "} in"),
 621                   pprIfaceExpr noParens body])
 622
 623 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
 624   = add_par (sep [ptext (sLit "letrec {"),
 625                   nest 2 (sep (map ppr_bind pairs)),
 626                   ptext (sLit "} in"),
 627                   pprIfaceExpr noParens body])
 628
 629 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
 630
 631 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
 632 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
 633                               arrow <+> pprIfaceExpr noParens rhs]
 634
 635 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
 636 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 637 ppr_con_bs con bs                     = ppr con <+> hsep (map ppr bs)
 638
 639 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
 640 ppr_bind (IfLetBndr b ty info, rhs)
 641   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
 642          equals <+> pprIfaceExpr noParens rhs]
 643
 644 ------------------
 645 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
 646 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
 647 pprIfaceApp fun                args = sep (pprParendIfaceExpr fun : args)
 648
 649 ------------------
 650 instance Outputable IfaceNote where
 651     ppr (IfaceSCC cc)     = pprCostCentreCore cc
 652     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 653
 654
 655 instance Outputable IfaceConAlt where
 656     ppr IfaceDefault      = text "DEFAULT"
 657     ppr (IfaceLitAlt l)   = ppr l
 658     ppr (IfaceDataAlt d)  = ppr d
 659     ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
 660     -- IfaceTupleAlt is handled by the case-alternative printer
 661
 662 ------------------
 663 instance Outputable IfaceIdDetails where
 664   ppr IfVanillaId    = empty
 665   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
 666                           <+> if b then ptext (sLit "<naughty>") else empty
 667   ppr (IfDFunId ns)     = ptext (sLit "DFunId") <> brackets (int ns)
 668
 669 instance Outputable IfaceIdInfo where
 670   ppr NoInfo       = empty
 671   ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
 672
 673 instance Outputable IfaceInfoItem where
 674   ppr (HsUnfold lb unf)  = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
 675                            <> colon <+> ppr unf
 676   ppr (HsInline prag)    = ptext (sLit "Inline:") <+> ppr prag
 677   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
 678   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
 679   ppr HsNoCafRefs        = ptext (sLit "HasNoCafRefs")
 680
 681 instance Outputable IfaceUnfolding where
 682   ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
 683   ppr (IfCoreUnfold s e)   = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
 684   ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
 685                                         pprParendIfaceExpr e]
 686   ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
 687                              <+> parens (ptext (sLit "arity") <+> int a)
 688   ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
 689                              <+> parens (ptext (sLit "arity") <+> int a)
 690   ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:")
 691                              <+> brackets (pprWithCommas ppr ns)
 692
 693 -- -----------------------------------------------------------------------------
 694 -- Finding the Names in IfaceSyn
 695
 696 -- This is used for dependency analysis in MkIface, so that we
 697 -- fingerprint a declaration before the things that depend on it.  It
 698 -- is specific to interface-file fingerprinting in the sense that we
 699 -- don't collect *all* Names: for example, the DFun of an instance is
 700 -- recorded textually rather than by its fingerprint when
 701 -- fingerprinting the instance, so DFuns are not dependencies.
 702
 703 freeNamesIfDecl :: IfaceDecl -> NameSet
 704 freeNamesIfDecl (IfaceId _s t d i) =
 705   freeNamesIfType t &&&
 706   freeNamesIfIdInfo i &&&
 707   freeNamesIfIdDetails d
 708 freeNamesIfDecl IfaceForeign{} =
 709   emptyNameSet
 710 freeNamesIfDecl d@IfaceData{} =
 711   freeNamesIfTvBndrs (ifTyVars d) &&&
 712   freeNamesIfTcFam (ifFamInst d) &&&
 713   freeNamesIfContext (ifCtxt d) &&&
 714   freeNamesIfConDecls (ifCons d)
 715 freeNamesIfDecl d@IfaceSyn{} =
 716   freeNamesIfTvBndrs (ifTyVars d) &&&
 717   freeNamesIfSynRhs (ifSynRhs d) &&&
 718   freeNamesIfTcFam (ifFamInst d)
 719 freeNamesIfDecl d@IfaceClass{} =
 720   freeNamesIfTvBndrs (ifTyVars d) &&&
 721   freeNamesIfContext (ifCtxt d) &&&
 722   freeNamesIfDecls   (ifATs d) &&&
 723   fnList freeNamesIfClsSig (ifSigs d)
 724
 725 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
 726 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
 727 freeNamesIfIdDetails _                 = emptyNameSet
 728
 729 -- All other changes are handled via the version info on the tycon
 730 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
 731 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
 732 freeNamesIfSynRhs Nothing   = emptyNameSet
 733
 734 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
 735 freeNamesIfTcFam (Just (tc,tys)) =
 736   freeNamesIfTc tc &&& fnList freeNamesIfType tys
 737 freeNamesIfTcFam Nothing =
 738   emptyNameSet
 739
 740 freeNamesIfContext :: IfaceContext -> NameSet
 741 freeNamesIfContext = fnList freeNamesIfPredType
 742
 743 freeNamesIfDecls :: [IfaceDecl] -> NameSet
 744 freeNamesIfDecls = fnList freeNamesIfDecl
 745
 746 freeNamesIfClsSig :: IfaceClassOp -> NameSet
 747 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
 748
 749 freeNamesIfConDecls :: IfaceConDecls -> NameSet
 750 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
 751 freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
 752 freeNamesIfConDecls _               = emptyNameSet
 753
 754 freeNamesIfConDecl :: IfaceConDecl -> NameSet
 755 freeNamesIfConDecl c =
 756   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
 757   freeNamesIfTvBndrs (ifConExTvs c) &&&
 758   freeNamesIfContext (ifConCtxt c) &&&
 759   fnList freeNamesIfType (ifConArgTys c) &&&
 760   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 761
 762 freeNamesIfPredType :: IfacePredType -> NameSet
 763 freeNamesIfPredType (IfaceClassP cl tys) =
 764    unitNameSet cl &&& fnList freeNamesIfType tys
 765 freeNamesIfPredType (IfaceIParam _n ty) =
 766    freeNamesIfType ty
 767 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
 768    freeNamesIfType ty1 &&& freeNamesIfType ty2
 769
 770 freeNamesIfType :: IfaceType -> NameSet
 771 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 772 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 773 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
 774 freeNamesIfType (IfaceTyConApp tc ts) =
 775    freeNamesIfTc tc &&& fnList freeNamesIfType ts
 776 freeNamesIfType (IfaceForAllTy tv t)  =
 777    freeNamesIfTvBndr tv &&& freeNamesIfType t
 778 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 779
 780 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
 781 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
 782
 783 freeNamesIfBndr :: IfaceBndr -> NameSet
 784 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
 785 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
 786
 787 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
 788 -- Remember IfaceLetBndr is used only for *nested* bindings
 789 -- The IdInfo can contain an unfolding (in the case of
 790 -- local INLINE pragmas), so look there too
 791 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
 792                                              &&& freeNamesIfIdInfo info
 793
 794 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
 795 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
 796     -- kinds can have Names inside, when the Kind is an equality predicate
 797
 798 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
 799 freeNamesIfIdBndr = freeNamesIfTvBndr
 800
 801 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 802 freeNamesIfIdInfo NoInfo = emptyNameSet
 803 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 804
 805 freeNamesItem :: IfaceInfoItem -> NameSet
 806 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
 807 freeNamesItem _              = emptyNameSet
 808
 809 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
 810 freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
 811 freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 812 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 813 freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
 814 freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
 815 freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)
 816
 817 freeNamesIfExpr :: IfaceExpr -> NameSet
 818 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
 819 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 820 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 821 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
 822 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
 823 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
 824 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
 825 freeNamesIfExpr (IfaceNote _n r)   = freeNamesIfExpr r
 826
 827 freeNamesIfExpr (IfaceCase s _ ty alts)
 828   = freeNamesIfExpr s
 829     &&& fnList fn_alt alts &&& fn_cons alts
 830     &&& freeNamesIfType ty
 831   where
 832     fn_alt (_con,_bs,r) = freeNamesIfExpr r
 833
 834     -- Depend on the data constructors.  Just one will do!
 835     -- Note [Tracking data constructors]
 836     fn_cons []                              = emptyNameSet
 837     fn_cons ((IfaceDefault    ,_,_) : alts) = fn_cons alts
 838     fn_cons ((IfaceDataAlt con,_,_) : _   ) = unitNameSet con
 839     fn_cons (_                      : _   ) = emptyNameSet
 840
 841 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
 842   = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
 843
 844 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 845   = fnList fn_pair as &&& freeNamesIfExpr x
 846   where
 847     fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
 848
 849 freeNamesIfExpr _ = emptyNameSet
 850
 851 freeNamesIfTc :: IfaceTyCon -> NameSet
 852 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 853 -- ToDo: shouldn't we include IfaceIntTc & co.?
 854 freeNamesIfTc _ = emptyNameSet
 855
 856 freeNamesIfRule :: IfaceRule -> NameSet
 857 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
 858                            , ifRuleArgs = es, ifRuleRhs = rhs })
 859   = unitNameSet f &&&
 860     fnList freeNamesIfBndr bs &&&
 861     fnList freeNamesIfExpr es &&&
 862     freeNamesIfExpr rhs
 863
 864 -- helpers
 865 (&&&) :: NameSet -> NameSet -> NameSet
 866 (&&&) = unionNameSets
 867
 868 fnList :: (a -> NameSet) -> [a] -> NameSet
 869 fnList f = foldr (&&&) emptyNameSet . map f
 870 \end{code}
 871
 872 Note [Tracking data constructors]
 873 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 874 In a case expression
 875    case e of { C a -> ...; ... }
 876 You might think that we don't need to include the datacon C
 877 in the free names, because its type will probably show up in
 878 the free names of 'e'.  But in rare circumstances this may
 879 not happen.   Here's the one that bit me:
 880
 881    module DynFlags where
 882      import {-# SOURCE #-} Packages( PackageState )
 883      data DynFlags = DF ... PackageState ...
 884
 885    module Packages where
 886      import DynFlags
 887      data PackageState = PS ...
 888      lookupModule (df :: DynFlags)
 889         = case df of
 890               DF ...p... -> case p of
 891                                PS ... -> ...
 892
 893 Now, lookupModule depends on DynFlags, but the transitive dependency
 894 on the *locally-defined* type PackageState is not visible. We need
 895 to take account of the use of the data constructor PS in the pattern match.