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