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