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