compiler/iface/IfaceSyn.lhs

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