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