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 IfaceTyCon 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     InlinePragma
 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           has_wrapper = ifConWrapper con_decl           -- This is the reason for
 388                                                         -- having the ifConWrapper field!
 389
 390 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
 391                                ifSigs = sigs, ifATs = ats })
 392   = -- dictionary datatype:
 393     --   type constructor
 394     tc_occ :
 395     --   (possibly) newtype coercion
 396     co_occs ++
 397     --    data constructor (DataCon namespace)
 398     --    data worker (Id namespace)
 399     --    no wrapper (class dictionaries never have a wrapper)
 400     [dc_occ, dcww_occ] ++
 401     -- associated types
 402     [ifName at | at <- ats ] ++
 403     -- superclass selectors
 404     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
 405     -- operation selectors
 406     [op | IfaceClassOp op  _ _ <- sigs]
 407   where
 408     n_ctxt = length sc_ctxt
 409     n_sigs = length sigs
 410     tc_occ  = mkClassTyConOcc cls_occ
 411     dc_occ  = mkClassDataConOcc cls_occ
 412     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
 413             | otherwise  = []
 414     dcww_occ = mkDataConWorkerOcc dc_occ
 415     is_newtype = n_sigs + n_ctxt == 1                   -- Sigh
 416
 417 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
 418                              ifFamInst = famInst})
 419   = famInstCo famInst tc_occ
 420
 421 ifaceDeclSubBndrs _ = []
 422
 423 -- coercion for data/newtype family instances
 424 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
 425 famInstCo Nothing  _       = []
 426 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
 427
 428 ----------------------------- Printing IfaceDecl ------------------------------
 429
 430 instance Outputable IfaceDecl where
 431   ppr = pprIfaceDecl
 432
 433 pprIfaceDecl :: IfaceDecl -> SDoc
 434 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
 435                        ifIdDetails = details, ifIdInfo = info})
 436   = sep [ ppr var <+> dcolon <+> ppr ty,
 437           nest 2 (ppr details),
 438           nest 2 (ppr info) ]
 439
 440 pprIfaceDecl (IfaceForeign {ifName = tycon})
 441   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 442
 443 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 444                         ifSynRhs = Just mono_ty,
 445                         ifFamInst = mbFamInst})
 446   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
 447        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 448
 449 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 450                         ifSynRhs = Nothing, ifSynKind = kind })
 451   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
 452        4 (dcolon <+> ppr kind)
 453
 454 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
 455                          ifTyVars = tyvars, ifCons = condecls,
 456                          ifRec = isrec, ifFamInst = mbFamInst})
 457   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
 458        4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
 459                 pprFamily mbFamInst])
 460   where
 461     pp_nd = case condecls of
 462                 IfAbstractTyCon -> ptext (sLit "data")
 463                 IfOpenDataTyCon -> ptext (sLit "data family")
 464                 IfDataTyCon _   -> ptext (sLit "data")
 465                 IfNewTyCon _    -> ptext (sLit "newtype")
 466
 467 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
 468                           ifFDs = fds, ifATs = ats, ifSigs = sigs,
 469                           ifRec = isrec})
 470   = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
 471        4 (vcat [pprRec isrec,
 472                 sep (map ppr ats),
 473                 sep (map ppr sigs)])
 474
 475 pprRec :: RecFlag -> SDoc
 476 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
 477
 478 pprGen :: Bool -> SDoc
 479 pprGen True  = ptext (sLit "Generics: yes")
 480 pprGen False = ptext (sLit "Generics: no")
 481
 482 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
 483 pprFamily Nothing        = ptext (sLit "FamilyInstance: none")
 484 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
 485
 486 instance Outputable IfaceClassOp where
 487    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
 488
 489 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
 490 pprIfaceDeclHead context thing tyvars
 491   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
 492           pprIfaceTvBndrs tyvars]
 493
 494 pp_condecls :: OccName -> IfaceConDecls -> SDoc
 495 pp_condecls _  IfAbstractTyCon  = ptext (sLit "{- abstract -}")
 496 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
 497 pp_condecls _  IfOpenDataTyCon  = empty
 498 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
 499                                                              (map (pprIfaceConDecl tc) cs))
 500
 501 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 502 pprIfaceConDecl tc
 503         (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
 504                  ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
 505                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
 506                  ifConStricts = strs, ifConFields = fields })
 507   = sep [main_payload,
 508          if is_infix then ptext (sLit "Infix") else empty,
 509          if has_wrap then ptext (sLit "HasWrapper") else empty,
 510          if null strs then empty
 511               else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
 512          if null fields then empty
 513               else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
 514   where
 515     main_payload = ppr name <+> dcolon <+>
 516                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 517
 518     eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
 519               | (tv,ty) <- eq_spec]
 520
 521         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
 522         -- because we don't have a Name for the tycon, only an OccName
 523     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
 524                 (t:ts) -> fsep (t : map (arrow <+>) ts)
 525                 []     -> panic "pp_con_taus"
 526
 527     pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
 528
 529 instance Outputable IfaceRule where
 530   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 531                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
 532     = sep [hsep [doubleQuotes (ftext name), ppr act,
 533                  ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
 534            nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
 535                         ptext (sLit "=") <+> ppr rhs])
 536       ]
 537
 538 instance Outputable IfaceInst where
 539   ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
 540                   ifInstCls = cls, ifInstTys = mb_tcs})
 541     = hang (ptext (sLit "instance") <+> ppr flag
 542                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
 543          2 (equals <+> ppr dfun_id)
 544
 545 instance Outputable IfaceFamInst where
 546   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
 547                      ifFamInstTyCon = tycon_id})
 548     = hang (ptext (sLit "family instance") <+>
 549             ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
 550          2 (equals <+> ppr tycon_id)
 551
 552 ppr_rough :: Maybe IfaceTyCon -> SDoc
 553 ppr_rough Nothing   = dot
 554 ppr_rough (Just tc) = ppr tc
 555 \end{code}
 556
 557
 558 ----------------------------- Printing IfaceExpr ------------------------------------
 559
 560 \begin{code}
 561 instance Outputable IfaceExpr where
 562     ppr e = pprIfaceExpr noParens e
 563
 564 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
 565         -- The function adds parens in context that need
 566         -- an atomic value (e.g. function args)
 567
 568 pprIfaceExpr _       (IfaceLcl v)       = ppr v
 569 pprIfaceExpr _       (IfaceExt v)       = ppr v
 570 pprIfaceExpr _       (IfaceLit l)       = ppr l
 571 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 572 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 573 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 574
 575 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 576 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 577
 578 pprIfaceExpr add_par e@(IfaceLam _ _)
 579   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
 580                   pprIfaceExpr noParens body])
 581   where
 582     (bndrs,body) = collect [] e
 583     collect bs (IfaceLam b e) = collect (b:bs) e
 584     collect bs e              = (reverse bs, e)
 585
 586 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
 587   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 588                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 589                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
 590                   pprIfaceExpr noParens rhs <+> char '}'])
 591
 592 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
 593   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
 594                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 595                         <+> ppr bndr <+> char '{',
 596                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 597
 598 pprIfaceExpr _       (IfaceCast expr co)
 599   = sep [pprIfaceExpr parens expr,
 600          nest 2 (ptext (sLit "`cast`")),
 601          pprParendIfaceType co]
 602
 603 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
 604   = add_par (sep [ptext (sLit "let {"),
 605                   nest 2 (ppr_bind (b, rhs)),
 606                   ptext (sLit "} in"),
 607                   pprIfaceExpr noParens body])
 608
 609 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
 610   = add_par (sep [ptext (sLit "letrec {"),
 611                   nest 2 (sep (map ppr_bind pairs)),
 612                   ptext (sLit "} in"),
 613                   pprIfaceExpr noParens body])
 614
 615 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
 616
 617 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
 618 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
 619                               arrow <+> pprIfaceExpr noParens rhs]
 620
 621 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
 622 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 623 ppr_con_bs con bs                     = ppr con <+> hsep (map ppr bs)
 624
 625 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
 626 ppr_bind (IfLetBndr b ty info, rhs)
 627   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
 628          equals <+> pprIfaceExpr noParens rhs]
 629
 630 ------------------
 631 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
 632 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
 633 pprIfaceApp fun                args = sep (pprIfaceExpr parens fun : args)
 634
 635 ------------------
 636 instance Outputable IfaceNote where
 637     ppr (IfaceSCC cc)     = pprCostCentreCore cc
 638     ppr IfaceInlineMe     = ptext (sLit "__inline_me")
 639     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 640
 641
 642 instance Outputable IfaceConAlt where
 643     ppr IfaceDefault      = text "DEFAULT"
 644     ppr (IfaceLitAlt l)   = ppr l
 645     ppr (IfaceDataAlt d)  = ppr d
 646     ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
 647     -- IfaceTupleAlt is handled by the case-alternative printer
 648
 649 ------------------
 650 instance Outputable IfaceIdDetails where
 651   ppr IfVanillaId    = empty
 652   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
 653                           <+> if b then ptext (sLit "<naughty>") else empty
 654   ppr IfDFunId       = ptext (sLit "DFunId")
 655
 656 instance Outputable IfaceIdInfo where
 657   ppr NoInfo       = empty
 658   ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
 659
 660 instance Outputable IfaceInfoItem where
 661   ppr (HsUnfold unf)     = ptext (sLit "Unfolding:") <+>
 662                                         parens (pprIfaceExpr noParens unf)
 663   ppr (HsInline prag)    = ptext (sLit "Inline:") <+> ppr prag
 664   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
 665   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
 666   ppr HsNoCafRefs        = ptext (sLit "HasNoCafRefs")
 667   ppr (HsWorker w a)     = ptext (sLit "Worker:") <+> ppr w <+> int a
 668
 669
 670 -- -----------------------------------------------------------------------------
 671 -- Finding the Names in IfaceSyn
 672
 673 -- This is used for dependency analysis in MkIface, so that we
 674 -- fingerprint a declaration before the things that depend on it.  It
 675 -- is specific to interface-file fingerprinting in the sense that we
 676 -- don't collect *all* Names: for example, the DFun of an instance is
 677 -- recorded textually rather than by its fingerprint when
 678 -- fingerprinting the instance, so DFuns are not dependencies.
 679
 680 freeNamesIfDecl :: IfaceDecl -> NameSet
 681 freeNamesIfDecl (IfaceId _s t _d i) =
 682   freeNamesIfType t &&&
 683   freeNamesIfIdInfo i
 684 freeNamesIfDecl IfaceForeign{} =
 685   emptyNameSet
 686 freeNamesIfDecl d@IfaceData{} =
 687   freeNamesIfTvBndrs (ifTyVars d) &&&
 688   freeNamesIfTcFam (ifFamInst d) &&&
 689   freeNamesIfContext (ifCtxt d) &&&
 690   freeNamesIfConDecls (ifCons d)
 691 freeNamesIfDecl d@IfaceSyn{} =
 692   freeNamesIfTvBndrs (ifTyVars d) &&&
 693   freeNamesIfSynRhs (ifSynRhs d) &&&
 694   freeNamesIfTcFam (ifFamInst d)
 695 freeNamesIfDecl d@IfaceClass{} =
 696   freeNamesIfTvBndrs (ifTyVars d) &&&
 697   freeNamesIfContext (ifCtxt d) &&&
 698   freeNamesIfDecls   (ifATs d) &&&
 699   fnList freeNamesIfClsSig (ifSigs d)
 700
 701 -- All other changes are handled via the version info on the tycon
 702 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
 703 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
 704 freeNamesIfSynRhs Nothing   = emptyNameSet
 705
 706 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
 707 freeNamesIfTcFam (Just (tc,tys)) =
 708   freeNamesIfTc tc &&& fnList freeNamesIfType tys
 709 freeNamesIfTcFam Nothing =
 710   emptyNameSet
 711
 712 freeNamesIfContext :: IfaceContext -> NameSet
 713 freeNamesIfContext = fnList freeNamesIfPredType
 714
 715 freeNamesIfDecls :: [IfaceDecl] -> NameSet
 716 freeNamesIfDecls = fnList freeNamesIfDecl
 717
 718 freeNamesIfClsSig :: IfaceClassOp -> NameSet
 719 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
 720
 721 freeNamesIfConDecls :: IfaceConDecls -> NameSet
 722 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
 723 freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
 724 freeNamesIfConDecls _               = emptyNameSet
 725
 726 freeNamesIfConDecl :: IfaceConDecl -> NameSet
 727 freeNamesIfConDecl c =
 728   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
 729   freeNamesIfTvBndrs (ifConExTvs c) &&&
 730   freeNamesIfContext (ifConCtxt c) &&&
 731   fnList freeNamesIfType (ifConArgTys c) &&&
 732   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 733
 734 freeNamesIfPredType :: IfacePredType -> NameSet
 735 freeNamesIfPredType (IfaceClassP cl tys) =
 736    unitNameSet cl &&& fnList freeNamesIfType tys
 737 freeNamesIfPredType (IfaceIParam _n ty) =
 738    freeNamesIfType ty
 739 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
 740    freeNamesIfType ty1 &&& freeNamesIfType ty2
 741
 742 freeNamesIfType :: IfaceType -> NameSet
 743 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 744 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 745 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
 746 freeNamesIfType (IfaceTyConApp tc ts) =
 747    freeNamesIfTc tc &&& fnList freeNamesIfType ts
 748 freeNamesIfType (IfaceForAllTy tv t)  =
 749    freeNamesIfTvBndr tv &&& freeNamesIfType t
 750 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 751
 752 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
 753 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
 754
 755 freeNamesIfBndr :: IfaceBndr -> NameSet
 756 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
 757 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
 758
 759 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
 760 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
 761     -- kinds can have Names inside, when the Kind is an equality predicate
 762
 763 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
 764 freeNamesIfIdBndr = freeNamesIfTvBndr
 765
 766 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 767 freeNamesIfIdInfo NoInfo = emptyNameSet
 768 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 769
 770 freeNamesItem :: IfaceInfoItem -> NameSet
 771 freeNamesItem (HsUnfold u)     = freeNamesIfExpr u
 772 freeNamesItem (HsWorker wkr _) = unitNameSet wkr
 773 freeNamesItem _                = emptyNameSet
 774
 775 freeNamesIfExpr :: IfaceExpr -> NameSet
 776 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
 777 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 778 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 779 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
 780 freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
 781 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
 782 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
 783 freeNamesIfExpr (IfaceNote _n r)   = freeNamesIfExpr r
 784
 785 freeNamesIfExpr (IfaceCase s _ ty alts)
 786   = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
 787   where
 788     -- no need to look at the constructor, because we'll already have its
 789     -- parent recorded by the type on the case expression.
 790     freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
 791
 792 freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
 793   = freeNamesIfExpr r &&& freeNamesIfExpr x
 794
 795 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 796   = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
 797
 798 freeNamesIfExpr _ = emptyNameSet
 799
 800
 801 freeNamesIfTc :: IfaceTyCon -> NameSet
 802 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 803 -- ToDo: shouldn't we include IfaceIntTc & co.?
 804 freeNamesIfTc _ = emptyNameSet
 805
 806 freeNamesIfRule :: IfaceRule -> NameSet
 807 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
 808   = unitNameSet f &&&
 809     fnList freeNamesIfBndr bs &&&
 810     fnList freeNamesIfExpr es &&&
 811     freeNamesIfExpr rhs
 812
 813 -- helpers
 814 (&&&) :: NameSet -> NameSet -> NameSet
 815 (&&&) = unionNameSets
 816
 817 fnList :: (a -> NameSet) -> [a] -> NameSet
 818 fnList f = foldr (&&&) emptyNameSet . map f
 819 \end{code}