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