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