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