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(..), IfaceIdInfo(..), IfaceIdDetails(..),
  13         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
  14         IfaceInst(..), IfaceFamInst(..),
  15
  16         -- Misc
  17         ifaceDeclSubBndrs, visibleIfConDecls,
  18
  19         -- Free Names
  20         freeNamesIfDecl, freeNamesIfRule,
  21
  22         -- Pretty printing
  23         pprIfaceExpr, pprIfaceDeclHead
  24     ) where
  25
  26 #include "HsVersions.h"
  27
  28 import IfaceType
  29
  30 import NewDemand
  31 import Annotations
  32 import Class
  33 import NameSet
  34 import Name
  35 import CostCentre
  36 import Literal
  37 import ForeignCall
  38 import Serialized
  39 import BasicTypes
  40 import Outputable
  41 import FastString
  42 import Module
  43
  44 import Data.List
  45 import Data.Maybe
  46
  47 infixl 3 &&&
  48 \end{code}
  49
  50
  51 %************************************************************************
  52 %*                                                                      *
  53                 Data type declarations
  54 %*                                                                      *
  55 %************************************************************************
  56
  57 \begin{code}
  58 data IfaceDecl
  59   = IfaceId { ifName      :: OccName,
  60               ifType      :: IfaceType,
  61               ifIdDetails :: IfaceIdDetails,
  62               ifIdInfo    :: IfaceIdInfo }
  63
  64   | IfaceData { ifName       :: OccName,        -- Type constructor
  65                 ifTyVars     :: [IfaceTvBndr],  -- Type variables
  66                 ifCtxt       :: IfaceContext,   -- The "stupid theta"
  67                 ifCons       :: IfaceConDecls,  -- Includes new/data info
  68                 ifRec        :: RecFlag,        -- Recursive or not?
  69                 ifGadtSyntax :: Bool,           -- True <=> declared using
  70                                                 -- GADT syntax
  71                 ifGeneric    :: Bool,           -- True <=> generic converter
  72                                                 --          functions available
  73                                                 -- We need this for imported
  74                                                 -- data decls, since the
  75                                                 -- imported modules may have
  76                                                 -- been compiled with
  77                                                 -- different flags to the
  78                                                 -- current compilation unit
  79                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
  80                                                 -- Just <=> instance of family
  81                                                 -- Invariant:
  82                                                 --   ifCons /= IfOpenDataTyCon
  83                                                 --   for family instances
  84     }
  85
  86   | IfaceSyn  { ifName    :: OccName,           -- Type constructor
  87                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
  88                 ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
  89                 ifSynRhs  :: Maybe IfaceType,   -- Just rhs for an ordinary synonyn
  90                                                 -- Nothing for an open family
  91                 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
  92                                                 -- Just <=> instance of family
  93                                                 -- Invariant: ifOpenSyn == False
  94                                                 --   for family instances
  95     }
  96
  97   | IfaceClass { ifCtxt    :: IfaceContext,     -- Context...
  98                  ifName    :: OccName,          -- Name of the class
  99                  ifTyVars  :: [IfaceTvBndr],    -- Type variables
 100                  ifFDs     :: [FunDep FastString], -- Functional dependencies
 101                  ifATs     :: [IfaceDecl],      -- Associated type families
 102                  ifSigs    :: [IfaceClassOp],   -- Method signatures
 103                  ifRec     :: RecFlag           -- Is newtype/datatype associated 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 DefMeth 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 :: [StrictnessMark]}       -- Empty (meaning all lazy),
 139                                                 -- or 1-1 corresp with arg tys
 140
 141 data IfaceInst
 142   = IfaceInst { ifInstCls  :: Name,                     -- See comments with
 143                 ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
 144                 ifDFun     :: Name,                     -- 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   :: Name                -- 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   :: Name,           -- Head of lhs
 166         ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
 167         ifRuleRhs    :: IfaceExpr,
 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 Bool
 187   | IfDFunId
 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     Activation
 207   | HsUnfold     IfaceExpr
 208   | HsNoCafRefs
 209   | HsWorker     Name Arity     -- Worker, if any see IdInfo.WorkerInfo
 210                                         -- for why we want arity here.
 211         -- NB: we need IfaceExtName (not just OccName) because the worker
 212         --     can simplify to a function in another module.
 213 -- NB: Specialisations and rules come in separately and are
 214 -- only later attached to the Id.  Partial reason: some are orphans.
 215
 216 --------------------------------
 217 data IfaceExpr
 218   = IfaceLcl    FastString
 219   | IfaceExt    Name
 220   | IfaceType   IfaceType
 221   | IfaceTuple  Boxity [IfaceExpr]              -- Saturated; type arguments omitted
 222   | IfaceLam    IfaceBndr IfaceExpr
 223   | IfaceApp    IfaceExpr IfaceExpr
 224   | IfaceCase   IfaceExpr FastString IfaceType [IfaceAlt]
 225   | IfaceLet    IfaceBinding  IfaceExpr
 226   | IfaceNote   IfaceNote IfaceExpr
 227   | IfaceCast   IfaceExpr IfaceCoercion
 228   | IfaceLit    Literal
 229   | IfaceFCall  ForeignCall IfaceType
 230   | IfaceTick   Module Int
 231
 232 data IfaceNote = IfaceSCC CostCentre
 233                | IfaceInlineMe
 234                | IfaceCoreNote String
 235
 236 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
 237         -- Note: FastString, not IfaceBndr (and same with the case binder)
 238         -- We reconstruct the kind/type of the thing from the context
 239         -- thus saving bulk in interface files
 240
 241 data IfaceConAlt = IfaceDefault
 242                  | IfaceDataAlt Name
 243                  | IfaceTupleAlt Boxity
 244                  | IfaceLitAlt Literal
 245
 246 data IfaceBinding
 247   = IfaceNonRec IfaceLetBndr IfaceExpr
 248   | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
 249
 250 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 251 -- It's used for *non-top-level* let/rec binders
 252 -- See Note [IdInfo on nested let-bindings]
 253 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
 254 \end{code}
 255
 256 Note [IdInfo on nested let-bindings]
 257 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 258 Occasionally we want to preserve IdInfo on nested let bindings. The one
 259 that came up was a NOINLINE pragma on a let-binding inside an INLINE
 260 function.  The user (Duncan Coutts) really wanted the NOINLINE control
 261 to cross the separate compilation boundary.
 262
 263 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
 264 Currently we only actually retain InlinePragInfo, but in principle we could
 265 add strictness etc.
 266
 267
 268 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
 269 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 270 If a module contains any "orphans", then its interface file is read
 271 regardless, so that its instances are not missed.
 272
 273 Roughly speaking, an instance is an orphan if its head (after the =>)
 274 mentions nothing defined in this module.  Functional dependencies
 275 complicate the situation though. Consider
 276
 277   module M where { class C a b | a -> b }
 278
 279 and suppose we are compiling module X:
 280
 281   module X where
 282         import M
 283         data T = ...
 284         instance C Int T where ...
 285
 286 This instance is an orphan, because when compiling a third module Y we
 287 might get a constraint (C Int v), and we'd want to improve v to T.  So
 288 we must make sure X's instances are loaded, even if we do not directly
 289 use anything from X.
 290
 291 More precisely, an instance is an orphan iff
 292
 293   If there are no fundeps, then at least of the names in
 294   the instance head is locally defined.
 295
 296   If there are fundeps, then for every fundep, at least one of the
 297   names free in a *non-determined* part of the instance head is
 298   defined in this module.
 299
 300 (Note that these conditions hold trivially if the class is locally
 301 defined.)
 302
 303 Note [Versioning of instances]
 304 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 305 Now consider versioning.  If we *use* an instance decl in one compilation,
 306 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
 307 But suppose we *don't* (currently) use an instance!  We must recompile if
 308 the instance is changed in such a way that it becomes important.  (This would
 309 only matter with overlapping instances, else the importing module wouldn't have
 310 compiled before and the recompilation check is irrelevant.)
 311
 312 The is_orph field is set to (Just n) if the instance is not an orphan.
 313 The 'n' is *any* of the locally-defined names mentioned anywhere in the
 314 instance head.  This name is used for versioning; the instance decl is
 315 considered part of the defn of this 'n'.
 316
 317 I'm worried about whether this works right if we pick a name from
 318 a functionally-dependent part of the instance decl.  E.g.
 319
 320   module M where { class C a b | a -> b }
 321
 322 and suppose we are compiling module X:
 323
 324   module X where
 325         import M
 326         data S  = ...
 327         data T = ...
 328         instance C S T where ...
 329
 330 If we base the instance verion on T, I'm worried that changing S to S'
 331 would change T's version, but not S or S'.  But an importing module might
 332 not depend on T, and so might not be recompiled even though the new instance
 333 (C S' T) might be relevant.  I have not been able to make a concrete example,
 334 and it seems deeply obscure, so I'm going to leave it for now.
 335
 336
 337 Note [Versioning of rules]
 338 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 339 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
 340 n appears on the LHS of the rule; any change in the rule changes the version of n.
 341
 342
 343 \begin{code}
 344 -- -----------------------------------------------------------------------------
 345 -- Utils on IfaceSyn
 346
 347 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
 348 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
 349 -- Deeply revolting, because it has to predict what gets bound,
 350 -- especially the question of whether there's a wrapper for a datacon
 351
 352 -- N.B. the set of names returned here *must* match the set of
 353 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
 354 -- TyThing.getOccName should define a bijection between the two lists.
 355 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
 356 -- The order of the list does not matter.
 357 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}  = []
 358
 359 -- Newtype
 360 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 361                               ifCons = IfNewTyCon (
 362                                         IfCon { ifConOcc = con_occ }),
 363                               ifFamInst = famInst})
 364   =   -- implicit coerion and (possibly) family instance coercion
 365     (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
 366       -- data constructor and worker (newtypes don't have a wrapper)
 367     [con_occ, mkDataConWorkerOcc con_occ]
 368
 369
 370 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 371                               ifCons = IfDataTyCon cons,
 372                               ifFamInst = famInst})
 373   =   -- (possibly) family instance coercion;
 374       -- there is no implicit coercion for non-newtypes
 375     famInstCo famInst tc_occ
 376       -- for each data constructor in order,
 377       --    data constructor, worker, and (possibly) wrapper
 378     ++ concatMap dc_occs cons
 379   where
 380     dc_occs con_decl
 381         | has_wrapper = [con_occ, work_occ, wrap_occ]
 382         | otherwise   = [con_occ, work_occ]
 383         where
 384           con_occ  = ifConOcc con_decl                  -- DataCon namespace
 385           wrap_occ = mkDataConWrapperOcc con_occ        -- Id namespace
 386           work_occ = mkDataConWorkerOcc con_occ         -- Id namespace
 387           strs     = ifConStricts con_decl
 388           has_wrapper = ifConWrapper con_decl           -- This is the reason for
 389                                                         -- having the ifConWrapper field!
 390
 391 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
 392                                ifSigs = sigs, ifATs = ats })
 393   = -- dictionary datatype:
 394     --   type constructor
 395     tc_occ :
 396     --   (possibly) newtype coercion
 397     co_occs ++
 398     --    data constructor (DataCon namespace)
 399     --    data worker (Id namespace)
 400     --    no wrapper (class dictionaries never have a wrapper)
 401     [dc_occ, dcww_occ] ++
 402     -- associated types
 403     [ifName at | at <- ats ] ++
 404     -- superclass selectors
 405     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
 406     -- operation selectors
 407     [op | IfaceClassOp op  _ _ <- sigs]
 408   where
 409     n_ctxt = length sc_ctxt
 410     n_sigs = length sigs
 411     tc_occ  = mkClassTyConOcc cls_occ
 412     dc_occ  = mkClassDataConOcc cls_occ
 413     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
 414             | otherwise  = []
 415     dcww_occ = mkDataConWorkerOcc dc_occ
 416     is_newtype = n_sigs + n_ctxt == 1                   -- Sigh
 417
 418 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
 419                              ifFamInst = famInst})
 420   = famInstCo famInst tc_occ
 421
 422 ifaceDeclSubBndrs _ = []
 423
 424 -- coercion for data/newtype family instances
 425 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
 426 famInstCo Nothing  _       = []
 427 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
 428
 429 ----------------------------- Printing IfaceDecl ------------------------------
 430
 431 instance Outputable IfaceDecl where
 432   ppr = pprIfaceDecl
 433
 434 pprIfaceDecl :: IfaceDecl -> SDoc
 435 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
 436                        ifIdDetails = details, ifIdInfo = info})
 437   = sep [ ppr var <+> dcolon <+> ppr ty,
 438           nest 2 (ppr details),
 439           nest 2 (ppr info) ]
 440
 441 pprIfaceDecl (IfaceForeign {ifName = tycon})
 442   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 443
 444 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 445                         ifSynRhs = Just mono_ty,
 446                         ifFamInst = mbFamInst})
 447   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
 448        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 449
 450 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 451                         ifSynRhs = Nothing, ifSynKind = kind })
 452   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
 453        4 (dcolon <+> ppr kind)
 454
 455 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
 456                          ifTyVars = tyvars, ifCons = condecls,
 457                          ifRec = isrec, ifFamInst = mbFamInst})
 458   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
 459        4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
 460                 pprFamily mbFamInst])
 461   where
 462     pp_nd = case condecls of
 463                 IfAbstractTyCon -> ptext (sLit "data")
 464                 IfOpenDataTyCon -> ptext (sLit "data family")
 465                 IfDataTyCon _   -> ptext (sLit "data")
 466                 IfNewTyCon _    -> ptext (sLit "newtype")
 467
 468 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
 469                           ifFDs = fds, ifATs = ats, ifSigs = sigs,
 470                           ifRec = isrec})
 471   = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
 472        4 (vcat [pprRec isrec,
 473                 sep (map ppr ats),
 474                 sep (map ppr sigs)])
 475
 476 pprRec :: RecFlag -> SDoc
 477 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
 478
 479 pprGen :: Bool -> SDoc
 480 pprGen True  = ptext (sLit "Generics: yes")
 481 pprGen False = ptext (sLit "Generics: no")
 482
 483 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
 484 pprFamily Nothing        = ptext (sLit "FamilyInstance: none")
 485 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
 486
 487 instance Outputable IfaceClassOp where
 488    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
 489
 490 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
 491 pprIfaceDeclHead context thing tyvars
 492   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
 493           pprIfaceTvBndrs tyvars]
 494
 495 pp_condecls :: OccName -> IfaceConDecls -> SDoc
 496 pp_condecls _  IfAbstractTyCon  = ptext (sLit "{- abstract -}")
 497 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
 498 pp_condecls _  IfOpenDataTyCon  = empty
 499 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
 500                                                              (map (pprIfaceConDecl tc) cs))
 501
 502 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 503 pprIfaceConDecl tc
 504         (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
 505                  ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
 506                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
 507                  ifConStricts = strs, ifConFields = fields })
 508   = sep [main_payload,
 509          if is_infix then ptext (sLit "Infix") else empty,
 510          if has_wrap then ptext (sLit "HasWrapper") else empty,
 511          if null strs then empty
 512               else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
 513          if null fields then empty
 514               else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
 515   where
 516     main_payload = ppr name <+> dcolon <+>
 517                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 518
 519     eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
 520               | (tv,ty) <- eq_spec]
 521
 522         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
 523         -- because we don't have a Name for the tycon, only an OccName
 524     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
 525                 (t:ts) -> fsep (t : map (arrow <+>) ts)
 526                 []     -> panic "pp_con_taus"
 527
 528     pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
 529
 530 instance Outputable IfaceRule where
 531   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 532                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
 533     = sep [hsep [doubleQuotes (ftext name), ppr act,
 534                  ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
 535            nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
 536                         ptext (sLit "=") <+> ppr rhs])
 537       ]
 538
 539 instance Outputable IfaceInst where
 540   ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
 541                   ifInstCls = cls, ifInstTys = mb_tcs})
 542     = hang (ptext (sLit "instance") <+> ppr flag
 543                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
 544          2 (equals <+> ppr dfun_id)
 545
 546 instance Outputable IfaceFamInst where
 547   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
 548                      ifFamInstTyCon = tycon_id})
 549     = hang (ptext (sLit "family instance") <+>
 550             ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
 551          2 (equals <+> ppr tycon_id)
 552
 553 ppr_rough :: Maybe IfaceTyCon -> SDoc
 554 ppr_rough Nothing   = dot
 555 ppr_rough (Just tc) = ppr tc
 556 \end{code}
 557
 558
 559 ----------------------------- Printing IfaceExpr ------------------------------------
 560
 561 \begin{code}
 562 instance Outputable IfaceExpr where
 563     ppr e = pprIfaceExpr noParens e
 564
 565 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
 566         -- The function adds parens in context that need
 567         -- an atomic value (e.g. function args)
 568
 569 pprIfaceExpr _       (IfaceLcl v)       = ppr v
 570 pprIfaceExpr _       (IfaceExt v)       = ppr v
 571 pprIfaceExpr _       (IfaceLit l)       = ppr l
 572 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 573 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 574 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 575
 576 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 577 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 578
 579 pprIfaceExpr add_par e@(IfaceLam _ _)
 580   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
 581                   pprIfaceExpr noParens body])
 582   where
 583     (bndrs,body) = collect [] e
 584     collect bs (IfaceLam b e) = collect (b:bs) e
 585     collect bs e              = (reverse bs, e)
 586
 587 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
 588   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 589                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 590                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
 591                   pprIfaceExpr noParens rhs <+> char '}'])
 592
 593 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
 594   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 595                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 596                         <+> ppr bndr <+> char '{',
 597                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 598
 599 pprIfaceExpr _       (IfaceCast expr co)
 600   = sep [pprIfaceExpr parens expr,
 601          nest 2 (ptext (sLit "`cast`")),
 602          pprParendIfaceType co]
 603
 604 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
 605   = add_par (sep [ptext (sLit "let {"),
 606                   nest 2 (ppr_bind (b, rhs)),
 607                   ptext (sLit "} in"),
 608                   pprIfaceExpr noParens body])
 609
 610 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
 611   = add_par (sep [ptext (sLit "letrec {"),
 612                   nest 2 (sep (map ppr_bind pairs)),
 613                   ptext (sLit "} in"),
 614                   pprIfaceExpr noParens body])
 615
 616 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
 617
 618 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
 619 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
 620                               arrow <+> pprIfaceExpr noParens rhs]
 621
 622 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
 623 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 624 ppr_con_bs con bs                     = ppr con <+> hsep (map ppr bs)
 625
 626 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
 627 ppr_bind (IfLetBndr b ty info, rhs)
 628   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
 629          equals <+> pprIfaceExpr noParens rhs]
 630
 631 ------------------
 632 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
 633 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
 634 pprIfaceApp fun                args = sep (pprIfaceExpr parens fun : args)
 635
 636 ------------------
 637 instance Outputable IfaceNote where
 638     ppr (IfaceSCC cc)     = pprCostCentreCore cc
 639     ppr IfaceInlineMe     = ptext (sLit "__inline_me")
 640     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 641
 642
 643 instance Outputable IfaceConAlt where
 644     ppr IfaceDefault      = text "DEFAULT"
 645     ppr (IfaceLitAlt l)   = ppr l
 646     ppr (IfaceDataAlt d)  = ppr d
 647     ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
 648     -- IfaceTupleAlt is handled by the case-alternative printer
 649
 650 ------------------
 651 instance Outputable IfaceIdDetails where
 652   ppr IfVanillaId    = empty
 653   ppr (IfRecSelId b) = ptext (sLit "RecSel")
 654                        <> if b then ptext (sLit "<naughty>") else empty
 655   ppr IfDFunId       = ptext (sLit "DFunId")
 656
 657 instance Outputable IfaceIdInfo where
 658   ppr NoInfo       = empty
 659   ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
 660
 661 instance Outputable IfaceInfoItem where
 662   ppr (HsUnfold unf)     = ptext (sLit "Unfolding:") <+>
 663                                         parens (pprIfaceExpr noParens unf)
 664   ppr (HsInline act)     = ptext (sLit "Inline:") <+> ppr act
 665   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
 666   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
 667   ppr HsNoCafRefs        = ptext (sLit "HasNoCafRefs")
 668   ppr (HsWorker w a)     = ptext (sLit "Worker:") <+> ppr w <+> int a
 669
 670
 671 -- -----------------------------------------------------------------------------
 672 -- Finding the Names in IfaceSyn
 673
 674 -- This is used for dependency analysis in MkIface, so that we
 675 -- fingerprint a declaration before the things that depend on it.  It
 676 -- is specific to interface-file fingerprinting in the sense that we
 677 -- don't collect *all* Names: for example, the DFun of an instance is
 678 -- recorded textually rather than by its fingerprint when
 679 -- fingerprinting the instance, so DFuns are not dependencies.
 680
 681 freeNamesIfDecl :: IfaceDecl -> NameSet
 682 freeNamesIfDecl (IfaceId _s t _d i) =
 683   freeNamesIfType t &&&
 684   freeNamesIfIdInfo i
 685 freeNamesIfDecl IfaceForeign{} =
 686   emptyNameSet
 687 freeNamesIfDecl d@IfaceData{} =
 688   freeNamesIfTvBndrs (ifTyVars d) &&&
 689   freeNamesIfTcFam (ifFamInst d) &&&
 690   freeNamesIfContext (ifCtxt d) &&&
 691   freeNamesIfConDecls (ifCons d)
 692 freeNamesIfDecl d@IfaceSyn{} =
 693   freeNamesIfTvBndrs (ifTyVars d) &&&
 694   freeNamesIfSynRhs (ifSynRhs d) &&&
 695   freeNamesIfTcFam (ifFamInst d)
 696 freeNamesIfDecl d@IfaceClass{} =
 697   freeNamesIfTvBndrs (ifTyVars d) &&&
 698   freeNamesIfContext (ifCtxt d) &&&
 699   freeNamesIfDecls   (ifATs d) &&&
 700   fnList freeNamesIfClsSig (ifSigs d)
 701
 702 -- All other changes are handled via the version info on the tycon
 703 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
 704 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
 705 freeNamesIfSynRhs Nothing   = emptyNameSet
 706
 707 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
 708 freeNamesIfTcFam (Just (tc,tys)) =
 709   freeNamesIfTc tc &&& fnList freeNamesIfType tys
 710 freeNamesIfTcFam Nothing =
 711   emptyNameSet
 712
 713 freeNamesIfContext :: IfaceContext -> NameSet
 714 freeNamesIfContext = fnList freeNamesIfPredType
 715
 716 freeNamesIfDecls :: [IfaceDecl] -> NameSet
 717 freeNamesIfDecls = fnList freeNamesIfDecl
 718
 719 freeNamesIfClsSig :: IfaceClassOp -> NameSet
 720 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
 721
 722 freeNamesIfConDecls :: IfaceConDecls -> NameSet
 723 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
 724 freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
 725 freeNamesIfConDecls _               = emptyNameSet
 726
 727 freeNamesIfConDecl :: IfaceConDecl -> NameSet
 728 freeNamesIfConDecl c =
 729   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
 730   freeNamesIfTvBndrs (ifConExTvs c) &&&
 731   freeNamesIfContext (ifConCtxt c) &&&
 732   fnList freeNamesIfType (ifConArgTys c) &&&
 733   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 734
 735 freeNamesIfPredType :: IfacePredType -> NameSet
 736 freeNamesIfPredType (IfaceClassP cl tys) =
 737    unitNameSet cl &&& fnList freeNamesIfType tys
 738 freeNamesIfPredType (IfaceIParam _n ty) =
 739    freeNamesIfType ty
 740 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
 741    freeNamesIfType ty1 &&& freeNamesIfType ty2
 742
 743 freeNamesIfType :: IfaceType -> NameSet
 744 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 745 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 746 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
 747 freeNamesIfType (IfaceTyConApp tc ts) =
 748    freeNamesIfTc tc &&& fnList freeNamesIfType ts
 749 freeNamesIfType (IfaceForAllTy tv t)  =
 750    freeNamesIfTvBndr tv &&& freeNamesIfType t
 751 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 752
 753 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
 754 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
 755
 756 freeNamesIfBndr :: IfaceBndr -> NameSet
 757 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
 758 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
 759
 760 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
 761 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
 762     -- kinds can have Names inside, when the Kind is an equality predicate
 763
 764 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
 765 freeNamesIfIdBndr = freeNamesIfTvBndr
 766
 767 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 768 freeNamesIfIdInfo NoInfo = emptyNameSet
 769 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 770
 771 freeNamesItem :: IfaceInfoItem -> NameSet
 772 freeNamesItem (HsUnfold u)     = freeNamesIfExpr u
 773 freeNamesItem (HsWorker wkr _) = unitNameSet wkr
 774 freeNamesItem _                = emptyNameSet
 775
 776 freeNamesIfExpr :: IfaceExpr -> NameSet
 777 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
 778 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 779 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 780 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
 781 freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
 782 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
 783 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
 784 freeNamesIfExpr (IfaceNote _n r)   = freeNamesIfExpr r
 785
 786 freeNamesIfExpr (IfaceCase s _ ty alts)
 787   = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
 788   where
 789     -- no need to look at the constructor, because we'll already have its
 790     -- parent recorded by the type on the case expression.
 791     freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
 792
 793 freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
 794   = freeNamesIfExpr r &&& freeNamesIfExpr x
 795
 796 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 797   = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
 798
 799 freeNamesIfExpr _ = emptyNameSet
 800
 801
 802 freeNamesIfTc :: IfaceTyCon -> NameSet
 803 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 804 -- ToDo: shouldn't we include IfaceIntTc & co.?
 805 freeNamesIfTc _ = emptyNameSet
 806
 807 freeNamesIfRule :: IfaceRule -> NameSet
 808 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
 809   = unitNameSet f &&&
 810     fnList freeNamesIfBndr bs &&&
 811     fnList freeNamesIfExpr es &&&
 812     freeNamesIfExpr rhs
 813
 814 -- helpers
 815 (&&&) :: NameSet -> NameSet -> NameSet
 816 (&&&) = unionNameSets
 817
 818 fnList :: (a -> NameSet) -> [a] -> NameSet
 819 fnList f = foldr (&&&) emptyNameSet . map f
 820 \end{code}