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