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