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