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