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   | IfaceCo     IfaceType               -- We re-use IfaceType for coercions
 231   | IfaceTuple  Boxity [IfaceExpr]      -- Saturated; type arguments omitted
 232   | IfaceLam    IfaceBndr IfaceExpr
 233   | IfaceApp    IfaceExpr IfaceExpr
 234   | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
 235   | IfaceLet    IfaceBinding  IfaceExpr
 236   | IfaceNote   IfaceNote IfaceExpr
 237   | IfaceCast   IfaceExpr IfaceCoercion
 238   | IfaceLit    Literal
 239   | IfaceFCall  ForeignCall IfaceType
 240   | IfaceTick   Module Int
 241
 242 data IfaceNote = IfaceSCC CostCentre
 243                | IfaceCoreNote String
 244
 245 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
 246         -- Note: IfLclName, not IfaceBndr (and same with the case binder)
 247         -- We reconstruct the kind/type of the thing from the context
 248         -- thus saving bulk in interface files
 249
 250 data IfaceConAlt = IfaceDefault
 251                  | IfaceDataAlt IfExtName
 252                  | IfaceTupleAlt Boxity
 253                  | IfaceLitAlt Literal
 254
 255 data IfaceBinding
 256   = IfaceNonRec IfaceLetBndr IfaceExpr
 257   | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
 258
 259 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 260 -- It's used for *non-top-level* let/rec binders
 261 -- See Note [IdInfo on nested let-bindings]
 262 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
 263 \end{code}
 264
 265 Note [Expose recursive functions]
 266 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 267 For supercompilation we want to put *all* unfoldings in the interface
 268 file, even for functions that are recursive (or big).  So we need to
 269 know when an unfolding belongs to a loop-breaker so that we can refrain
 270 from inlining it (except during supercompilation).
 271
 272 Note [IdInfo on nested let-bindings]
 273 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 274 Occasionally we want to preserve IdInfo on nested let bindings. The one
 275 that came up was a NOINLINE pragma on a let-binding inside an INLINE
 276 function.  The user (Duncan Coutts) really wanted the NOINLINE control
 277 to cross the separate compilation boundary.
 278
 279 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
 280 that is what is seen by importing module with --make
 281
 282 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
 283 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 284 If a module contains any "orphans", then its interface file is read
 285 regardless, so that its instances are not missed.
 286
 287 Roughly speaking, an instance is an orphan if its head (after the =>)
 288 mentions nothing defined in this module.  Functional dependencies
 289 complicate the situation though. Consider
 290
 291   module M where { class C a b | a -> b }
 292
 293 and suppose we are compiling module X:
 294
 295   module X where
 296         import M
 297         data T = ...
 298         instance C Int T where ...
 299
 300 This instance is an orphan, because when compiling a third module Y we
 301 might get a constraint (C Int v), and we'd want to improve v to T.  So
 302 we must make sure X's instances are loaded, even if we do not directly
 303 use anything from X.
 304
 305 More precisely, an instance is an orphan iff
 306
 307   If there are no fundeps, then at least of the names in
 308   the instance head is locally defined.
 309
 310   If there are fundeps, then for every fundep, at least one of the
 311   names free in a *non-determined* part of the instance head is
 312   defined in this module.
 313
 314 (Note that these conditions hold trivially if the class is locally
 315 defined.)
 316
 317 Note [Versioning of instances]
 318 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 319 Now consider versioning.  If we *use* an instance decl in one compilation,
 320 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
 321 But suppose we *don't* (currently) use an instance!  We must recompile if
 322 the instance is changed in such a way that it becomes important.  (This would
 323 only matter with overlapping instances, else the importing module wouldn't have
 324 compiled before and the recompilation check is irrelevant.)
 325
 326 The is_orph field is set to (Just n) if the instance is not an orphan.
 327 The 'n' is *any* of the locally-defined names mentioned anywhere in the
 328 instance head.  This name is used for versioning; the instance decl is
 329 considered part of the defn of this 'n'.
 330
 331 I'm worried about whether this works right if we pick a name from
 332 a functionally-dependent part of the instance decl.  E.g.
 333
 334   module M where { class C a b | a -> b }
 335
 336 and suppose we are compiling module X:
 337
 338   module X where
 339         import M
 340         data S  = ...
 341         data T = ...
 342         instance C S T where ...
 343
 344 If we base the instance verion on T, I'm worried that changing S to S'
 345 would change T's version, but not S or S'.  But an importing module might
 346 not depend on T, and so might not be recompiled even though the new instance
 347 (C S' T) might be relevant.  I have not been able to make a concrete example,
 348 and it seems deeply obscure, so I'm going to leave it for now.
 349
 350
 351 Note [Versioning of rules]
 352 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 353 A rule that is not an orphan has an ifRuleOrph field of (Just n), where n
 354 appears on the LHS of the rule; any change in the rule changes the version of n.
 355
 356
 357 \begin{code}
 358 -- -----------------------------------------------------------------------------
 359 -- Utils on IfaceSyn
 360
 361 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
 362 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
 363 -- Deeply revolting, because it has to predict what gets bound,
 364 -- especially the question of whether there's a wrapper for a datacon
 365
 366 -- N.B. the set of names returned here *must* match the set of
 367 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
 368 -- TyThing.getOccName should define a bijection between the two lists.
 369 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
 370 -- The order of the list does not matter.
 371 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}  = []
 372
 373 -- Newtype
 374 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 375                               ifCons = IfNewTyCon (
 376                                         IfCon { ifConOcc = con_occ }),
 377                               ifFamInst = famInst})
 378   =   -- implicit coerion and (possibly) family instance coercion
 379     (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
 380       -- data constructor and worker (newtypes don't have a wrapper)
 381     [con_occ, mkDataConWorkerOcc con_occ]
 382
 383
 384 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 385                               ifCons = IfDataTyCon cons,
 386                               ifFamInst = famInst})
 387   =   -- (possibly) family instance coercion;
 388       -- there is no implicit coercion for non-newtypes
 389     famInstCo famInst tc_occ
 390       -- for each data constructor in order,
 391       --    data constructor, worker, and (possibly) wrapper
 392     ++ concatMap dc_occs cons
 393   where
 394     dc_occs con_decl
 395         | has_wrapper = [con_occ, work_occ, wrap_occ]
 396         | otherwise   = [con_occ, work_occ]
 397         where
 398           con_occ  = ifConOcc con_decl            -- DataCon namespace
 399           wrap_occ = mkDataConWrapperOcc con_occ  -- Id namespace
 400           work_occ = mkDataConWorkerOcc con_occ   -- Id namespace
 401           has_wrapper = ifConWrapper con_decl     -- This is the reason for
 402                                                   -- having the ifConWrapper field!
 403
 404 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
 405                                ifSigs = sigs, ifATs = ats })
 406   = -- dictionary datatype:
 407     --   type constructor
 408     tc_occ :
 409     --   (possibly) newtype coercion
 410     co_occs ++
 411     --    data constructor (DataCon namespace)
 412     --    data worker (Id namespace)
 413     --    no wrapper (class dictionaries never have a wrapper)
 414     [dc_occ, dcww_occ] ++
 415     -- associated types
 416     [ifName at | at <- ats ] ++
 417     -- superclass selectors
 418     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
 419     -- operation selectors
 420     [op | IfaceClassOp op  _ _ <- sigs]
 421   where
 422     n_ctxt = length sc_ctxt
 423     n_sigs = length sigs
 424     tc_occ  = mkClassTyConOcc cls_occ
 425     dc_occ  = mkClassDataConOcc cls_occ
 426     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
 427             | otherwise  = []
 428     dcww_occ = mkDataConWorkerOcc dc_occ
 429     is_newtype = n_sigs + n_ctxt == 1 -- Sigh
 430
 431 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
 432                              ifFamInst = famInst})
 433   = famInstCo famInst tc_occ
 434
 435 ifaceDeclSubBndrs _ = []
 436
 437 -- coercion for data/newtype family instances
 438 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
 439 famInstCo Nothing  _       = []
 440 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
 441
 442 ----------------------------- Printing IfaceDecl ------------------------------
 443
 444 instance Outputable IfaceDecl where
 445   ppr = pprIfaceDecl
 446
 447 pprIfaceDecl :: IfaceDecl -> SDoc
 448 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
 449                        ifIdDetails = details, ifIdInfo = info})
 450   = sep [ ppr var <+> dcolon <+> ppr ty,
 451           nest 2 (ppr details),
 452           nest 2 (ppr info) ]
 453
 454 pprIfaceDecl (IfaceForeign {ifName = tycon})
 455   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 456
 457 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 458                         ifSynRhs = Just mono_ty,
 459                         ifFamInst = mbFamInst})
 460   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
 461        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 462
 463 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 464                         ifSynRhs = Nothing, ifSynKind = kind })
 465   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
 466        4 (dcolon <+> ppr kind)
 467
 468 pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
 469                          ifTyVars = tyvars, ifCons = condecls,
 470                          ifRec = isrec, ifFamInst = mbFamInst})
 471   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
 472        4 (vcat [pprRec isrec, pp_condecls tycon condecls,
 473                 pprFamily mbFamInst])
 474   where
 475     pp_nd = case condecls of
 476                 IfAbstractTyCon -> ptext (sLit "data")
 477                 IfOpenDataTyCon -> ptext (sLit "data family")
 478                 IfDataTyCon _   -> ptext (sLit "data")
 479                 IfNewTyCon _    -> ptext (sLit "newtype")
 480
 481 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
 482                           ifFDs = fds, ifATs = ats, ifSigs = sigs,
 483                           ifRec = isrec})
 484   = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
 485        4 (vcat [pprRec isrec,
 486                 sep (map ppr ats),
 487                 sep (map ppr sigs)])
 488
 489 pprRec :: RecFlag -> SDoc
 490 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
 491
 492 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
 493 pprFamily Nothing        = ptext (sLit "FamilyInstance: none")
 494 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
 495
 496 instance Outputable IfaceClassOp where
 497    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
 498
 499 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
 500 pprIfaceDeclHead context thing tyvars
 501   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
 502           pprIfaceTvBndrs tyvars]
 503
 504 pp_condecls :: OccName -> IfaceConDecls -> SDoc
 505 pp_condecls _  IfAbstractTyCon  = ptext (sLit "{- abstract -}")
 506 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
 507 pp_condecls _  IfOpenDataTyCon  = empty
 508 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
 509                                                             (map (pprIfaceConDecl tc) cs))
 510
 511 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 512 pprIfaceConDecl tc
 513         (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
 514                  ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
 515                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
 516                  ifConStricts = strs, ifConFields = fields })
 517   = sep [main_payload,
 518          if is_infix then ptext (sLit "Infix") else empty,
 519          if has_wrap then ptext (sLit "HasWrapper") else empty,
 520          ppUnless (null strs) $
 521             nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
 522          ppUnless (null fields) $
 523             nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
 524   where
 525     ppr_bang HsNoBang = char '_'        -- Want to see these
 526     ppr_bang bang     = ppr bang
 527
 528     main_payload = ppr name <+> dcolon <+>
 529                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 530
 531     eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
 532               | (tv,ty) <- eq_spec]
 533
 534         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
 535         -- because we don't have a Name for the tycon, only an OccName
 536     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
 537                 (t:ts) -> fsep (t : map (arrow <+>) ts)
 538                 []     -> panic "pp_con_taus"
 539
 540     pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
 541
 542 instance Outputable IfaceRule where
 543   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 544                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
 545     = sep [hsep [doubleQuotes (ftext name), ppr act,
 546                  ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
 547            nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
 548                         ptext (sLit "=") <+> ppr rhs])
 549       ]
 550
 551 instance Outputable IfaceInst where
 552   ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
 553                   ifInstCls = cls, ifInstTys = mb_tcs})
 554     = hang (ptext (sLit "instance") <+> ppr flag
 555                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
 556          2 (equals <+> ppr dfun_id)
 557
 558 instance Outputable IfaceFamInst where
 559   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
 560                      ifFamInstTyCon = tycon_id})
 561     = hang (ptext (sLit "family instance") <+>
 562             ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
 563          2 (equals <+> ppr tycon_id)
 564
 565 ppr_rough :: Maybe IfaceTyCon -> SDoc
 566 ppr_rough Nothing   = dot
 567 ppr_rough (Just tc) = ppr tc
 568 \end{code}
 569
 570
 571 ----------------------------- Printing IfaceExpr ------------------------------------
 572
 573 \begin{code}
 574 instance Outputable IfaceExpr where
 575     ppr e = pprIfaceExpr noParens e
 576
 577 pprParendIfaceExpr :: IfaceExpr -> SDoc
 578 pprParendIfaceExpr = pprIfaceExpr parens
 579
 580 -- | Pretty Print an IfaceExpre
 581 --
 582 -- The first argument should be a function that adds parens in context that need
 583 -- an atomic value (e.g. function args)
 584 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
 585
 586 pprIfaceExpr _       (IfaceLcl v)       = ppr v
 587 pprIfaceExpr _       (IfaceExt v)       = ppr v
 588 pprIfaceExpr _       (IfaceLit l)       = ppr l
 589 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 590 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 591 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 592 pprIfaceExpr _       (IfaceCo co)       = text "@~" <+> pprParendIfaceType co
 593
 594 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 595 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 596
 597 pprIfaceExpr add_par i@(IfaceLam _ _)
 598   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
 599                   pprIfaceExpr noParens body])
 600   where
 601     (bndrs,body) = collect [] i
 602     collect bs (IfaceLam b e) = collect (b:bs) e
 603     collect bs e              = (reverse bs, e)
 604
 605 pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
 606   = add_par (sep [ptext (sLit "case")
 607                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 608                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
 609                   pprIfaceExpr noParens rhs <+> char '}'])
 610
 611 pprIfaceExpr add_par (IfaceCase scrut bndr alts)
 612   = add_par (sep [ptext (sLit "case")
 613                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
 614                         <+> ppr bndr <+> char '{',
 615                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 616
 617 pprIfaceExpr _       (IfaceCast expr co)
 618   = sep [pprParendIfaceExpr expr,
 619          nest 2 (ptext (sLit "`cast`")),
 620          pprParendIfaceType co]
 621
 622 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
 623   = add_par (sep [ptext (sLit "let {"),
 624                   nest 2 (ppr_bind (b, rhs)),
 625                   ptext (sLit "} in"),
 626                   pprIfaceExpr noParens body])
 627
 628 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
 629   = add_par (sep [ptext (sLit "letrec {"),
 630                   nest 2 (sep (map ppr_bind pairs)),
 631                   ptext (sLit "} in"),
 632                   pprIfaceExpr noParens body])
 633
 634 pprIfaceExpr add_par (IfaceNote note body) = add_par $ ppr note
 635                                                 <+> pprParendIfaceExpr body
 636
 637 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
 638 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
 639                          arrow <+> pprIfaceExpr noParens rhs]
 640
 641 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
 642 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 643 ppr_con_bs con bs                     = ppr con <+> hsep (map ppr bs)
 644
 645 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
 646 ppr_bind (IfLetBndr b ty info, rhs)
 647   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
 648          equals <+> pprIfaceExpr noParens rhs]
 649
 650 ------------------
 651 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
 652 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
 653                                           nest 2 (pprParendIfaceExpr arg) : args
 654 pprIfaceApp fun                args = sep (pprParendIfaceExpr fun : args)
 655
 656 ------------------
 657 instance Outputable IfaceNote where
 658     ppr (IfaceSCC cc)     = pprCostCentreCore cc
 659     ppr (IfaceCoreNote s) = ptext (sLit "__core_note")
 660                             <+> pprHsString (mkFastString s)
 661
 662
 663 instance Outputable IfaceConAlt where
 664     ppr IfaceDefault      = text "DEFAULT"
 665     ppr (IfaceLitAlt l)   = ppr l
 666     ppr (IfaceDataAlt d)  = ppr d
 667     ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
 668     -- IfaceTupleAlt is handled by the case-alternative printer
 669
 670 ------------------
 671 instance Outputable IfaceIdDetails where
 672   ppr IfVanillaId       = empty
 673   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
 674                           <+> if b then ptext (sLit "<naughty>") else empty
 675   ppr (IfDFunId ns)     = ptext (sLit "DFunId") <> brackets (int ns)
 676
 677 instance Outputable IfaceIdInfo where
 678   ppr NoInfo       = empty
 679   ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is
 680                      <+> ptext (sLit "-}")
 681
 682 instance Outputable IfaceInfoItem where
 683   ppr (HsUnfold lb unf)  = ptext (sLit "Unfolding")
 684                            <> ppWhen lb (ptext (sLit "(loop-breaker)"))
 685                            <> colon <+> ppr unf
 686   ppr (HsInline prag)    = ptext (sLit "Inline:") <+> ppr prag
 687   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
 688   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
 689   ppr HsNoCafRefs        = ptext (sLit "HasNoCafRefs")
 690
 691 instance Outputable IfaceUnfolding where
 692   ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
 693   ppr (IfCoreUnfold s e)   = (if s then ptext (sLit "<stable>") else empty)
 694                               <+> parens (ppr e)
 695   ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule")
 696                                             <+> ppr (a,uok,bok),
 697                                         pprParendIfaceExpr e]
 698   ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
 699                              <+> parens (ptext (sLit "arity") <+> int a)
 700   ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
 701                              <+> parens (ptext (sLit "arity") <+> int a)
 702   ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:")
 703                              <+> brackets (pprWithCommas ppr ns)
 704
 705 -- -----------------------------------------------------------------------------
 706 -- | Finding the Names in IfaceSyn
 707
 708 -- This is used for dependency analysis in MkIface, so that we
 709 -- fingerprint a declaration before the things that depend on it.  It
 710 -- is specific to interface-file fingerprinting in the sense that we
 711 -- don't collect *all* Names: for example, the DFun of an instance is
 712 -- recorded textually rather than by its fingerprint when
 713 -- fingerprinting the instance, so DFuns are not dependencies.
 714
 715 freeNamesIfDecl :: IfaceDecl -> NameSet
 716 freeNamesIfDecl (IfaceId _s t d i) =
 717   freeNamesIfType t &&&
 718   freeNamesIfIdInfo i &&&
 719   freeNamesIfIdDetails d
 720 freeNamesIfDecl IfaceForeign{} =
 721   emptyNameSet
 722 freeNamesIfDecl d@IfaceData{} =
 723   freeNamesIfTvBndrs (ifTyVars d) &&&
 724   freeNamesIfTcFam (ifFamInst d) &&&
 725   freeNamesIfContext (ifCtxt d) &&&
 726   freeNamesIfConDecls (ifCons d)
 727 freeNamesIfDecl d@IfaceSyn{} =
 728   freeNamesIfTvBndrs (ifTyVars d) &&&
 729   freeNamesIfSynRhs (ifSynRhs d) &&&
 730   freeNamesIfTcFam (ifFamInst d)
 731 freeNamesIfDecl d@IfaceClass{} =
 732   freeNamesIfTvBndrs (ifTyVars d) &&&
 733   freeNamesIfContext (ifCtxt d) &&&
 734   freeNamesIfDecls   (ifATs d) &&&
 735   fnList freeNamesIfClsSig (ifSigs d)
 736
 737 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
 738 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
 739 freeNamesIfIdDetails _                 = emptyNameSet
 740
 741 -- All other changes are handled via the version info on the tycon
 742 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
 743 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
 744 freeNamesIfSynRhs Nothing   = emptyNameSet
 745
 746 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
 747 freeNamesIfTcFam (Just (tc,tys)) =
 748   freeNamesIfTc tc &&& fnList freeNamesIfType tys
 749 freeNamesIfTcFam Nothing =
 750   emptyNameSet
 751
 752 freeNamesIfContext :: IfaceContext -> NameSet
 753 freeNamesIfContext = fnList freeNamesIfPredType
 754
 755 freeNamesIfDecls :: [IfaceDecl] -> NameSet
 756 freeNamesIfDecls = fnList freeNamesIfDecl
 757
 758 freeNamesIfClsSig :: IfaceClassOp -> NameSet
 759 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
 760
 761 freeNamesIfConDecls :: IfaceConDecls -> NameSet
 762 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
 763 freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
 764 freeNamesIfConDecls _               = emptyNameSet
 765
 766 freeNamesIfConDecl :: IfaceConDecl -> NameSet
 767 freeNamesIfConDecl c =
 768   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
 769   freeNamesIfTvBndrs (ifConExTvs c) &&&
 770   freeNamesIfContext (ifConCtxt c) &&&
 771   fnList freeNamesIfType (ifConArgTys c) &&&
 772   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 773
 774 freeNamesIfPredType :: IfacePredType -> NameSet
 775 freeNamesIfPredType (IfaceClassP cl tys) =
 776    unitNameSet cl &&& fnList freeNamesIfType tys
 777 freeNamesIfPredType (IfaceIParam _n ty) =
 778    freeNamesIfType ty
 779 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
 780    freeNamesIfType ty1 &&& freeNamesIfType ty2
 781
 782 freeNamesIfType :: IfaceType -> NameSet
 783 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 784 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 785 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
 786 freeNamesIfType (IfaceTyConApp tc ts) =
 787    freeNamesIfTc tc &&& fnList freeNamesIfType ts
 788 freeNamesIfType (IfaceForAllTy tv t)  =
 789    freeNamesIfTvBndr tv &&& freeNamesIfType t
 790 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 791 freeNamesIfType (IfaceCoConApp tc ts) =
 792    freeNamesIfCo tc &&& fnList freeNamesIfType ts
 793
 794 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
 795 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
 796
 797 freeNamesIfBndr :: IfaceBndr -> NameSet
 798 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
 799 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
 800
 801 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
 802 -- Remember IfaceLetBndr is used only for *nested* bindings
 803 -- The IdInfo can contain an unfolding (in the case of
 804 -- local INLINE pragmas), so look there too
 805 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
 806                                              &&& freeNamesIfIdInfo info
 807
 808 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
 809 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
 810     -- kinds can have Names inside, when the Kind is an equality predicate
 811
 812 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
 813 freeNamesIfIdBndr = freeNamesIfTvBndr
 814
 815 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 816 freeNamesIfIdInfo NoInfo      = emptyNameSet
 817 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 818
 819 freeNamesItem :: IfaceInfoItem -> NameSet
 820 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
 821 freeNamesItem _              = emptyNameSet
 822
 823 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
 824 freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
 825 freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 826 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 827 freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
 828 freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
 829 freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)
 830
 831 freeNamesIfExpr :: IfaceExpr -> NameSet
 832 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
 833 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 834 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 835 freeNamesIfExpr (IfaceCo co)      = freeNamesIfType co
 836 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
 837 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
 838 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
 839 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
 840 freeNamesIfExpr (IfaceNote _n r)  = freeNamesIfExpr r
 841
 842 freeNamesIfExpr (IfaceCase s _ alts)
 843   = freeNamesIfExpr s
 844     &&& fnList fn_alt alts &&& fn_cons alts
 845   where
 846     fn_alt (_con,_bs,r) = freeNamesIfExpr r
 847
 848     -- Depend on the data constructors.  Just one will do!
 849     -- Note [Tracking data constructors]
 850     fn_cons []                            = emptyNameSet
 851     fn_cons ((IfaceDefault    ,_,_) : xs) = fn_cons xs
 852     fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
 853     fn_cons (_                      : _ ) = emptyNameSet
 854
 855 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
 856   = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
 857
 858 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 859   = fnList fn_pair as &&& freeNamesIfExpr x
 860   where
 861     fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
 862
 863 freeNamesIfExpr _ = emptyNameSet
 864
 865 freeNamesIfTc :: IfaceTyCon -> NameSet
 866 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 867 -- ToDo: shouldn't we include IfaceIntTc & co.?
 868 freeNamesIfTc _ = emptyNameSet
 869
 870 freeNamesIfCo :: IfaceCoCon -> NameSet
 871 freeNamesIfCo (IfaceCoAx tc) = unitNameSet tc
 872 freeNamesIfCo _ = emptyNameSet
 873
 874 freeNamesIfRule :: IfaceRule -> NameSet
 875 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
 876                            , ifRuleArgs = es, ifRuleRhs = rhs })
 877   = unitNameSet f &&&
 878     fnList freeNamesIfBndr bs &&&
 879     fnList freeNamesIfExpr es &&&
 880     freeNamesIfExpr rhs
 881
 882 -- helpers
 883 (&&&) :: NameSet -> NameSet -> NameSet
 884 (&&&) = unionNameSets
 885
 886 fnList :: (a -> NameSet) -> [a] -> NameSet
 887 fnList f = foldr (&&&) emptyNameSet . map f
 888 \end{code}
 889
 890 Note [Tracking data constructors]
 891 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 892 In a case expression
 893    case e of { C a -> ...; ... }
 894 You might think that we don't need to include the datacon C
 895 in the free names, because its type will probably show up in
 896 the free names of 'e'.  But in rare circumstances this may
 897 not happen.   Here's the one that bit me:
 898
 899    module DynFlags where
 900      import {-# SOURCE #-} Packages( PackageState )
 901      data DynFlags = DF ... PackageState ...
 902
 903    module Packages where
 904      import DynFlags
 905      data PackageState = PS ...
 906      lookupModule (df :: DynFlags)
 907         = case df of
 908               DF ...p... -> case p of
 909                                PS ... -> ...
 910
 911 Now, lookupModule depends on DynFlags, but the transitive dependency
 912 on the *locally-defined* type PackageState is not visible. We need
 913 to take account of the use of the data constructor PS in the pattern match.
 914