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 NewDemand
  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     IfaceUnfolding
 206   | HsNoCafRefs
 207
 208 -- NB: Specialisations and rules come in separately and are
 209 -- only later attached to the Id.  Partial reason: some are orphans.
 210
 211 data IfaceUnfolding
 212   = IfCoreUnfold IfaceExpr
 213   | IfInlineRule Arity
 214                  Bool           -- Sat/UnSat
 215                  IfaceExpr
 216   | IfWrapper    Arity Name       -- NB: we need a Name (not just OccName) because the worker
 217                                   --     can simplify to a function in another module.
 218   | IfDFunUnfold [IfaceExpr]
 219
 220 --------------------------------
 221 data IfaceExpr
 222   = IfaceLcl    FastString
 223   | IfaceExt    Name
 224   | IfaceType   IfaceType
 225   | IfaceTuple  Boxity [IfaceExpr]              -- Saturated; type arguments omitted
 226   | IfaceLam    IfaceBndr IfaceExpr
 227   | IfaceApp    IfaceExpr IfaceExpr
 228   | IfaceCase   IfaceExpr FastString IfaceType [IfaceAlt]
 229   | IfaceLet    IfaceBinding  IfaceExpr
 230   | IfaceNote   IfaceNote IfaceExpr
 231   | IfaceCast   IfaceExpr IfaceCoercion
 232   | IfaceLit    Literal
 233   | IfaceFCall  ForeignCall IfaceType
 234   | IfaceTick   Module Int
 235
 236 data IfaceNote = IfaceSCC CostCentre
 237                | IfaceCoreNote String
 238
 239 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
 240         -- Note: FastString, not IfaceBndr (and same with the case binder)
 241         -- We reconstruct the kind/type of the thing from the context
 242         -- thus saving bulk in interface files
 243
 244 data IfaceConAlt = IfaceDefault
 245                  | IfaceDataAlt Name
 246                  | IfaceTupleAlt Boxity
 247                  | IfaceLitAlt Literal
 248
 249 data IfaceBinding
 250   = IfaceNonRec IfaceLetBndr IfaceExpr
 251   | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
 252
 253 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 254 -- It's used for *non-top-level* let/rec binders
 255 -- See Note [IdInfo on nested let-bindings]
 256 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
 257 \end{code}
 258
 259 Note [IdInfo on nested let-bindings]
 260 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 261 Occasionally we want to preserve IdInfo on nested let bindings. The one
 262 that came up was a NOINLINE pragma on a let-binding inside an INLINE
 263 function.  The user (Duncan Coutts) really wanted the NOINLINE control
 264 to cross the separate compilation boundary.
 265
 266 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
 267 Currently we only actually retain InlinePragInfo, but in principle we could
 268 add strictness etc.
 269
 270
 271 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
 272 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 273 If a module contains any "orphans", then its interface file is read
 274 regardless, so that its instances are not missed.
 275
 276 Roughly speaking, an instance is an orphan if its head (after the =>)
 277 mentions nothing defined in this module.  Functional dependencies
 278 complicate the situation though. Consider
 279
 280   module M where { class C a b | a -> b }
 281
 282 and suppose we are compiling module X:
 283
 284   module X where
 285         import M
 286         data T = ...
 287         instance C Int T where ...
 288
 289 This instance is an orphan, because when compiling a third module Y we
 290 might get a constraint (C Int v), and we'd want to improve v to T.  So
 291 we must make sure X's instances are loaded, even if we do not directly
 292 use anything from X.
 293
 294 More precisely, an instance is an orphan iff
 295
 296   If there are no fundeps, then at least of the names in
 297   the instance head is locally defined.
 298
 299   If there are fundeps, then for every fundep, at least one of the
 300   names free in a *non-determined* part of the instance head is
 301   defined in this module.
 302
 303 (Note that these conditions hold trivially if the class is locally
 304 defined.)
 305
 306 Note [Versioning of instances]
 307 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 308 Now consider versioning.  If we *use* an instance decl in one compilation,
 309 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
 310 But suppose we *don't* (currently) use an instance!  We must recompile if
 311 the instance is changed in such a way that it becomes important.  (This would
 312 only matter with overlapping instances, else the importing module wouldn't have
 313 compiled before and the recompilation check is irrelevant.)
 314
 315 The is_orph field is set to (Just n) if the instance is not an orphan.
 316 The 'n' is *any* of the locally-defined names mentioned anywhere in the
 317 instance head.  This name is used for versioning; the instance decl is
 318 considered part of the defn of this 'n'.
 319
 320 I'm worried about whether this works right if we pick a name from
 321 a functionally-dependent part of the instance decl.  E.g.
 322
 323   module M where { class C a b | a -> b }
 324
 325 and suppose we are compiling module X:
 326
 327   module X where
 328         import M
 329         data S  = ...
 330         data T = ...
 331         instance C S T where ...
 332
 333 If we base the instance verion on T, I'm worried that changing S to S'
 334 would change T's version, but not S or S'.  But an importing module might
 335 not depend on T, and so might not be recompiled even though the new instance
 336 (C S' T) might be relevant.  I have not been able to make a concrete example,
 337 and it seems deeply obscure, so I'm going to leave it for now.
 338
 339
 340 Note [Versioning of rules]
 341 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 342 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
 343 n appears on the LHS of the rule; any change in the rule changes the version of n.
 344
 345
 346 \begin{code}
 347 -- -----------------------------------------------------------------------------
 348 -- Utils on IfaceSyn
 349
 350 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
 351 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
 352 -- Deeply revolting, because it has to predict what gets bound,
 353 -- especially the question of whether there's a wrapper for a datacon
 354
 355 -- N.B. the set of names returned here *must* match the set of
 356 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
 357 -- TyThing.getOccName should define a bijection between the two lists.
 358 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
 359 -- The order of the list does not matter.
 360 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}  = []
 361
 362 -- Newtype
 363 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 364                               ifCons = IfNewTyCon (
 365                                         IfCon { ifConOcc = con_occ }),
 366                               ifFamInst = famInst})
 367   =   -- implicit coerion and (possibly) family instance coercion
 368     (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
 369       -- data constructor and worker (newtypes don't have a wrapper)
 370     [con_occ, mkDataConWorkerOcc con_occ]
 371
 372
 373 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 374                               ifCons = IfDataTyCon cons,
 375                               ifFamInst = famInst})
 376   =   -- (possibly) family instance coercion;
 377       -- there is no implicit coercion for non-newtypes
 378     famInstCo famInst tc_occ
 379       -- for each data constructor in order,
 380       --    data constructor, worker, and (possibly) wrapper
 381     ++ concatMap dc_occs cons
 382   where
 383     dc_occs con_decl
 384         | has_wrapper = [con_occ, work_occ, wrap_occ]
 385         | otherwise   = [con_occ, work_occ]
 386         where
 387           con_occ  = ifConOcc con_decl                  -- DataCon namespace
 388           wrap_occ = mkDataConWrapperOcc con_occ        -- Id namespace
 389           work_occ = mkDataConWorkerOcc con_occ         -- Id namespace
 390           has_wrapper = ifConWrapper con_decl           -- This is the reason for
 391                                                         -- having the ifConWrapper field!
 392
 393 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
 394                                ifSigs = sigs, ifATs = ats })
 395   = -- dictionary datatype:
 396     --   type constructor
 397     tc_occ :
 398     --   (possibly) newtype coercion
 399     co_occs ++
 400     --    data constructor (DataCon namespace)
 401     --    data worker (Id namespace)
 402     --    no wrapper (class dictionaries never have a wrapper)
 403     [dc_occ, dcww_occ] ++
 404     -- associated types
 405     [ifName at | at <- ats ] ++
 406     -- superclass selectors
 407     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
 408     -- operation selectors
 409     [op | IfaceClassOp op  _ _ <- sigs]
 410   where
 411     n_ctxt = length sc_ctxt
 412     n_sigs = length sigs
 413     tc_occ  = mkClassTyConOcc cls_occ
 414     dc_occ  = mkClassDataConOcc cls_occ
 415     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
 416             | otherwise  = []
 417     dcww_occ = mkDataConWorkerOcc dc_occ
 418     is_newtype = n_sigs + n_ctxt == 1                   -- Sigh
 419
 420 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
 421                              ifFamInst = famInst})
 422   = famInstCo famInst tc_occ
 423
 424 ifaceDeclSubBndrs _ = []
 425
 426 -- coercion for data/newtype family instances
 427 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
 428 famInstCo Nothing  _       = []
 429 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
 430
 431 ----------------------------- Printing IfaceDecl ------------------------------
 432
 433 instance Outputable IfaceDecl where
 434   ppr = pprIfaceDecl
 435
 436 pprIfaceDecl :: IfaceDecl -> SDoc
 437 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
 438                        ifIdDetails = details, ifIdInfo = info})
 439   = sep [ ppr var <+> dcolon <+> ppr ty,
 440           nest 2 (ppr details),
 441           nest 2 (ppr info) ]
 442
 443 pprIfaceDecl (IfaceForeign {ifName = tycon})
 444   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 445
 446 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 447                         ifSynRhs = Just mono_ty,
 448                         ifFamInst = mbFamInst})
 449   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
 450        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 451
 452 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 453                         ifSynRhs = Nothing, ifSynKind = kind })
 454   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
 455        4 (dcolon <+> ppr kind)
 456
 457 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
 458                          ifTyVars = tyvars, ifCons = condecls,
 459                          ifRec = isrec, ifFamInst = mbFamInst})
 460   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
 461        4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
 462                 pprFamily mbFamInst])
 463   where
 464     pp_nd = case condecls of
 465                 IfAbstractTyCon -> ptext (sLit "data")
 466                 IfOpenDataTyCon -> ptext (sLit "data family")
 467                 IfDataTyCon _   -> ptext (sLit "data")
 468                 IfNewTyCon _    -> ptext (sLit "newtype")
 469
 470 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
 471                           ifFDs = fds, ifATs = ats, ifSigs = sigs,
 472                           ifRec = isrec})
 473   = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
 474        4 (vcat [pprRec isrec,
 475                 sep (map ppr ats),
 476                 sep (map ppr sigs)])
 477
 478 pprRec :: RecFlag -> SDoc
 479 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
 480
 481 pprGen :: Bool -> SDoc
 482 pprGen True  = ptext (sLit "Generics: yes")
 483 pprGen False = ptext (sLit "Generics: no")
 484
 485 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
 486 pprFamily Nothing        = ptext (sLit "FamilyInstance: none")
 487 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
 488
 489 instance Outputable IfaceClassOp where
 490    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
 491
 492 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
 493 pprIfaceDeclHead context thing tyvars
 494   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
 495           pprIfaceTvBndrs tyvars]
 496
 497 pp_condecls :: OccName -> IfaceConDecls -> SDoc
 498 pp_condecls _  IfAbstractTyCon  = ptext (sLit "{- abstract -}")
 499 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
 500 pp_condecls _  IfOpenDataTyCon  = empty
 501 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
 502                                                              (map (pprIfaceConDecl tc) cs))
 503
 504 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 505 pprIfaceConDecl tc
 506         (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
 507                  ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
 508                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
 509                  ifConStricts = strs, ifConFields = fields })
 510   = sep [main_payload,
 511          if is_infix then ptext (sLit "Infix") else empty,
 512          if has_wrap then ptext (sLit "HasWrapper") else empty,
 513          ppUnless (null strs) $
 514             nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
 515          ppUnless (null fields) $
 516             nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
 517   where
 518     main_payload = ppr name <+> dcolon <+>
 519                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 520
 521     eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
 522               | (tv,ty) <- eq_spec]
 523
 524         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
 525         -- because we don't have a Name for the tycon, only an OccName
 526     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
 527                 (t:ts) -> fsep (t : map (arrow <+>) ts)
 528                 []     -> panic "pp_con_taus"
 529
 530     pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
 531
 532 instance Outputable IfaceRule where
 533   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 534                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
 535     = sep [hsep [doubleQuotes (ftext name), ppr act,
 536                  ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
 537            nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
 538                         ptext (sLit "=") <+> ppr rhs])
 539       ]
 540
 541 instance Outputable IfaceInst where
 542   ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
 543                   ifInstCls = cls, ifInstTys = mb_tcs})
 544     = hang (ptext (sLit "instance") <+> ppr flag
 545                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
 546          2 (equals <+> ppr dfun_id)
 547
 548 instance Outputable IfaceFamInst where
 549   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
 550                      ifFamInstTyCon = tycon_id})
 551     = hang (ptext (sLit "family instance") <+>
 552             ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
 553          2 (equals <+> ppr tycon_id)
 554
 555 ppr_rough :: Maybe IfaceTyCon -> SDoc
 556 ppr_rough Nothing   = dot
 557 ppr_rough (Just tc) = ppr tc
 558 \end{code}
 559
 560
 561 ----------------------------- Printing IfaceExpr ------------------------------------
 562
 563 \begin{code}
 564 instance Outputable IfaceExpr where
 565     ppr e = pprIfaceExpr noParens e
 566
 567 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
 568         -- The function adds parens in context that need
 569         -- an atomic value (e.g. function args)
 570
 571 pprIfaceExpr _       (IfaceLcl v)       = ppr v
 572 pprIfaceExpr _       (IfaceExt v)       = ppr v
 573 pprIfaceExpr _       (IfaceLit l)       = ppr l
 574 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 575 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 576 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 577
 578 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 579 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 580
 581 pprIfaceExpr add_par e@(IfaceLam _ _)
 582   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
 583                   pprIfaceExpr noParens body])
 584   where
 585     (bndrs,body) = collect [] e
 586     collect bs (IfaceLam b e) = collect (b:bs) e
 587     collect bs e              = (reverse bs, e)
 588
 589 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
 590   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 591                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 592                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
 593                   pprIfaceExpr noParens rhs <+> char '}'])
 594
 595 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
 596   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 597                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 598                         <+> ppr bndr <+> char '{',
 599                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 600
 601 pprIfaceExpr _       (IfaceCast expr co)
 602   = sep [pprIfaceExpr parens expr,
 603          nest 2 (ptext (sLit "`cast`")),
 604          pprParendIfaceType co]
 605
 606 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
 607   = add_par (sep [ptext (sLit "let {"),
 608                   nest 2 (ppr_bind (b, rhs)),
 609                   ptext (sLit "} in"),
 610                   pprIfaceExpr noParens body])
 611
 612 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
 613   = add_par (sep [ptext (sLit "letrec {"),
 614                   nest 2 (sep (map ppr_bind pairs)),
 615                   ptext (sLit "} in"),
 616                   pprIfaceExpr noParens body])
 617
 618 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
 619
 620 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
 621 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
 622                               arrow <+> pprIfaceExpr noParens rhs]
 623
 624 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
 625 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 626 ppr_con_bs con bs                     = ppr con <+> hsep (map ppr bs)
 627
 628 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
 629 ppr_bind (IfLetBndr b ty info, rhs)
 630   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
 631          equals <+> pprIfaceExpr noParens rhs]
 632
 633 ------------------
 634 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
 635 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
 636 pprIfaceApp fun                args = sep (pprIfaceExpr parens fun : args)
 637
 638 ------------------
 639 instance Outputable IfaceNote where
 640     ppr (IfaceSCC cc)     = pprCostCentreCore cc
 641     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 642
 643
 644 instance Outputable IfaceConAlt where
 645     ppr IfaceDefault      = text "DEFAULT"
 646     ppr (IfaceLitAlt l)   = ppr l
 647     ppr (IfaceDataAlt d)  = ppr d
 648     ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
 649     -- IfaceTupleAlt is handled by the case-alternative printer
 650
 651 ------------------
 652 instance Outputable IfaceIdDetails where
 653   ppr IfVanillaId    = empty
 654   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
 655                           <+> if b then ptext (sLit "<naughty>") else empty
 656   ppr IfDFunId       = ptext (sLit "DFunId")
 657
 658 instance Outputable IfaceIdInfo where
 659   ppr NoInfo       = empty
 660   ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
 661
 662 instance Outputable IfaceInfoItem where
 663   ppr (HsUnfold unf)     = ptext (sLit "Unfolding:") <+> ppr unf
 664   ppr (HsInline prag)    = ptext (sLit "Inline:") <+> ppr prag
 665   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
 666   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
 667   ppr HsNoCafRefs        = ptext (sLit "HasNoCafRefs")
 668
 669 instance Outputable IfaceUnfolding where
 670   ppr (IfCoreUnfold e)     = parens (ppr e)
 671   ppr (IfInlineRule a b e) = ptext (sLit "InlineRule:")
 672                              <+> parens (ptext (sLit "arity") <+> int a <+> ppr b)
 673                              <+> parens (ppr e)
 674   ppr (IfWrapper a wkr)    = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
 675   ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:") <+> brackets (pprWithCommas (pprIfaceExpr parens) ns)
 676
 677
 678 -- -----------------------------------------------------------------------------
 679 -- Finding the Names in IfaceSyn
 680
 681 -- This is used for dependency analysis in MkIface, so that we
 682 -- fingerprint a declaration before the things that depend on it.  It
 683 -- is specific to interface-file fingerprinting in the sense that we
 684 -- don't collect *all* Names: for example, the DFun of an instance is
 685 -- recorded textually rather than by its fingerprint when
 686 -- fingerprinting the instance, so DFuns are not dependencies.
 687
 688 freeNamesIfDecl :: IfaceDecl -> NameSet
 689 freeNamesIfDecl (IfaceId _s t d i) =
 690   freeNamesIfType t &&&
 691   freeNamesIfIdInfo i &&&
 692   freeNamesIfIdDetails d
 693 freeNamesIfDecl IfaceForeign{} =
 694   emptyNameSet
 695 freeNamesIfDecl d@IfaceData{} =
 696   freeNamesIfTvBndrs (ifTyVars d) &&&
 697   freeNamesIfTcFam (ifFamInst d) &&&
 698   freeNamesIfContext (ifCtxt d) &&&
 699   freeNamesIfConDecls (ifCons d)
 700 freeNamesIfDecl d@IfaceSyn{} =
 701   freeNamesIfTvBndrs (ifTyVars d) &&&
 702   freeNamesIfSynRhs (ifSynRhs d) &&&
 703   freeNamesIfTcFam (ifFamInst d)
 704 freeNamesIfDecl d@IfaceClass{} =
 705   freeNamesIfTvBndrs (ifTyVars d) &&&
 706   freeNamesIfContext (ifCtxt d) &&&
 707   freeNamesIfDecls   (ifATs d) &&&
 708   fnList freeNamesIfClsSig (ifSigs d)
 709
 710 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
 711 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
 712 freeNamesIfIdDetails _                 = emptyNameSet
 713
 714 -- All other changes are handled via the version info on the tycon
 715 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
 716 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
 717 freeNamesIfSynRhs Nothing   = emptyNameSet
 718
 719 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
 720 freeNamesIfTcFam (Just (tc,tys)) =
 721   freeNamesIfTc tc &&& fnList freeNamesIfType tys
 722 freeNamesIfTcFam Nothing =
 723   emptyNameSet
 724
 725 freeNamesIfContext :: IfaceContext -> NameSet
 726 freeNamesIfContext = fnList freeNamesIfPredType
 727
 728 freeNamesIfDecls :: [IfaceDecl] -> NameSet
 729 freeNamesIfDecls = fnList freeNamesIfDecl
 730
 731 freeNamesIfClsSig :: IfaceClassOp -> NameSet
 732 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
 733
 734 freeNamesIfConDecls :: IfaceConDecls -> NameSet
 735 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
 736 freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
 737 freeNamesIfConDecls _               = emptyNameSet
 738
 739 freeNamesIfConDecl :: IfaceConDecl -> NameSet
 740 freeNamesIfConDecl c =
 741   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
 742   freeNamesIfTvBndrs (ifConExTvs c) &&&
 743   freeNamesIfContext (ifConCtxt c) &&&
 744   fnList freeNamesIfType (ifConArgTys c) &&&
 745   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 746
 747 freeNamesIfPredType :: IfacePredType -> NameSet
 748 freeNamesIfPredType (IfaceClassP cl tys) =
 749    unitNameSet cl &&& fnList freeNamesIfType tys
 750 freeNamesIfPredType (IfaceIParam _n ty) =
 751    freeNamesIfType ty
 752 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
 753    freeNamesIfType ty1 &&& freeNamesIfType ty2
 754
 755 freeNamesIfType :: IfaceType -> NameSet
 756 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 757 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 758 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
 759 freeNamesIfType (IfaceTyConApp tc ts) =
 760    freeNamesIfTc tc &&& fnList freeNamesIfType ts
 761 freeNamesIfType (IfaceForAllTy tv t)  =
 762    freeNamesIfTvBndr tv &&& freeNamesIfType t
 763 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 764
 765 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
 766 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
 767
 768 freeNamesIfBndr :: IfaceBndr -> NameSet
 769 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
 770 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
 771
 772 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
 773 -- Remember IfaceLetBndr is used only for *nested* bindings
 774 -- The cut-down IdInfo never contains any Names, but the type may!
 775 freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
 776
 777 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
 778 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
 779     -- kinds can have Names inside, when the Kind is an equality predicate
 780
 781 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
 782 freeNamesIfIdBndr = freeNamesIfTvBndr
 783
 784 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 785 freeNamesIfIdInfo NoInfo = emptyNameSet
 786 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 787
 788 freeNamesItem :: IfaceInfoItem -> NameSet
 789 freeNamesItem (HsUnfold u)     = freeNamesIfUnfold u
 790 freeNamesItem _                = emptyNameSet
 791
 792 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
 793 freeNamesIfUnfold (IfCoreUnfold e)     = freeNamesIfExpr e
 794 freeNamesIfUnfold (IfInlineRule _ _ e) = freeNamesIfExpr e
 795 freeNamesIfUnfold (IfWrapper _ v)      = unitNameSet v
 796 freeNamesIfUnfold (IfDFunUnfold vs)    = fnList freeNamesIfExpr vs
 797
 798 freeNamesIfExpr :: IfaceExpr -> NameSet
 799 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
 800 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 801 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 802 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
 803 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
 804 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
 805 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
 806 freeNamesIfExpr (IfaceNote _n r)   = freeNamesIfExpr r
 807
 808 freeNamesIfExpr (IfaceCase s _ ty alts)
 809   = freeNamesIfExpr s
 810     &&& fnList fn_alt alts &&& fn_cons alts
 811     &&& freeNamesIfType ty
 812   where
 813     fn_alt (_con,_bs,r) = freeNamesIfExpr r
 814
 815     -- Depend on the data constructors.  Just one will do!
 816     -- Note [Tracking data constructors]
 817     fn_cons []                              = emptyNameSet
 818     fn_cons ((IfaceDefault    ,_,_) : alts) = fn_cons alts
 819     fn_cons ((IfaceDataAlt con,_,_) : _   ) = unitNameSet con
 820     fn_cons (_                      : _   ) = emptyNameSet
 821
 822 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
 823   = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
 824
 825 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 826   = fnList fn_pair as &&& freeNamesIfExpr x
 827   where
 828     fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
 829
 830 freeNamesIfExpr _ = emptyNameSet
 831
 832
 833 freeNamesIfTc :: IfaceTyCon -> NameSet
 834 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 835 -- ToDo: shouldn't we include IfaceIntTc & co.?
 836 freeNamesIfTc _ = emptyNameSet
 837
 838 freeNamesIfRule :: IfaceRule -> NameSet
 839 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
 840   = unitNameSet f &&&
 841     fnList freeNamesIfBndr bs &&&
 842     fnList freeNamesIfExpr es &&&
 843     freeNamesIfExpr rhs
 844
 845 -- helpers
 846 (&&&) :: NameSet -> NameSet -> NameSet
 847 (&&&) = unionNameSets
 848
 849 fnList :: (a -> NameSet) -> [a] -> NameSet
 850 fnList f = foldr (&&&) emptyNameSet . map f
 851 \end{code}
 852
 853 Note [Tracking data constructors]
 854 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 855 In a case expression
 856    case e of { C a -> ...; ... }
 857 You might think that we don't need to include the datacon C
 858 in the free names, because its type will probably show up in
 859 the free names of 'e'.  But in rare circumstances this may
 860 not happen.   Here's the one that bit me:
 861
 862    module DynFlags where
 863      import {-# SOURCE #-} Packages( PackageState )
 864      data DynFlags = DF ... PackageState ...
 865
 866    module Packages where
 867      import DynFlags
 868      data PackageState = PS ...
 869      lookupModule (df :: DynFlags)
 870         = case df of
 871               DF ...p... -> case p of
 872                                PS ... -> ...
 873
 874 Now, lookupModule depends on DynFlags, but the transitive dependency
 875 on the *locally-defined* type PackageState is not visible. We need
 876 to take account of the use of the data constructor PS in the pattern match.