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 pprParendIfaceExpr 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 pprParendIfaceExpr :: IfaceExpr -> SDoc
 581 pprParendIfaceExpr = pprIfaceExpr parens
 582
 583 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
 584         -- The function adds parens in context that need
 585         -- an atomic value (e.g. function args)
 586
 587 pprIfaceExpr _       (IfaceLcl v)       = ppr v
 588 pprIfaceExpr _       (IfaceExt v)       = ppr v
 589 pprIfaceExpr _       (IfaceLit l)       = ppr l
 590 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 591 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 592 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 593
 594 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 595 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 596
 597 pprIfaceExpr add_par e@(IfaceLam _ _)
 598   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
 599                   pprIfaceExpr noParens body])
 600   where
 601     (bndrs,body) = collect [] e
 602     collect bs (IfaceLam b e) = collect (b:bs) e
 603     collect bs e              = (reverse bs, e)
 604
 605 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
 606   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 607                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 608                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
 609                   pprIfaceExpr noParens rhs <+> char '}'])
 610
 611 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
 612   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 613                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 614                         <+> ppr bndr <+> char '{',
 615                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 616
 617 pprIfaceExpr _       (IfaceCast expr co)
 618   = sep [pprParendIfaceExpr expr,
 619          nest 2 (ptext (sLit "`cast`")),
 620          pprParendIfaceType co]
 621
 622 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
 623   = add_par (sep [ptext (sLit "let {"),
 624                   nest 2 (ppr_bind (b, rhs)),
 625                   ptext (sLit "} in"),
 626                   pprIfaceExpr noParens body])
 627
 628 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
 629   = add_par (sep [ptext (sLit "letrec {"),
 630                   nest 2 (sep (map ppr_bind pairs)),
 631                   ptext (sLit "} in"),
 632                   pprIfaceExpr noParens body])
 633
 634 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
 635
 636 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
 637 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
 638                               arrow <+> pprIfaceExpr noParens rhs]
 639
 640 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
 641 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 642 ppr_con_bs con bs                     = ppr con <+> hsep (map ppr bs)
 643
 644 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
 645 ppr_bind (IfLetBndr b ty info, rhs)
 646   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
 647          equals <+> pprIfaceExpr noParens rhs]
 648
 649 ------------------
 650 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
 651 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
 652 pprIfaceApp fun                args = sep (pprParendIfaceExpr fun : args)
 653
 654 ------------------
 655 instance Outputable IfaceNote where
 656     ppr (IfaceSCC cc)     = pprCostCentreCore cc
 657     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 658
 659
 660 instance Outputable IfaceConAlt where
 661     ppr IfaceDefault      = text "DEFAULT"
 662     ppr (IfaceLitAlt l)   = ppr l
 663     ppr (IfaceDataAlt d)  = ppr d
 664     ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
 665     -- IfaceTupleAlt is handled by the case-alternative printer
 666
 667 ------------------
 668 instance Outputable IfaceIdDetails where
 669   ppr IfVanillaId    = empty
 670   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
 671                           <+> if b then ptext (sLit "<naughty>") else empty
 672   ppr IfDFunId       = ptext (sLit "DFunId")
 673
 674 instance Outputable IfaceIdInfo where
 675   ppr NoInfo       = empty
 676   ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
 677
 678 instance Outputable IfaceInfoItem where
 679   ppr (HsUnfold lb unf)  = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
 680                            <> colon <+> ppr unf
 681   ppr (HsInline prag)    = ptext (sLit "Inline:") <+> ppr prag
 682   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
 683   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
 684   ppr HsNoCafRefs        = ptext (sLit "HasNoCafRefs")
 685
 686 instance Outputable IfaceUnfolding where
 687   ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
 688   ppr (IfCoreUnfold e)     = parens (ppr e)
 689   ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
 690                                         pprParendIfaceExpr e]
 691   ppr (IfWrapper a wkr)    = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
 692   ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:") <+> brackets (pprWithCommas pprParendIfaceExpr ns)
 693
 694
 695 -- -----------------------------------------------------------------------------
 696 -- Finding the Names in IfaceSyn
 697
 698 -- This is used for dependency analysis in MkIface, so that we
 699 -- fingerprint a declaration before the things that depend on it.  It
 700 -- is specific to interface-file fingerprinting in the sense that we
 701 -- don't collect *all* Names: for example, the DFun of an instance is
 702 -- recorded textually rather than by its fingerprint when
 703 -- fingerprinting the instance, so DFuns are not dependencies.
 704
 705 freeNamesIfDecl :: IfaceDecl -> NameSet
 706 freeNamesIfDecl (IfaceId _s t d i) =
 707   freeNamesIfType t &&&
 708   freeNamesIfIdInfo i &&&
 709   freeNamesIfIdDetails d
 710 freeNamesIfDecl IfaceForeign{} =
 711   emptyNameSet
 712 freeNamesIfDecl d@IfaceData{} =
 713   freeNamesIfTvBndrs (ifTyVars d) &&&
 714   freeNamesIfTcFam (ifFamInst d) &&&
 715   freeNamesIfContext (ifCtxt d) &&&
 716   freeNamesIfConDecls (ifCons d)
 717 freeNamesIfDecl d@IfaceSyn{} =
 718   freeNamesIfTvBndrs (ifTyVars d) &&&
 719   freeNamesIfSynRhs (ifSynRhs d) &&&
 720   freeNamesIfTcFam (ifFamInst d)
 721 freeNamesIfDecl d@IfaceClass{} =
 722   freeNamesIfTvBndrs (ifTyVars d) &&&
 723   freeNamesIfContext (ifCtxt d) &&&
 724   freeNamesIfDecls   (ifATs d) &&&
 725   fnList freeNamesIfClsSig (ifSigs d)
 726
 727 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
 728 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
 729 freeNamesIfIdDetails _                 = emptyNameSet
 730
 731 -- All other changes are handled via the version info on the tycon
 732 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
 733 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
 734 freeNamesIfSynRhs Nothing   = emptyNameSet
 735
 736 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
 737 freeNamesIfTcFam (Just (tc,tys)) =
 738   freeNamesIfTc tc &&& fnList freeNamesIfType tys
 739 freeNamesIfTcFam Nothing =
 740   emptyNameSet
 741
 742 freeNamesIfContext :: IfaceContext -> NameSet
 743 freeNamesIfContext = fnList freeNamesIfPredType
 744
 745 freeNamesIfDecls :: [IfaceDecl] -> NameSet
 746 freeNamesIfDecls = fnList freeNamesIfDecl
 747
 748 freeNamesIfClsSig :: IfaceClassOp -> NameSet
 749 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
 750
 751 freeNamesIfConDecls :: IfaceConDecls -> NameSet
 752 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
 753 freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
 754 freeNamesIfConDecls _               = emptyNameSet
 755
 756 freeNamesIfConDecl :: IfaceConDecl -> NameSet
 757 freeNamesIfConDecl c =
 758   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
 759   freeNamesIfTvBndrs (ifConExTvs c) &&&
 760   freeNamesIfContext (ifConCtxt c) &&&
 761   fnList freeNamesIfType (ifConArgTys c) &&&
 762   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 763
 764 freeNamesIfPredType :: IfacePredType -> NameSet
 765 freeNamesIfPredType (IfaceClassP cl tys) =
 766    unitNameSet cl &&& fnList freeNamesIfType tys
 767 freeNamesIfPredType (IfaceIParam _n ty) =
 768    freeNamesIfType ty
 769 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
 770    freeNamesIfType ty1 &&& freeNamesIfType ty2
 771
 772 freeNamesIfType :: IfaceType -> NameSet
 773 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 774 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 775 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
 776 freeNamesIfType (IfaceTyConApp tc ts) =
 777    freeNamesIfTc tc &&& fnList freeNamesIfType ts
 778 freeNamesIfType (IfaceForAllTy tv t)  =
 779    freeNamesIfTvBndr tv &&& freeNamesIfType t
 780 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 781
 782 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
 783 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
 784
 785 freeNamesIfBndr :: IfaceBndr -> NameSet
 786 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
 787 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
 788
 789 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
 790 -- Remember IfaceLetBndr is used only for *nested* bindings
 791 -- The cut-down IdInfo never contains any Names, but the type may!
 792 freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
 793
 794 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
 795 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
 796     -- kinds can have Names inside, when the Kind is an equality predicate
 797
 798 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
 799 freeNamesIfIdBndr = freeNamesIfTvBndr
 800
 801 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 802 freeNamesIfIdInfo NoInfo = emptyNameSet
 803 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 804
 805 freeNamesItem :: IfaceInfoItem -> NameSet
 806 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
 807 freeNamesItem _              = emptyNameSet
 808
 809 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
 810 freeNamesIfUnfold (IfCoreUnfold e)       = freeNamesIfExpr e
 811 freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 812 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 813 freeNamesIfUnfold (IfWrapper _ v)        = unitNameSet v
 814 freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr vs
 815
 816 freeNamesIfExpr :: IfaceExpr -> NameSet
 817 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
 818 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 819 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 820 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
 821 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
 822 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
 823 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
 824 freeNamesIfExpr (IfaceNote _n r)   = freeNamesIfExpr r
 825
 826 freeNamesIfExpr (IfaceCase s _ ty alts)
 827   = freeNamesIfExpr s
 828     &&& fnList fn_alt alts &&& fn_cons alts
 829     &&& freeNamesIfType ty
 830   where
 831     fn_alt (_con,_bs,r) = freeNamesIfExpr r
 832
 833     -- Depend on the data constructors.  Just one will do!
 834     -- Note [Tracking data constructors]
 835     fn_cons []                              = emptyNameSet
 836     fn_cons ((IfaceDefault    ,_,_) : alts) = fn_cons alts
 837     fn_cons ((IfaceDataAlt con,_,_) : _   ) = unitNameSet con
 838     fn_cons (_                      : _   ) = emptyNameSet
 839
 840 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
 841   = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
 842
 843 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 844   = fnList fn_pair as &&& freeNamesIfExpr x
 845   where
 846     fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
 847
 848 freeNamesIfExpr _ = emptyNameSet
 849
 850
 851 freeNamesIfTc :: IfaceTyCon -> NameSet
 852 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 853 -- ToDo: shouldn't we include IfaceIntTc & co.?
 854 freeNamesIfTc _ = emptyNameSet
 855
 856 freeNamesIfRule :: IfaceRule -> NameSet
 857 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
 858   = unitNameSet f &&&
 859     fnList freeNamesIfBndr bs &&&
 860     fnList freeNamesIfExpr es &&&
 861     freeNamesIfExpr rhs
 862
 863 -- helpers
 864 (&&&) :: NameSet -> NameSet -> NameSet
 865 (&&&) = unionNameSets
 866
 867 fnList :: (a -> NameSet) -> [a] -> NameSet
 868 fnList f = foldr (&&&) emptyNameSet . map f
 869 \end{code}
 870
 871 Note [Tracking data constructors]
 872 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 873 In a case expression
 874    case e of { C a -> ...; ... }
 875 You might think that we don't need to include the datacon C
 876 in the free names, because its type will probably show up in
 877 the free names of 'e'.  But in rare circumstances this may
 878 not happen.   Here's the one that bit me:
 879
 880    module DynFlags where
 881      import {-# SOURCE #-} Packages( PackageState )
 882      data DynFlags = DF ... PackageState ...
 883
 884    module Packages where
 885      import DynFlags
 886      data PackageState = PS ...
 887      lookupModule (df :: DynFlags)
 888         = case df of
 889               DF ...p... -> case p of
 890                                PS ... -> ...
 891
 892 Now, lookupModule depends on DynFlags, but the transitive dependency
 893 on the *locally-defined* type PackageState is not visible. We need
 894 to take account of the use of the data constructor PS in the pattern match.