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