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