compiler/iface/MkIface.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 MkIface (
   8         mkUsedNames,
   9         mkDependencies,
  10         mkIface,        -- Build a ModIface from a ModGuts,
  11                         -- including computing version information
  12
  13         mkIfaceTc,
  14
  15         writeIfaceFile, -- Write the interface file
  16
  17         checkOldIface,  -- See if recompilation is required, by
  18                         -- comparing version information
  19
  20         tyThingToIfaceDecl -- Converting things to their Iface equivalents
  21  ) where
  22 \end{code}
  23
  24         -----------------------------------------------
  25                 MkIface.lhs deals with versioning
  26         -----------------------------------------------
  27
  28 Here's the fingerprint-related info in an interface file
  29
  30   module Foo xxxxxxxxxxxxxxxx  -- module fingerprint
  31              yyyyyyyyyyyyyyyy  -- export list fingerprint
  32              zzzzzzzzzzzzzzzz  -- rule fingerprint
  33     Usages:     -- Version info for what this compilation of Foo imported
  34         Baz xxxxxxxxxxxxxxxx    -- Module version
  35             [yyyyyyyyyyyyyyyy]  -- The export-list version
  36                                 -- ( if Foo depended on it)
  37             (g,zzzzzzzzzzzzzzzz) -- Function and its version
  38             (T,wwwwwwwwwwwwwwww) -- Type and its version
  39
  40     <fingerprint> f :: Int -> Int {- Unfolding: \x -> Wib.t x -}
  41
  42         -----------------------------------------------
  43                         Basic idea
  44         -----------------------------------------------
  45
  46 Basic idea:
  47   * In the mi_usages information in an interface, we record the
  48     fingerprint of each free variable of the module
  49
  50   * In mkIface, we compute the fingerprint of each exported thing A.f.
  51     For each external thing that A.f refers to, we include the fingerprint
  52     of the external reference when computing the fingerprint of A.f.  So
  53     if anything that A.f depends on changes, then A.f's fingerprint will
  54     change.
  55
  56   * In checkOldIface we compare the mi_usages for the module with
  57     the actual fingerprint for all each thing recorded in mi_usages
  58
  59 Fixities
  60 ~~~~~~~~
  61 We count A.f as changing if its fixity changes
  62
  63 Rules
  64 ~~~~~
  65 If a rule changes, we want to recompile any module that might be
  66 affected by that rule.  For non-orphan rules, this is relatively easy.
  67 If module M defines f, and a rule for f, just arrange that the fingerprint
  68 for M.f changes if any of the rules for M.f change.  Any module
  69 that does not depend on M.f can't be affected by the rule-change
  70 either.
  71
  72 Orphan rules (ones whose 'head function' is not defined in M) are
  73 harder.  Here's what we do.
  74
  75   * We have a per-module orphan-rule fingerprint which changes if
  76     any orphan rule changes. (It's unaffected by non-orphan rules.)
  77
  78   * We record usage info for any orphan module 'below' this one,
  79     giving the orphan-rule fingerprint.  We recompile if this
  80     changes.
  81
  82 The net effect is that if an orphan rule changes, we recompile every
  83 module above it.  That's very conservative, but it's devilishly hard
  84 to know what it might affect, so we just have to be conservative.
  85
  86 Instance decls
  87 ~~~~~~~~~~~~~~
  88 In an iface file we have
  89      module A where
  90         instance Eq a => Eq [a]  =  dfun29
  91         dfun29 :: ...
  92
  93 We have a fingerprint for dfun29, covering its unfolding
  94 etc. Suppose we are compiling a module M that imports A only
  95 indirectly.  If typechecking M uses this instance decl, we record the
  96 dependency on A.dfun29 as if it were a free variable of the module
  97 (via the tcg_inst_usages accumulator).  That means that A will appear
  98 in M's usage list.  If the shape of the instance declaration changes,
  99 then so will dfun29's fingerprint, triggering a recompilation.
 100
 101 Adding an instance declaration, or changing an instance decl that is
 102 not currently used, is more tricky.  (This really only makes a
 103 difference when we have overlapping instance decls, because then the
 104 new instance decl might kick in to override the old one.)  We handle
 105 this in a very similar way that we handle rules above.
 106
 107   * For non-orphan instance decls, identify one locally-defined tycon/class
 108     mentioned in the decl.  Treat the instance decl as part of the defn of that
 109     tycon/class, so that if the shape of the instance decl changes, so does the
 110     tycon/class; that in turn will force recompilation of anything that uses
 111     that tycon/class.
 112
 113   * For orphan instance decls, act the same way as for orphan rules.
 114     Indeed, we use the same global orphan-rule version number.
 115
 116 mkUsageInfo
 117 ~~~~~~~~~~~
 118 mkUsageInfo figures out what the ``usage information'' for this
 119 moudule is; that is, what it must record in its interface file as the
 120 things it uses.
 121
 122 We produce a line for every module B below the module, A, currently being
 123 compiled:
 124         import B <n> ;
 125 to record the fact that A does import B indirectly.  This is used to decide
 126 to look for B.hi rather than B.hi-boot when compiling a module that
 127 imports A.  This line says that A imports B, but uses nothing in it.
 128 So we'll get an early bale-out when compiling A if B's fingerprint changes.
 129
 130 The usage information records:
 131
 132 \begin{itemize}
 133 \item   (a) anything reachable from its body code
 134 \item   (b) any module exported with a @module Foo@
 135 \item   (c) anything reachable from an exported item
 136 \end{itemize}
 137
 138 Why (b)?  Because if @Foo@ changes then this module's export list
 139 will change, so we must recompile this module at least as far as
 140 making a new interface file --- but in practice that means complete
 141 recompilation.
 142
 143 Why (c)?  Consider this:
 144 \begin{verbatim}
 145         module A( f, g ) where  |       module B( f ) where
 146           import B( f )         |         f = h 3
 147           g = ...               |         h = ...
 148 \end{verbatim}
 149
 150 Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
 151 @A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
 152 *identical* to what it was before.  If anything about @B.f@ changes
 153 than anyone who imports @A@ should be recompiled in case they use
 154 @B.f@ (they'll get an early exit if they don't).  So, if anything
 155 about @B.f@ changes we'd better make sure that something in A.hi
 156 changes, and the convenient way to do that is to record the version
 157 number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
 158 complete recompiation of A, which is overkill but it's the only way to
 159 write a new, slightly different, A.hi.
 160
 161 But the example is tricker.  Even if @B.f@ doesn't change at all,
 162 @B.h@ may do so, and this change may not be reflected in @f@'s version
 163 number.  But with -O, a module that imports A must be recompiled if
 164 @B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
 165 the occurrence of @B.f@ in the export list *just as if* it were in the
 166 code of A, and thereby haul in all the stuff reachable from it.
 167
 168         *** Conclusion: if A mentions B.f in its export list,
 169             behave just as if A mentioned B.f in its source code,
 170             and slurp in B.f and all its transitive closure ***
 171
 172 [NB: If B was compiled with -O, but A isn't, we should really *still*
 173 haul in all the unfoldings for B, in case the module that imports A *is*
 174 compiled with -O.  I think this is the case.]
 175
 176 SimonM [30/11/2007]: I believe the above is all out of date; the
 177 current implementation doesn't do it this way.  Instead, when any of
 178 the dependencies of a declaration changes, the version of the
 179 declaration itself changes.
 180
 181 \begin{code}
 182 #include "HsVersions.h"
 183
 184 import IfaceSyn
 185 import IfaceType
 186 import LoadIface
 187 import Id
 188 import IdInfo
 189 import NewDemand
 190 import CoreSyn
 191 import CoreFVs
 192 import Class
 193 import TyCon
 194 import DataCon
 195 import Type
 196 import TcType
 197 import InstEnv
 198 import FamInstEnv
 199 import TcRnMonad
 200 import HscTypes
 201 import Finder
 202 import DynFlags
 203 import VarEnv
 204 import Var
 205 import Name
 206 import RdrName
 207 import NameEnv
 208 import NameSet
 209 import OccName
 210 import Module
 211 import BinIface
 212 import ErrUtils
 213 import Digraph
 214 import SrcLoc
 215 import Outputable
 216 import BasicTypes       hiding ( SuccessFlag(..) )
 217 import LazyUniqFM
 218 import Unique
 219 import Util             hiding ( eqListBy )
 220 import FiniteMap
 221 import FastString
 222 import Maybes
 223 import ListSetOps
 224 import Binary
 225 import Fingerprint
 226 import Panic
 227
 228 import Control.Monad
 229 import Data.List
 230 import Data.IORef
 231 import System.FilePath
 232 \end{code}
 233
 234
 235
 236 %************************************************************************
 237 %*                                                                      *
 238 \subsection{Completing an interface}
 239 %*                                                                      *
 240 %************************************************************************
 241
 242 \begin{code}
 243 mkIface :: HscEnv
 244         -> Maybe Fingerprint    -- The old fingerprint, if we have it
 245         -> ModDetails           -- The trimmed, tidied interface
 246         -> ModGuts              -- Usages, deprecations, etc
 247         -> IO (ModIface,        -- The new one
 248                Bool)            -- True <=> there was an old Iface, and the
 249                                 --          new one is identical, so no need
 250                                 --          to write it
 251
 252 mkIface hsc_env maybe_old_fingerprint mod_details
 253          ModGuts{     mg_module    = this_mod,
 254                       mg_boot      = is_boot,
 255                       mg_used_names = used_names,
 256                       mg_deps      = deps,
 257                       mg_dir_imps  = dir_imp_mods,
 258                       mg_rdr_env   = rdr_env,
 259                       mg_fix_env   = fix_env,
 260                       mg_deprecs   = deprecs,
 261                       mg_hpc_info  = hpc_info }
 262         = mkIface_ hsc_env maybe_old_fingerprint
 263                    this_mod is_boot used_names deps rdr_env
 264                    fix_env deprecs hpc_info dir_imp_mods mod_details
 265
 266 -- | make an interface from the results of typechecking only.  Useful
 267 -- for non-optimising compilation, or where we aren't generating any
 268 -- object code at all ('HscNothing').
 269 mkIfaceTc :: HscEnv
 270           -> Maybe Fingerprint  -- The old fingerprint, if we have it
 271           -> ModDetails         -- gotten from mkBootModDetails, probably
 272           -> TcGblEnv           -- Usages, deprecations, etc
 273           -> IO (ModIface,
 274                  Bool)
 275 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
 276   tc_result@TcGblEnv{ tcg_mod = this_mod,
 277                       tcg_src = hsc_src,
 278                       tcg_imports = imports,
 279                       tcg_rdr_env = rdr_env,
 280                       tcg_fix_env = fix_env,
 281                       tcg_deprecs = deprecs,
 282                       tcg_hpc = other_hpc_info
 283                     }
 284   = do
 285           used_names <- mkUsedNames tc_result
 286           deps <- mkDependencies tc_result
 287           let hpc_info = emptyHpcInfo other_hpc_info
 288           mkIface_ hsc_env maybe_old_fingerprint
 289                    this_mod (isHsBoot hsc_src) used_names deps rdr_env
 290                    fix_env deprecs hpc_info (imp_mods imports) mod_details
 291
 292
 293 mkUsedNames :: TcGblEnv -> IO NameSet
 294 mkUsedNames
 295           TcGblEnv{ tcg_inst_uses = dfun_uses_var,
 296                     tcg_dus = dus
 297                   }
 298  = do
 299         dfun_uses <- readIORef dfun_uses_var            -- What dfuns are used
 300         return (allUses dus `unionNameSets` dfun_uses)
 301
 302 mkDependencies :: TcGblEnv -> IO Dependencies
 303 mkDependencies
 304           TcGblEnv{ tcg_mod = mod,
 305                     tcg_imports = imports,
 306                     tcg_th_used = th_var
 307                   }
 308  = do
 309       th_used   <- readIORef th_var                     -- Whether TH is used
 310       let
 311         dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
 312                 -- M.hi-boot can be in the imp_dep_mods, but we must remove
 313                 -- it before recording the modules on which this one depends!
 314                 -- (We want to retain M.hi-boot in imp_dep_mods so that
 315                 --  loadHiBootInterface can see if M's direct imports depend
 316                 --  on M.hi-boot, and hence that we should do the hi-boot consistency
 317                 --  check.)
 318
 319                 -- Modules don't compare lexicographically usually,
 320                 -- but we want them to do so here.
 321         le_mod :: Module -> Module -> Bool
 322         le_mod m1 m2 = moduleNameFS (moduleName m1)
 323                            <= moduleNameFS (moduleName m2)
 324
 325         le_dep_mod :: (ModuleName, IsBootInterface)
 326                     -> (ModuleName, IsBootInterface) -> Bool
 327         le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
 328
 329
 330         pkgs | th_used   = insertList thPackageId (imp_dep_pkgs imports)
 331              | otherwise = imp_dep_pkgs imports
 332
 333       return Deps { dep_mods   = sortLe le_dep_mod dep_mods,
 334                     dep_pkgs   = sortLe (<=)   pkgs,
 335                     dep_orphs  = sortLe le_mod (imp_orphs  imports),
 336                     dep_finsts = sortLe le_mod (imp_finsts imports) }
 337                 -- sort to get into canonical order
 338
 339
 340 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
 341          -> NameSet -> Dependencies -> GlobalRdrEnv
 342          -> NameEnv FixItem -> Deprecations -> HpcInfo
 343          -> ImportedMods
 344          -> ModDetails
 345          -> IO (ModIface, Bool)
 346 mkIface_ hsc_env maybe_old_fingerprint
 347          this_mod is_boot used_names deps rdr_env fix_env src_deprecs hpc_info
 348          dir_imp_mods
 349          ModDetails{  md_insts     = insts,
 350                       md_fam_insts = fam_insts,
 351                       md_rules     = rules,
 352                       md_vect_info = vect_info,
 353                       md_types     = type_env,
 354                       md_exports   = exports }
 355 -- NB:  notice that mkIface does not look at the bindings
 356 --      only at the TypeEnv.  The previous Tidy phase has
 357 --      put exactly the info into the TypeEnv that we want
 358 --      to expose in the interface
 359
 360   = do  { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
 361
 362         ; let   { entities = typeEnvElts type_env ;
 363                   decls  = [ tyThingToIfaceDecl entity
 364                            | entity <- entities,
 365                              let name = getName entity,
 366                              not (isImplicitTyThing entity),
 367                                 -- No implicit Ids and class tycons in the interface file
 368                              not (isWiredInName name),
 369                                 -- Nor wired-in things; the compiler knows about them anyhow
 370                              nameIsLocalOrFrom this_mod name  ]
 371                                 -- Sigh: see Note [Root-main Id] in TcRnDriver
 372
 373                 ; fixities    = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
 374                 ; deprecs     = src_deprecs
 375                 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
 376                 ; iface_insts = map instanceToIfaceInst insts
 377                 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
 378                 ; iface_vect_info = flattenVectInfo vect_info
 379
 380                 ; intermediate_iface = ModIface {
 381                         mi_module   = this_mod,
 382                         mi_boot     = is_boot,
 383                         mi_deps     = deps,
 384                         mi_usages   = usages,
 385                         mi_exports  = mkIfaceExports exports,
 386
 387                         -- Sort these lexicographically, so that
 388                         -- the result is stable across compilations
 389                         mi_insts    = sortLe le_inst iface_insts,
 390                         mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
 391                         mi_rules    = sortLe le_rule iface_rules,
 392
 393                         mi_vect_info = iface_vect_info,
 394
 395                         mi_fixities = fixities,
 396                         mi_deprecs  = deprecs,
 397                         mi_globals  = Just rdr_env,
 398
 399                         -- Left out deliberately: filled in by addVersionInfo
 400                         mi_iface_hash = fingerprint0,
 401                         mi_mod_hash  = fingerprint0,
 402                         mi_exp_hash  = fingerprint0,
 403                         mi_orphan_hash = fingerprint0,
 404                         mi_orphan    = False,   -- Always set by addVersionInfo, but
 405                                                 -- it's a strict field, so we can't omit it.
 406                         mi_finsts    = False,   -- Ditto
 407                         mi_decls     = deliberatelyOmitted "decls",
 408                         mi_hash_fn   = deliberatelyOmitted "hash_fn",
 409                         mi_hpc       = isHpcUsed hpc_info,
 410
 411                         -- And build the cached values
 412                         mi_dep_fn = mkIfaceDepCache deprecs,
 413                         mi_fix_fn = mkIfaceFixCache fixities }
 414                 }
 415
 416         ; (new_iface, no_change_at_all, pp_orphs)
 417                 <- {-# SCC "versioninfo" #-}
 418                          addFingerprints hsc_env maybe_old_fingerprint
 419                                          intermediate_iface decls
 420
 421                 -- Debug printing
 422         ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
 423                (printDump (expectJust "mkIface" pp_orphs))
 424
 425 -- XXX  ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
 426
 427         ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
 428                         (pprModIface new_iface)
 429
 430                 -- bug #1617: on reload we weren't updating the PrintUnqualified
 431                 -- correctly.  This stems from the fact that the interface had
 432                 -- not changed, so addVersionInfo returns the old ModIface
 433                 -- with the old GlobalRdrEnv (mi_globals).
 434         ; let final_iface = new_iface{ mi_globals = Just rdr_env }
 435
 436         ; return (final_iface, no_change_at_all) }
 437   where
 438      r1 `le_rule`     r2 = ifRuleName      r1    <=    ifRuleName      r2
 439      i1 `le_inst`     i2 = ifDFun          i1 `le_occ` ifDFun          i2
 440      i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
 441
 442      le_occ :: Name -> Name -> Bool
 443         -- Compare lexicographically by OccName, *not* by unique, because
 444         -- the latter is not stable across compilations
 445      le_occ n1 n2 = nameOccName n1 <= nameOccName n2
 446
 447      dflags = hsc_dflags hsc_env
 448      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
 449      ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
 450
 451      flattenVectInfo (VectInfo { vectInfoVar   = vVar
 452                                , vectInfoTyCon = vTyCon
 453                                }) =
 454        IfaceVectInfo {
 455          ifaceVectInfoVar        = [ Var.varName v
 456                                    | (v, _) <- varEnvElts vVar],
 457          ifaceVectInfoTyCon      = [ tyConName t
 458                                    | (t, t_v) <- nameEnvElts vTyCon
 459                                    , t /= t_v],
 460          ifaceVectInfoTyConReuse = [ tyConName t
 461                                    | (t, t_v) <- nameEnvElts vTyCon
 462                                    , t == t_v]
 463        }
 464
 465 -----------------------------
 466 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
 467 writeIfaceFile dflags location new_iface
 468     = do createDirectoryHierarchy (takeDirectory hi_file_path)
 469          writeBinIface dflags hi_file_path new_iface
 470     where hi_file_path = ml_hi_file location
 471
 472
 473 -- -----------------------------------------------------------------------------
 474 -- Look up parents and versions of Names
 475
 476 -- This is like a global version of the mi_hash_fn field in each ModIface.
 477 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
 478 -- the parent and version info.
 479
 480 mkHashFun
 481         :: HscEnv                       -- needed to look up versions
 482         -> ExternalPackageState         -- ditto
 483         -> (Name -> Fingerprint)
 484 mkHashFun hsc_env eps
 485   = \name ->
 486       let
 487         mod = nameModule name
 488         occ = nameOccName name
 489         iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
 490                    pprPanic "lookupVers2" (ppr mod <+> ppr occ)
 491       in
 492         snd (mi_hash_fn iface occ `orElse`
 493                   pprPanic "lookupVers1" (ppr mod <+> ppr occ))
 494   where
 495       hpt = hsc_HPT hsc_env
 496       pit = eps_PIT eps
 497
 498 -- ---------------------------------------------------------------------------
 499 -- Compute fingerprints for the interface
 500
 501 addFingerprints
 502         :: HscEnv
 503         -> Maybe Fingerprint -- the old fingerprint, if any
 504         -> ModIface          -- The new interface (lacking decls)
 505         -> [IfaceDecl]       -- The new decls
 506         -> IO (ModIface,     -- Updated interface
 507                Bool,         -- True <=> no changes at all;
 508                              -- no need to write Iface
 509                Maybe SDoc)   -- Warnings about orphans
 510
 511 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
 512  = do
 513    eps <- hscEPS hsc_env
 514    let
 515         -- the ABI of a declaration represents everything that is made
 516         -- visible about the declaration that a client can depend on.
 517         -- see IfaceDeclABI below.
 518        declABI :: IfaceDecl -> IfaceDeclABI
 519        declABI decl = (this_mod, decl, extras)
 520         where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
 521
 522        edges :: [(IfaceDeclABI, Unique, [Unique])]
 523        edges = [ (abi, getUnique (ifName decl), out)
 524                | decl <- new_decls
 525                , let abi = declABI decl
 526                , let out = localOccs $ freeNamesDeclABI abi
 527                ]
 528
 529        localOccs = map (getUnique . getParent . getOccName)
 530                         . filter ((== this_mod) . nameModule)
 531                         . nameSetToList
 532           where getParent occ = lookupOccEnv parent_map occ `orElse` occ
 533
 534         -- maps OccNames to their parents in the current module.
 535         -- e.g. a reference to a constructor must be turned into a reference
 536         -- to the TyCon for the purposes of calculating dependencies.
 537        parent_map :: OccEnv OccName
 538        parent_map = foldr extend emptyOccEnv new_decls
 539           where extend d env =
 540                   extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
 541                   where n = ifName d
 542
 543         -- strongly-connected groups of declarations, in dependency order
 544        groups = stronglyConnComp edges
 545
 546        global_hash_fn = mkHashFun hsc_env eps
 547
 548         -- how to output Names when generating the data to fingerprint.
 549         -- Here we want to output the fingerprint for each top-level
 550         -- Name, whether it comes from the current module or another
 551         -- module.  In this way, the fingerprint for a declaration will
 552         -- change if the fingerprint for anything it refers to (transitively)
 553         -- changes.
 554        mk_put_name :: (OccEnv (OccName,Fingerprint))
 555                    -> BinHandle -> Name -> IO  ()
 556        mk_put_name local_env bh name
 557           | isWiredInName name  =  putNameLiterally bh name
 558            -- wired-in names don't have fingerprints
 559           | otherwise
 560           = let hash | nameModule name /= this_mod =  global_hash_fn name
 561                      | otherwise =
 562                         snd (lookupOccEnv local_env (getOccName name)
 563                            `orElse` pprPanic "urk! lookup local fingerprint"
 564                                        (ppr name)) -- (undefined,fingerprint0))
 565                 -- This panic indicates that we got the dependency
 566                 -- analysis wrong, because we needed a fingerprint for
 567                 -- an entity that wasn't in the environment.  To debug
 568                 -- it, turn the panic into a trace, uncomment the
 569                 -- pprTraces below, run the compile again, and inspect
 570                 -- the output and the generated .hi file with
 571                 -- --show-iface.
 572             in
 573             put_ bh hash
 574
 575         -- take a strongly-connected group of declarations and compute
 576         -- its fingerprint.
 577
 578        fingerprint_group :: (OccEnv (OccName,Fingerprint),
 579                              [(Fingerprint,IfaceDecl)])
 580                          -> SCC IfaceDeclABI
 581                          -> IO (OccEnv (OccName,Fingerprint),
 582                                 [(Fingerprint,IfaceDecl)])
 583
 584        fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
 585           = do let hash_fn = mk_put_name local_env
 586                    decl = abiDecl abi
 587                -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
 588                hash <- computeFingerprint dflags hash_fn abi
 589                return (extend_hash_env (hash,decl) local_env,
 590                        (hash,decl) : decls_w_hashes)
 591
 592        fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
 593           = do let decls = map abiDecl abis
 594                    local_env' = foldr extend_hash_env local_env
 595                                    (zip (repeat fingerprint0) decls)
 596                    hash_fn = mk_put_name local_env'
 597                -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
 598                let stable_abis = sortBy cmp_abiNames abis
 599                 -- put the cycle in a canonical order
 600                hash <- computeFingerprint dflags hash_fn stable_abis
 601                let pairs = zip (repeat hash) decls
 602                return (foldr extend_hash_env local_env pairs,
 603                        pairs ++ decls_w_hashes)
 604
 605        extend_hash_env :: (Fingerprint,IfaceDecl)
 606                        -> OccEnv (OccName,Fingerprint)
 607                        -> OccEnv (OccName,Fingerprint)
 608        extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
 609         where
 610           decl_name = ifName d
 611           item = (decl_name, hash)
 612           env1 = extendOccEnv env0 decl_name item
 613           add_imp bndr env = extendOccEnv env bndr item
 614
 615    --
 616    (local_env, decls_w_hashes) <-
 617        foldM fingerprint_group (emptyOccEnv, []) groups
 618
 619    -- when calculating fingerprints, we always need to use canonical
 620    -- ordering for lists of things.  In particular, the mi_deps has various
 621    -- lists of modules and suchlike, so put these all in canonical order:
 622    let sorted_deps = sortDependencies (mi_deps iface0)
 623
 624    -- the export hash of a module depends on the orphan hashes of the
 625    -- orphan modules below us in the dependeny tree.  This is the way
 626    -- that changes in orphans get propagated all the way up the
 627    -- dependency tree.  We only care about orphan modules in the current
 628    -- package, because changes to orphans outside this package will be
 629    -- tracked by the usage on the ABI hash of package modules that we import.
 630    let orph_mods = filter ((== this_pkg) . modulePackageId)
 631                    $ dep_orphs sorted_deps
 632    dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
 633
 634    orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
 635                       (map IfaceInstABI orph_insts, orph_rules, fam_insts)
 636
 637    -- the export list hash doesn't depend on the fingerprints of
 638    -- the Names it mentions, only the Names themselves, hence putNameLiterally.
 639    export_hash <- computeFingerprint dflags putNameLiterally
 640                       (mi_exports iface0, orphan_hash, dep_orphan_hashes)
 641
 642    -- put the declarations in a canonical order, sorted by OccName
 643    let sorted_decls = eltsFM $ listToFM $
 644                           [(ifName d, e) | e@(_, d) <- decls_w_hashes]
 645
 646    -- the ABI hash depends on:
 647    --   - decls
 648    --   - export list
 649    --   - orphans
 650    --   - deprecations
 651    --   - XXX vect info?
 652    mod_hash <- computeFingerprint dflags putNameLiterally
 653                       (map fst sorted_decls,
 654                        export_hash,
 655                        orphan_hash,
 656                        mi_deprecs iface0)
 657
 658    -- The interface hash depends on:
 659    --    - the ABI hash, plus
 660    --    - usages
 661    --    - deps
 662    --    - hpc
 663    iface_hash <- computeFingerprint dflags putNameLiterally
 664                       (mod_hash,
 665                        mi_usages iface0,
 666                        sorted_deps,
 667                        mi_hpc iface0)
 668
 669    let
 670     no_change_at_all = Just iface_hash == mb_old_fingerprint
 671
 672     final_iface = iface0 {
 673                 mi_mod_hash    = mod_hash,
 674                 mi_iface_hash  = iface_hash,
 675                 mi_exp_hash    = export_hash,
 676                 mi_orphan_hash = orphan_hash,
 677                 mi_orphan      = not (null orph_rules && null orph_insts),
 678                 mi_finsts      = not . null $ mi_fam_insts iface0,
 679                 mi_decls       = sorted_decls,
 680                 mi_hash_fn     = lookupOccEnv local_env }
 681    --
 682    return (final_iface, no_change_at_all, pp_orphs)
 683
 684   where
 685     this_mod = mi_module iface0
 686     dflags = hsc_dflags hsc_env
 687     this_pkg = thisPackage dflags
 688     (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
 689     (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
 690         -- ToDo: shouldn't we be splitting fam_insts into orphans and
 691         -- non-orphans?
 692     fam_insts = mi_fam_insts iface0
 693     fix_fn = mi_fix_fn iface0
 694     pp_orphs = pprOrphans orph_insts orph_rules
 695
 696
 697 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
 698 getOrphanHashes hsc_env mods = do
 699   eps <- hscEPS hsc_env
 700   let
 701     hpt        = hsc_HPT hsc_env
 702     pit        = eps_PIT eps
 703     dflags     = hsc_dflags hsc_env
 704     get_orph_hash mod =
 705           case lookupIfaceByModule dflags hpt pit mod of
 706             Nothing    -> pprPanic "moduleOrphanHash" (ppr mod)
 707             Just iface -> mi_orphan_hash iface
 708   --
 709   return (map get_orph_hash mods)
 710
 711
 712 sortDependencies :: Dependencies -> Dependencies
 713 sortDependencies d
 714  = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
 715           dep_pkgs   = sortBy (compare `on` packageIdFS)  (dep_pkgs d),
 716           dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
 717           dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
 718
 719 -- The ABI of a declaration consists of:
 720      -- the full name of the identifier (inc. module and package, because
 721      --   these are used to construct the symbol name by which the
 722      --   identifier is known externally).
 723      -- the fixity of the identifier
 724      -- the declaration itself, as exposed to clients.  That is, the
 725      --   definition of an Id is included in the fingerprint only if
 726      --   it is made available as as unfolding in the interface.
 727      -- for Ids: rules
 728      -- for classes: instances, fixity & rules for methods
 729      -- for datatypes: instances, fixity & rules for constrs
 730 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
 731
 732 abiDecl :: IfaceDeclABI -> IfaceDecl
 733 abiDecl (_, decl, _) = decl
 734
 735 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
 736 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
 737                          ifName (abiDecl abi2)
 738
 739 freeNamesDeclABI :: IfaceDeclABI -> NameSet
 740 freeNamesDeclABI (_mod, decl, extras) =
 741   freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
 742
 743 data IfaceDeclExtras
 744   = IfaceIdExtras    Fixity [IfaceRule]
 745   | IfaceDataExtras  Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
 746   | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
 747   | IfaceOtherDeclExtras
 748
 749 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
 750 freeNamesDeclExtras (IfaceIdExtras    _ rules)
 751   = unionManyNameSets (map freeNamesIfRule rules)
 752 freeNamesDeclExtras (IfaceDataExtras  _ _insts subs)
 753   = unionManyNameSets (map freeNamesSub subs)
 754 freeNamesDeclExtras (IfaceClassExtras _insts subs)
 755   = unionManyNameSets (map freeNamesSub subs)
 756 freeNamesDeclExtras IfaceOtherDeclExtras
 757   = emptyNameSet
 758
 759 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
 760 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
 761
 762 instance Binary IfaceDeclExtras where
 763   get _bh = panic "no get for IfaceDeclExtras"
 764   put_ bh (IfaceIdExtras fix rules) = do
 765    putByte bh 1; put_ bh fix; put_ bh rules
 766   put_ bh (IfaceDataExtras fix insts cons) = do
 767    putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
 768   put_ bh (IfaceClassExtras insts methods) = do
 769    putByte bh 3; put_ bh insts; put_ bh methods
 770   put_ bh IfaceOtherDeclExtras = do
 771    putByte bh 4
 772
 773 declExtras :: (OccName -> Fixity)
 774            -> OccEnv [IfaceRule]
 775            -> OccEnv [IfaceInst]
 776            -> IfaceDecl
 777            -> IfaceDeclExtras
 778
 779 declExtras fix_fn rule_env inst_env decl
 780   = case decl of
 781       IfaceId{} -> IfaceIdExtras (fix_fn n)
 782                         (lookupOccEnvL rule_env n)
 783       IfaceData{ifCons=cons} ->
 784                      IfaceDataExtras (fix_fn n)
 785                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
 786                         (map (id_extras . ifConOcc) (visibleIfConDecls cons))
 787       IfaceClass{ifSigs=sigs} ->
 788                      IfaceClassExtras
 789                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
 790                         [id_extras op | IfaceClassOp op _ _ <- sigs]
 791       _other -> IfaceOtherDeclExtras
 792   where
 793         n = ifName decl
 794         id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
 795
 796 -- When hashing an instance, we omit the DFun.  This is because if a
 797 -- DFun is used it will already have a separate entry in the usages
 798 -- list, and we don't want changes to the DFun to cause the hash of
 799 -- the instnace to change - that would cause unnecessary changes to
 800 -- orphans, for example.
 801 newtype IfaceInstABI = IfaceInstABI IfaceInst
 802
 803 instance Binary IfaceInstABI where
 804   get = panic "no get for IfaceInstABI"
 805   put_ bh (IfaceInstABI inst) = do
 806     let ud  = getUserData bh
 807         bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
 808     put_ bh' inst
 809
 810 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
 811 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
 812
 813 -- used when we want to fingerprint a structure without depending on the
 814 -- fingerprints of external Names that it refers to.
 815 putNameLiterally :: BinHandle -> Name -> IO ()
 816 putNameLiterally bh name = do
 817   put_ bh $! nameModule name
 818   put_ bh $! nameOccName name
 819
 820 computeFingerprint :: Binary a
 821                    => DynFlags
 822                    -> (BinHandle -> Name -> IO ())
 823                    -> a
 824                    -> IO Fingerprint
 825
 826 computeFingerprint _dflags put_name a = do
 827   bh <- openBinMem (3*1024) -- just less than a block
 828   ud <- newWriteState put_name putFS
 829   bh <- return $ setUserData bh ud
 830   put_ bh a
 831   fingerprintBinMem bh
 832
 833 {-
 834 -- for testing: use the md5sum command to generate fingerprints and
 835 -- compare the results against our built-in version.
 836   fp' <- oldMD5 dflags bh
 837   if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
 838                else return fp
 839
 840 oldMD5 dflags bh = do
 841   tmp <- newTempName dflags "bin"
 842   writeBinMem bh tmp
 843   tmp2 <- newTempName dflags "md5"
 844   let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
 845   r <- system cmd
 846   case r of
 847     ExitFailure _ -> ghcError (PhaseFailed cmd r)
 848     ExitSuccess -> do
 849         hash_str <- readFile tmp2
 850         return $! readHexFingerprint hash_str
 851 -}
 852
 853 pprOrphans :: [IfaceInst] -> [IfaceRule] -> Maybe SDoc
 854 pprOrphans insts rules
 855   | null insts && null rules = Nothing
 856   | otherwise
 857   = Just $ vcat [
 858         if null insts then empty else
 859              hang (ptext (sLit "Warning: orphan instances:"))
 860                 2 (vcat (map ppr insts)),
 861         if null rules then empty else
 862              hang (ptext (sLit "Warning: orphan rules:"))
 863                 2 (vcat (map ppr rules))
 864     ]
 865
 866 ----------------------
 867 -- mkOrphMap partitions instance decls or rules into
 868 --      (a) an OccEnv for ones that are not orphans,
 869 --          mapping the local OccName to a list of its decls
 870 --      (b) a list of orphan decls
 871 mkOrphMap :: (decl -> Maybe OccName)    -- (Just occ) for a non-orphan decl, keyed by occ
 872                                         -- Nothing for an orphan decl
 873           -> [decl]                     -- Sorted into canonical order
 874           -> (OccEnv [decl],            -- Non-orphan decls associated with their key;
 875                                         --      each sublist in canonical order
 876               [decl])                   -- Orphan decls; in canonical order
 877 mkOrphMap get_key decls
 878   = foldl go (emptyOccEnv, []) decls
 879   where
 880     go (non_orphs, orphs) d
 881         | Just occ <- get_key d
 882         = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
 883         | otherwise = (non_orphs, d:orphs)
 884 \end{code}
 885
 886
 887 %*********************************************************
 888 %*                                                      *
 889 \subsection{Keeping track of what we've slurped, and fingerprints}
 890 %*                                                      *
 891 %*********************************************************
 892
 893
 894 \begin{code}
 895 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
 896 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
 897   = do  { eps <- hscEPS hsc_env
 898         ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
 899                                      dir_imp_mods used_names
 900         ; usages `seqList`  return usages }
 901          -- seq the list of Usages returned: occasionally these
 902          -- don't get evaluated for a while and we can end up hanging on to
 903          -- the entire collection of Ifaces.
 904
 905 mk_usage_info :: PackageIfaceTable
 906               -> HscEnv
 907               -> Module
 908               -> ImportedMods
 909               -> NameSet
 910               -> [Usage]
 911 mk_usage_info pit hsc_env this_mod direct_imports used_names
 912   = mapCatMaybes mkUsage usage_mods
 913   where
 914     hpt = hsc_HPT hsc_env
 915     dflags = hsc_dflags hsc_env
 916     this_pkg = thisPackage dflags
 917
 918     used_mods    = moduleEnvKeys ent_map
 919     dir_imp_mods = (moduleEnvKeys direct_imports)
 920     all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
 921     usage_mods   = sortBy stableModuleCmp all_mods
 922                         -- canonical order is imported, to avoid interface-file
 923                         -- wobblage.
 924
 925     -- ent_map groups together all the things imported and used
 926     -- from a particular module
 927     ent_map :: ModuleEnv [OccName]
 928     ent_map  = foldNameSet add_mv emptyModuleEnv used_names
 929      where
 930       add_mv name mv_map
 931         | isWiredInName name = mv_map  -- ignore wired-in names
 932         | otherwise
 933         = case nameModule_maybe name of
 934              Nothing  -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
 935              Just mod -> extendModuleEnv_C (++) mv_map mod [occ]
 936                    where occ = nameOccName name
 937
 938     -- We want to create a Usage for a home module if
 939     --  a) we used something from it; has something in used_names
 940     --  b) we imported it, even if we used nothing from it
 941     --     (need to recompile if its export list changes: export_fprint)
 942     mkUsage :: Module -> Maybe Usage
 943     mkUsage mod
 944       | isNothing maybe_iface           -- We can't depend on it if we didn't
 945                                         -- load its interface.
 946       || mod == this_mod                -- We don't care about usages of
 947                                         -- things in *this* module
 948       = Nothing
 949
 950       | modulePackageId mod /= this_pkg
 951       = Just UsagePackageModule{ usg_mod      = mod,
 952                                  usg_mod_hash = mod_hash }
 953         -- for package modules, we record the module hash only
 954
 955       | (null used_occs
 956           && isNothing export_hash
 957           && not is_direct_import
 958           && not finsts_mod)
 959       = Nothing                 -- Record no usage info
 960         -- for directly-imported modules, we always want to record a usage
 961         -- on the orphan hash.  This is what triggers a recompilation if
 962         -- an orphan is added or removed somewhere below us in the future.
 963
 964       | otherwise
 965       = Just UsageHomeModule {
 966                       usg_mod_name = moduleName mod,
 967                       usg_mod_hash = mod_hash,
 968                       usg_exports  = export_hash,
 969                       usg_entities = fmToList ent_hashs }
 970       where
 971         maybe_iface  = lookupIfaceByModule dflags hpt pit mod
 972                 -- In one-shot mode, the interfaces for home-package
 973                 -- modules accumulate in the PIT not HPT.  Sigh.
 974
 975         is_direct_import = mod `elemModuleEnv` direct_imports
 976
 977         Just iface   = maybe_iface
 978         finsts_mod   = mi_finsts    iface
 979         hash_env     = mi_hash_fn   iface
 980         mod_hash     = mi_mod_hash  iface
 981         export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
 982                     | otherwise             = Nothing
 983
 984         used_occs = lookupModuleEnv ent_map mod `orElse` []
 985
 986         -- Making a FiniteMap here ensures that (a) we remove duplicates
 987         -- when we have usages on several subordinates of a single parent,
 988         -- and (b) that the usages emerge in a canonical order, which
 989         -- is why we use FiniteMap rather than OccEnv: FiniteMap works
 990         -- using Ord on the OccNames, which is a lexicographic ordering.
 991         ent_hashs :: FiniteMap OccName Fingerprint
 992         ent_hashs = listToFM (map lookup_occ used_occs)
 993
 994         lookup_occ occ =
 995             case hash_env occ of
 996                 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
 997                 Just r  -> r
 998
 999         depend_on_exports mod =
1000            case lookupModuleEnv direct_imports mod of
1001                 Just _ -> True
1002                   -- Even if we used 'import M ()', we have to register a
1003                   -- usage on the export list because we are sensitive to
1004                   -- changes in orphan instances/rules.
1005                 Nothing -> False
1006                   -- In GHC 6.8.x the above line read "True", and in
1007                   -- fact it recorded a dependency on *all* the
1008                   -- modules underneath in the dependency tree.  This
1009                   -- happens to make orphans work right, but is too
1010                   -- expensive: it'll read too many interface files.
1011                   -- The 'isNothing maybe_iface' check above saved us
1012                   -- from generating many of these usages (at least in
1013                   -- one-shot mode), but that's even more bogus!
1014 \end{code}
1015
1016 \begin{code}
1017 mkIfaceExports :: [AvailInfo]
1018                -> [(Module, [GenAvailInfo OccName])]
1019   -- Group by module and sort by occurrence
1020   -- This keeps the list in canonical order
1021 mkIfaceExports exports
1022   = [ (mod, eltsFM avails)
1023     | (mod, avails) <- fmToList groupFM
1024     ]
1025   where
1026         -- Group by the module where the exported entities are defined
1027         -- (which may not be the same for all Names in an Avail)
1028         -- Deliberately use FiniteMap rather than UniqFM so we
1029         -- get a canonical ordering
1030     groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1031     groupFM = foldl add emptyModuleEnv exports
1032
1033     add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1034             -> Module -> GenAvailInfo OccName
1035             -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1036     add_one env mod avail
1037       =  extendModuleEnv_C plusFM env mod
1038                 (unitFM (occNameFS (availName avail)) avail)
1039
1040         -- NB: we should not get T(X) and T(Y) in the export list
1041         --     else the plusFM will simply discard one!  They
1042         --     should have been combined by now.
1043     add env (Avail n)
1044       = add_one env (nameModule n) (Avail (nameOccName n))
1045
1046     add env (AvailTC tc ns)
1047       = foldl add_for_mod env mods
1048       where
1049         tc_occ = nameOccName tc
1050         mods   = nub (map nameModule ns)
1051                 -- Usually just one, but see Note [Original module]
1052
1053         add_for_mod env mod
1054             = add_one env mod (AvailTC tc_occ (sort names_from_mod))
1055               -- NB. sort the children, we need a canonical order
1056             where
1057               names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
1058 \end{code}
1059
1060 Note [Orignal module]
1061 ~~~~~~~~~~~~~~~~~~~~~
1062 Consider this:
1063         module X where { data family T }
1064         module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1065 The exported Avail from Y will look like
1066         X.T{X.T, Y.MkT}
1067 That is, in Y,
1068   - only MkT is brought into scope by the data instance;
1069   - but the parent (used for grouping and naming in T(..) exports) is X.T
1070   - and in this case we export X.T too
1071
1072 In the result of MkIfaceExports, the names are grouped by defining module,
1073 so we may need to split up a single Avail into multiple ones.
1074
1075
1076 %************************************************************************
1077 %*                                                                      *
1078         Load the old interface file for this module (unless
1079         we have it aleady), and check whether it is up to date
1080
1081 %*                                                                      *
1082 %************************************************************************
1083
1084 \begin{code}
1085 checkOldIface :: HscEnv
1086               -> ModSummary
1087               -> Bool                   -- Source unchanged
1088               -> Maybe ModIface         -- Old interface from compilation manager, if any
1089               -> IO (RecompileRequired, Maybe ModIface)
1090
1091 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1092   = do  { showPass (hsc_dflags hsc_env)
1093                    ("Checking old interface for " ++
1094                         showSDoc (ppr (ms_mod mod_summary))) ;
1095
1096         ; initIfaceCheck hsc_env $
1097           check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1098      }
1099
1100 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1101                 -> IfG (Bool, Maybe ModIface)
1102 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1103  =  do  -- CHECK WHETHER THE SOURCE HAS CHANGED
1104     { when (not source_unchanged)
1105            (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1106
1107      -- If the source has changed and we're in interactive mode, avoid reading
1108      -- an interface; just return the one we might have been supplied with.
1109     ; let dflags = hsc_dflags hsc_env
1110     ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1111          return (outOfDate, maybe_iface)
1112       else
1113       case maybe_iface of {
1114         Just old_iface -> do -- Use the one we already have
1115           { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1116           ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1117           ; return (recomp, Just old_iface) }
1118
1119       ; Nothing -> do
1120
1121         -- Try and read the old interface for the current module
1122         -- from the .hi file left from the last time we compiled it
1123     { let iface_path = msHiFilePath mod_summary
1124     ; read_result <- readIface (ms_mod mod_summary) iface_path False
1125     ; case read_result of {
1126          Failed err -> do       -- Old interface file not found, or garbled; give up
1127                 { traceIf (text "FYI: cannot read old interface file:"
1128                                  $$ nest 4 err)
1129                 ; return (outOfDate, Nothing) }
1130
1131       ;  Succeeded iface -> do
1132
1133         -- We have got the old iface; check its versions
1134     { traceIf (text "Read the interface file" <+> text iface_path)
1135     ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1136     ; return (recomp, Just iface)
1137     }}}}}
1138
1139 \end{code}
1140
1141 @recompileRequired@ is called from the HscMain.   It checks whether
1142 a recompilation is required.  It needs access to the persistent state,
1143 finder, etc, because it may have to load lots of interface files to
1144 check their versions.
1145
1146 \begin{code}
1147 type RecompileRequired = Bool
1148 upToDate, outOfDate :: Bool
1149 upToDate  = False       -- Recompile not required
1150 outOfDate = True        -- Recompile required
1151
1152 checkVersions :: HscEnv
1153               -> Bool           -- True <=> source unchanged
1154               -> ModSummary
1155               -> ModIface       -- Old interface
1156               -> IfG RecompileRequired
1157 checkVersions hsc_env source_unchanged mod_summary iface
1158   | not source_unchanged
1159   = return outOfDate
1160   | otherwise
1161   = do  { traceHiDiffs (text "Considering whether compilation is required for" <+>
1162                         ppr (mi_module iface) <> colon)
1163
1164         ; recomp <- checkDependencies hsc_env mod_summary iface
1165         ; if recomp then return outOfDate else do {
1166
1167         -- Source code unchanged and no errors yet... carry on
1168         --
1169         -- First put the dependent-module info, read from the old
1170         -- interface, into the envt, so that when we look for
1171         -- interfaces we look for the right one (.hi or .hi-boot)
1172         --
1173         -- It's just temporary because either the usage check will succeed
1174         -- (in which case we are done with this module) or it'll fail (in which
1175         -- case we'll compile the module from scratch anyhow).
1176         --
1177         -- We do this regardless of compilation mode, although in --make mode
1178         -- all the dependent modules should be in the HPT already, so it's
1179         -- quite redundant
1180           updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
1181
1182         ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1183         ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1184     }}
1185   where
1186         -- This is a bit of a hack really
1187     mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1188     mod_deps = mkModDeps (dep_mods (mi_deps iface))
1189
1190
1191 -- If the direct imports of this module are resolved to targets that
1192 -- are not among the dependencies of the previous interface file,
1193 -- then we definitely need to recompile.  This catches cases like
1194 --   - an exposed package has been upgraded
1195 --   - we are compiling with different package flags
1196 --   - a home module that was shadowing a package module has been removed
1197 --   - a new home module has been added that shadows a package module
1198 -- See bug #1372.
1199 --
1200 -- Returns True if recompilation is required.
1201 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1202 checkDependencies hsc_env summary iface
1203  = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1204   where
1205    prev_dep_mods = dep_mods (mi_deps iface)
1206    prev_dep_pkgs = dep_pkgs (mi_deps iface)
1207
1208    this_pkg = thisPackage (hsc_dflags hsc_env)
1209
1210    orM = foldr f (return False)
1211     where f m rest = do b <- m; if b then return True else rest
1212
1213    dep_missing (L _ mod) = do
1214      find_res <- liftIO $ findImportedModule hsc_env mod Nothing
1215      case find_res of
1216         Found _ mod
1217           | pkg == this_pkg
1218            -> if moduleName mod `notElem` map fst prev_dep_mods
1219                  then do traceHiDiffs $
1220                            text "imported module " <> quotes (ppr mod) <>
1221                            text " not among previous dependencies"
1222                          return outOfDate
1223                  else
1224                          return upToDate
1225           | otherwise
1226            -> if pkg `notElem` prev_dep_pkgs
1227                  then do traceHiDiffs $
1228                            text "imported module " <> quotes (ppr mod) <>
1229                            text " is from package " <> quotes (ppr pkg) <>
1230                            text ", which is not among previous dependencies"
1231                          return outOfDate
1232                  else
1233                          return upToDate
1234            where pkg = modulePackageId mod
1235         _otherwise  -> return outOfDate
1236
1237 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1238               -> IfG RecompileRequired
1239 needInterface mod continue
1240   = do  -- Load the imported interface if possible
1241     let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1242     traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1243
1244     mb_iface <- loadInterface doc_str mod ImportBySystem
1245         -- Load the interface, but don't complain on failure;
1246         -- Instead, get an Either back which we can test
1247
1248     case mb_iface of
1249         Failed _ ->  (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1250                                        ppr mod]));
1251                 -- Couldn't find or parse a module mentioned in the
1252                 -- old interface file.  Don't complain: it might
1253                 -- just be that the current module doesn't need that
1254                 -- import and it's been deleted
1255         Succeeded iface -> continue iface
1256
1257
1258 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1259 -- Given the usage information extracted from the old
1260 -- M.hi file for the module being compiled, figure out
1261 -- whether M needs to be recompiled.
1262
1263 checkModUsage _this_pkg UsagePackageModule{
1264                                 usg_mod = mod,
1265                                 usg_mod_hash = old_mod_hash }
1266   = needInterface mod $ \iface -> do
1267     checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1268         -- We only track the ABI hash of package modules, rather than
1269         -- individual entity usages, so if the ABI hash changes we must
1270         -- recompile.  This is safe but may entail more recompilation when
1271         -- a dependent package has changed.
1272
1273 checkModUsage this_pkg UsageHomeModule{
1274                                 usg_mod_name = mod_name,
1275                                 usg_mod_hash = old_mod_hash,
1276                                 usg_exports = maybe_old_export_hash,
1277                                 usg_entities = old_decl_hash }
1278   = do
1279     let mod = mkModule this_pkg mod_name
1280     needInterface mod $ \iface -> do
1281
1282     let
1283         new_mod_hash    = mi_mod_hash    iface
1284         new_decl_hash   = mi_hash_fn     iface
1285         new_export_hash = mi_exp_hash    iface
1286
1287         -- CHECK MODULE
1288     recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1289     if not recompile then return upToDate else do
1290
1291         -- CHECK EXPORT LIST
1292     checkMaybeHash maybe_old_export_hash new_export_hash
1293         (ptext (sLit "  Export list changed")) $ do
1294
1295         -- CHECK ITEMS ONE BY ONE
1296     recompile <- checkList [ checkEntityUsage new_decl_hash u
1297                            | u <- old_decl_hash]
1298     if recompile
1299       then return outOfDate     -- This one failed, so just bail out now
1300       else up_to_date (ptext (sLit "  Great!  The bits I use are up to date"))
1301
1302 ------------------------
1303 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1304 checkModuleFingerprint old_mod_hash new_mod_hash
1305   | new_mod_hash == old_mod_hash
1306   = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1307
1308   | otherwise
1309   = out_of_date_hash (ptext (sLit "  Module fingerprint has changed"))
1310                      old_mod_hash new_mod_hash
1311
1312 ------------------------
1313 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1314                -> IfG RecompileRequired -> IfG RecompileRequired
1315 checkMaybeHash maybe_old_hash new_hash doc continue
1316   | Just hash <- maybe_old_hash, hash /= new_hash
1317   = out_of_date_hash doc hash new_hash
1318   | otherwise
1319   = continue
1320
1321 ------------------------
1322 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1323                  -> (OccName, Fingerprint)
1324                  -> IfG Bool
1325 checkEntityUsage new_hash (name,old_hash)
1326   = case new_hash name of
1327
1328         Nothing       ->        -- We used it before, but it ain't there now
1329                           out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1330
1331         Just (_, new_hash)      -- It's there, but is it up to date?
1332           | new_hash == old_hash -> do traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
1333                                        return upToDate
1334           | otherwise            -> out_of_date_hash (ptext (sLit "  Out of date:") <+> ppr name)
1335                                                      old_hash new_hash
1336
1337 up_to_date, out_of_date :: SDoc -> IfG Bool
1338 up_to_date  msg = traceHiDiffs msg >> return upToDate
1339 out_of_date msg = traceHiDiffs msg >> return outOfDate
1340
1341 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1342 out_of_date_hash msg old_hash new_hash
1343   = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1344
1345 ----------------------
1346 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1347 -- This helper is used in two places
1348 checkList []             = return upToDate
1349 checkList (check:checks) = do recompile <- check
1350                               if recompile
1351                                 then return outOfDate
1352                                 else checkList checks
1353 \end{code}
1354
1355 %************************************************************************
1356 %*                                                                      *
1357                 Converting things to their Iface equivalents
1358 %*                                                                      *
1359 %************************************************************************
1360
1361 \begin{code}
1362 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1363 -- Assumption: the thing is already tidied, so that locally-bound names
1364 --             (lambdas, for-alls) already have non-clashing OccNames
1365 -- Reason: Iface stuff uses OccNames, and the conversion here does
1366 --         not do tidying on the way
1367 tyThingToIfaceDecl (AnId id)
1368   = IfaceId { ifName   = getOccName id,
1369               ifType   = toIfaceType (idType id),
1370               ifIdInfo = info }
1371   where
1372     info = case toIfaceIdInfo (idInfo id) of
1373                 []    -> NoInfo
1374                 items -> HasInfo items
1375
1376 tyThingToIfaceDecl (AClass clas)
1377   = IfaceClass { ifCtxt   = toIfaceContext sc_theta,
1378                  ifName   = getOccName clas,
1379                  ifTyVars = toIfaceTvBndrs clas_tyvars,
1380                  ifFDs    = map toIfaceFD clas_fds,
1381                  ifATs    = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1382                  ifSigs   = map toIfaceClassOp op_stuff,
1383                  ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
1384   where
1385     (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1386       = classExtraBigSig clas
1387     tycon = classTyCon clas
1388
1389     toIfaceClassOp (sel_id, def_meth)
1390         = ASSERT(sel_tyvars == clas_tyvars)
1391           IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1392         where
1393                 -- Be careful when splitting the type, because of things
1394                 -- like         class Foo a where
1395                 --                op :: (?x :: String) => a -> a
1396                 -- and          class Baz a where
1397                 --                op :: (Ord a) => a -> a
1398           (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1399           op_ty                = funResultTy rho_ty
1400
1401     toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1402
1403 tyThingToIfaceDecl (ATyCon tycon)
1404   | isSynTyCon tycon
1405   = IfaceSyn {  ifName    = getOccName tycon,
1406                 ifTyVars  = toIfaceTvBndrs tyvars,
1407                 ifOpenSyn = syn_isOpen,
1408                 ifSynRhs  = toIfaceType syn_tyki,
1409                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1410              }
1411
1412   | isAlgTyCon tycon
1413   = IfaceData { ifName    = getOccName tycon,
1414                 ifTyVars  = toIfaceTvBndrs tyvars,
1415                 ifCtxt    = toIfaceContext (tyConStupidTheta tycon),
1416                 ifCons    = ifaceConDecls (algTyConRhs tycon),
1417                 ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
1418                 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1419                 ifGeneric = tyConHasGenerics tycon,
1420                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1421
1422   | isForeignTyCon tycon
1423   = IfaceForeign { ifName    = getOccName tycon,
1424                    ifExtName = tyConExtName tycon }
1425
1426   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1427   where
1428     tyvars = tyConTyVars tycon
1429     (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
1430                                OpenSynTyCon ki _ -> (True , ki)
1431                                SynonymTyCon ty   -> (False, ty)
1432
1433     ifaceConDecls (NewTyCon { data_con = con })     =
1434       IfNewTyCon  (ifaceConDecl con)
1435     ifaceConDecls (DataTyCon { data_cons = cons })  =
1436       IfDataTyCon (map ifaceConDecl cons)
1437     ifaceConDecls OpenTyCon {}                      = IfOpenDataTyCon
1438     ifaceConDecls AbstractTyCon                     = IfAbstractTyCon
1439         -- The last case happens when a TyCon has been trimmed during tidying
1440         -- Furthermore, tyThingToIfaceDecl is also used
1441         -- in TcRnDriver for GHCi, when browsing a module, in which case the
1442         -- AbstractTyCon case is perfectly sensible.
1443
1444     ifaceConDecl data_con
1445         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
1446                     ifConInfix   = dataConIsInfix data_con,
1447                     ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1448                     ifConExTvs   = toIfaceTvBndrs (dataConExTyVars data_con),
1449                     ifConEqSpec  = to_eq_spec (dataConEqSpec data_con),
1450                     ifConCtxt    = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1451                     ifConArgTys  = map toIfaceType (dataConOrigArgTys data_con),
1452                     ifConFields  = map getOccName
1453                                        (dataConFieldLabels data_con),
1454                     ifConStricts = dataConStrictMarks data_con }
1455
1456     to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1457
1458     famInstToIface Nothing                    = Nothing
1459     famInstToIface (Just (famTyCon, instTys)) =
1460       Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1461
1462 tyThingToIfaceDecl (ADataCon dc)
1463  = pprPanic "toIfaceDecl" (ppr dc)      -- Should be trimmed out earlier
1464
1465
1466 getFS :: NamedThing a => a -> FastString
1467 getFS x = occNameFS (getOccName x)
1468
1469 --------------------------
1470 instanceToIfaceInst :: Instance -> IfaceInst
1471 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1472                                 is_cls = cls_name, is_tcs = mb_tcs })
1473   = ASSERT( cls_name == className cls )
1474     IfaceInst { ifDFun    = dfun_name,
1475                 ifOFlag   = oflag,
1476                 ifInstCls = cls_name,
1477                 ifInstTys = map do_rough mb_tcs,
1478                 ifInstOrph = orph }
1479   where
1480     do_rough Nothing  = Nothing
1481     do_rough (Just n) = Just (toIfaceTyCon_name n)
1482
1483     dfun_name = idName dfun_id
1484     mod       = nameModule dfun_name
1485     is_local name = nameIsLocalOrFrom mod name
1486
1487         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1488     (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1489                 -- Slightly awkward: we need the Class to get the fundeps
1490     (tvs, fds) = classTvsFds cls
1491     arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1492     orph | is_local cls_name = Just (nameOccName cls_name)
1493          | all isJust mb_ns  = head mb_ns
1494          | otherwise         = Nothing
1495
1496     mb_ns :: [Maybe OccName]    -- One for each fundep; a locally-defined name
1497                                 -- that is not in the "determined" arguments
1498     mb_ns | null fds   = [choose_one arg_names]
1499           | otherwise  = map do_one fds
1500     do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1501                                           , not (tv `elem` rtvs)]
1502
1503     choose_one :: [NameSet] -> Maybe OccName
1504     choose_one nss = case nameSetToList (unionManyNameSets nss) of
1505                         []      -> Nothing
1506                         (n : _) -> Just (nameOccName n)
1507
1508 --------------------------
1509 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1510 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1511                                  fi_fam = fam,
1512                                  fi_tcs = mb_tcs })
1513   = IfaceFamInst { ifFamInstTyCon  = toIfaceTyCon tycon
1514                  , ifFamInstFam    = fam
1515                  , ifFamInstTys    = map do_rough mb_tcs }
1516   where
1517     do_rough Nothing  = Nothing
1518     do_rough (Just n) = Just (toIfaceTyCon_name n)
1519
1520 --------------------------
1521 toIfaceLetBndr :: Id -> IfaceLetBndr
1522 toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
1523                                (toIfaceType (idType id))
1524                                prag_info
1525   where
1526         -- Stripped-down version of tcIfaceIdInfo
1527         -- Change this if you want to export more IdInfo for
1528         -- non-top-level Ids.  Don't forget to change
1529         -- CoreTidy.tidyLetBndr too!
1530         --
1531         -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1532     id_info = idInfo id
1533     inline_prag = inlinePragInfo id_info
1534     prag_info | isAlwaysActive inline_prag = NoInfo
1535               | otherwise                  = HasInfo [HsInline inline_prag]
1536
1537 --------------------------
1538 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1539 toIfaceIdInfo id_info
1540   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1541                inline_hsinfo, wrkr_hsinfo,  unfold_hsinfo]
1542   where
1543     ------------  Arity  --------------
1544     arity_info = arityInfo id_info
1545     arity_hsinfo | arity_info == 0 = Nothing
1546                  | otherwise       = Just (HsArity arity_info)
1547
1548     ------------ Caf Info --------------
1549     caf_info   = cafInfo id_info
1550     caf_hsinfo = case caf_info of
1551                    NoCafRefs -> Just HsNoCafRefs
1552                    _other    -> Nothing
1553
1554     ------------  Strictness  --------------
1555         -- No point in explicitly exporting TopSig
1556     strict_hsinfo = case newStrictnessInfo id_info of
1557                         Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1558                         _other                        -> Nothing
1559
1560     ------------  Worker  --------------
1561     work_info   = workerInfo id_info
1562     has_worker  = workerExists work_info
1563     wrkr_hsinfo = case work_info of
1564                     HasWorker work_id wrap_arity ->
1565                         Just (HsWorker ((idName work_id)) wrap_arity)
1566                     NoWorker -> Nothing
1567
1568     ------------  Unfolding  --------------
1569     -- The unfolding is redundant if there is a worker
1570     unfold_info  = unfoldingInfo id_info
1571     rhs          = unfoldingTemplate unfold_info
1572     no_unfolding = neverUnfold unfold_info
1573                         -- The CoreTidy phase retains unfolding info iff
1574                         -- we want to expose the unfolding, taking into account
1575                         -- unconditional NOINLINE, etc.  See TidyPgm.addExternal
1576     unfold_hsinfo | no_unfolding = Nothing
1577                   | has_worker   = Nothing      -- Unfolding is implicit
1578                   | otherwise    = Just (HsUnfold (toIfaceExpr rhs))
1579
1580     ------------  Inline prag  --------------
1581     inline_prag = inlinePragInfo id_info
1582     inline_hsinfo | isAlwaysActive inline_prag     = Nothing
1583                   | no_unfolding && not has_worker = Nothing
1584                         -- If the iface file give no unfolding info, we
1585                         -- don't need to say when inlining is OK!
1586                   | otherwise                      = Just (HsInline inline_prag)
1587
1588 --------------------------
1589 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1590 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1591   = pprTrace "toHsRule: builtin" (ppr fn) $
1592     bogusIfaceRule fn
1593
1594 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1595                                 ru_act = act, ru_bndrs = bndrs,
1596                                 ru_args = args, ru_rhs = rhs })
1597   = IfaceRule { ifRuleName  = name, ifActivation = act,
1598                 ifRuleBndrs = map toIfaceBndr bndrs,
1599                 ifRuleHead  = fn,
1600                 ifRuleArgs  = map do_arg args,
1601                 ifRuleRhs   = toIfaceExpr rhs,
1602                 ifRuleOrph  = orph }
1603   where
1604         -- For type args we must remove synonyms from the outermost
1605         -- level.  Reason: so that when we read it back in we'll
1606         -- construct the same ru_rough field as we have right now;
1607         -- see tcIfaceRule
1608     do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1609     do_arg arg       = toIfaceExpr arg
1610
1611         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1612         -- A rule is an orphan only if none of the variables
1613         -- mentioned on its left-hand side are locally defined
1614     lhs_names = fn : nameSetToList (exprsFreeNames args)
1615                 -- No need to delete bndrs, because
1616                 -- exprsFreeNames finds only External names
1617
1618     orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1619                         (n : _) -> Just (nameOccName n)
1620                         []      -> Nothing
1621
1622 bogusIfaceRule :: Name -> IfaceRule
1623 bogusIfaceRule id_name
1624   = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1625         ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1626         ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1627
1628 ---------------------
1629 toIfaceExpr :: CoreExpr -> IfaceExpr
1630 toIfaceExpr (Var v)       = toIfaceVar v
1631 toIfaceExpr (Lit l)       = IfaceLit l
1632 toIfaceExpr (Type ty)     = IfaceType (toIfaceType ty)
1633 toIfaceExpr (Lam x b)     = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1634 toIfaceExpr (App f a)     = toIfaceApp f [a]
1635 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1636 toIfaceExpr (Let b e)     = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1637 toIfaceExpr (Cast e co)   = IfaceCast (toIfaceExpr e) (toIfaceType co)
1638 toIfaceExpr (Note n e)    = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1639
1640 ---------------------
1641 toIfaceNote :: Note -> IfaceNote
1642 toIfaceNote (SCC cc)      = IfaceSCC cc
1643 toIfaceNote InlineMe      = IfaceInlineMe
1644 toIfaceNote (CoreNote s)  = IfaceCoreNote s
1645
1646 ---------------------
1647 toIfaceBind :: Bind Id -> IfaceBinding
1648 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1649 toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1650
1651 ---------------------
1652 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1653            -> (IfaceConAlt, [FastString], IfaceExpr)
1654 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1655
1656 ---------------------
1657 toIfaceCon :: AltCon -> IfaceConAlt
1658 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1659                         | otherwise       = IfaceDataAlt (getName dc)
1660                         where
1661                           tc = dataConTyCon dc
1662
1663 toIfaceCon (LitAlt l) = IfaceLitAlt l
1664 toIfaceCon DEFAULT    = IfaceDefault
1665
1666 ---------------------
1667 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1668 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1669 toIfaceApp (Var v) as
1670   = case isDataConWorkId_maybe v of
1671         -- We convert the *worker* for tuples into IfaceTuples
1672         Just dc |  isTupleTyCon tc && saturated
1673                 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1674           where
1675             val_args  = dropWhile isTypeArg as
1676             saturated = val_args `lengthIs` idArity v
1677             tup_args  = map toIfaceExpr val_args
1678             tc        = dataConTyCon dc
1679
1680         _ -> mkIfaceApps (toIfaceVar v) as
1681
1682 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1683
1684 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1685 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1686
1687 ---------------------
1688 toIfaceVar :: Id -> IfaceExpr
1689 toIfaceVar v
1690   | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1691           -- Foreign calls have special syntax
1692   | isExternalName name             = IfaceExt name
1693   | Just (TickBox m ix) <- isTickBoxOp_maybe v
1694                                     = IfaceTick m ix
1695   | otherwise                       = IfaceLcl (getFS name)
1696   where
1697     name = idName v
1698 \end{code}