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