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