compiler/iface/IfaceSyn.lhs

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