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             in
 566             put_ bh hash
 567
 568         -- take a strongly-connected group of declarations and compute
 569         -- its fingerprint.
 570
 571        fingerprint_group :: (OccEnv (OccName,Fingerprint),
 572                              [(Fingerprint,IfaceDecl)])
 573                          -> SCC IfaceDeclABI
 574                          -> IO (OccEnv (OccName,Fingerprint),
 575                                 [(Fingerprint,IfaceDecl)])
 576
 577        fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
 578           = do let hash_fn = mk_put_name local_env
 579                    decl = abiDecl abi
 580                -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
 581                hash <- computeFingerprint dflags hash_fn abi
 582                return (extend_hash_env (hash,decl) local_env,
 583                        (hash,decl) : decls_w_hashes)
 584
 585        fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
 586           = do let decls = map abiDecl abis
 587                    local_env' = foldr extend_hash_env local_env
 588                                    (zip (repeat fingerprint0) decls)
 589                    hash_fn = mk_put_name local_env'
 590                -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
 591                let stable_abis = sortBy cmp_abiNames abis
 592                 -- put the cycle in a canonical order
 593                hash <- computeFingerprint dflags hash_fn stable_abis
 594                let pairs = zip (repeat hash) decls
 595                return (foldr extend_hash_env local_env pairs,
 596                        pairs ++ decls_w_hashes)
 597
 598        extend_hash_env :: (Fingerprint,IfaceDecl)
 599                        -> OccEnv (OccName,Fingerprint)
 600                        -> OccEnv (OccName,Fingerprint)
 601        extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
 602         where
 603           decl_name = ifName d
 604           item = (decl_name, hash)
 605           env1 = extendOccEnv env0 decl_name item
 606           add_imp bndr env = extendOccEnv env bndr item
 607
 608    --
 609    (local_env, decls_w_hashes) <-
 610        foldM fingerprint_group (emptyOccEnv, []) groups
 611
 612    -- the export hash of a module depends on the orphan hashes of the
 613    -- orphan modules below us in the dependeny tree.  This is the way
 614    -- that changes in orphans get propagated all the way up the
 615    -- dependency tree.  We only care about orphan modules in the current
 616    -- package, because changes to orphans outside this package will be
 617    -- tracked by the usage on the ABI hash of package modules that we import.
 618    let orph_mods = sortBy (compare `on` (moduleNameFS.moduleName))
 619                         . filter ((== this_pkg) . modulePackageId)
 620                         $ dep_orphs (mi_deps iface0)
 621    dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
 622
 623    orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
 624                       (map IfaceInstABI orph_insts, orph_rules, fam_insts)
 625
 626    -- the export list hash doesn't depend on the fingerprints of
 627    -- the Names it mentions, only the Names themselves, hence putNameLiterally.
 628    export_hash <- computeFingerprint dflags putNameLiterally
 629                       (mi_exports iface0, orphan_hash, dep_orphan_hashes)
 630
 631    -- put the declarations in a canonical order, sorted by OccName
 632    let sorted_decls = eltsFM $ listToFM $
 633                           [(ifName d, e) | e@(_, d) <- decls_w_hashes]
 634
 635    -- the ABI hash depends on:
 636    --   - decls
 637    --   - export list
 638    --   - orphans
 639    --   - deprecations
 640    --   - XXX vect info?
 641    mod_hash <- computeFingerprint dflags putNameLiterally
 642                       (map fst sorted_decls,
 643                        export_hash,
 644                        orphan_hash,
 645                        mi_deprecs iface0)
 646
 647    -- The interface hash depends on:
 648    --    - the ABI hash, plus
 649    --    - usages
 650    --    - deps
 651    --    - hpc
 652    iface_hash <- computeFingerprint dflags putNameLiterally
 653                       (mod_hash,
 654                        mi_usages iface0,
 655                        mi_deps iface0,
 656                        mi_hpc iface0)
 657
 658    let
 659     no_change_at_all = Just iface_hash == mb_old_fingerprint
 660
 661     final_iface = iface0 {
 662                 mi_mod_hash    = mod_hash,
 663                 mi_iface_hash  = iface_hash,
 664                 mi_exp_hash    = export_hash,
 665                 mi_orphan_hash = orphan_hash,
 666                 mi_orphan      = not (null orph_rules && null orph_insts),
 667                 mi_finsts      = not . null $ mi_fam_insts iface0,
 668                 mi_decls       = sorted_decls,
 669                 mi_hash_fn     = lookupOccEnv local_env }
 670    --
 671    return (final_iface, no_change_at_all, pp_orphs)
 672
 673   where
 674     this_mod = mi_module iface0
 675     dflags = hsc_dflags hsc_env
 676     this_pkg = thisPackage dflags
 677     (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
 678     (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
 679         -- ToDo: shouldn't we be splitting fam_insts into orphans and
 680         -- non-orphans?
 681     fam_insts = mi_fam_insts iface0
 682     fix_fn = mi_fix_fn iface0
 683     pp_orphs = pprOrphans orph_insts orph_rules
 684
 685
 686 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
 687 getOrphanHashes hsc_env mods = do
 688   eps <- hscEPS hsc_env
 689   let
 690     hpt        = hsc_HPT hsc_env
 691     pit        = eps_PIT eps
 692     dflags     = hsc_dflags hsc_env
 693     get_orph_hash mod =
 694           case lookupIfaceByModule dflags hpt pit mod of
 695             Nothing    -> pprPanic "moduleOrphanHash" (ppr mod)
 696             Just iface -> mi_orphan_hash iface
 697   --
 698   return (map get_orph_hash mods)
 699
 700
 701 -- The ABI of a declaration consists of:
 702      -- the full name of the identifier (inc. module and package, because
 703      --   these are used to construct the symbol name by which the
 704      --   identifier is known externally).
 705      -- the fixity of the identifier
 706      -- the declaration itself, as exposed to clients.  That is, the
 707      --   definition of an Id is included in the fingerprint only if
 708      --   it is made available as as unfolding in the interface.
 709      -- for Ids: rules
 710      -- for classes: instances, fixity & rules for methods
 711      -- for datatypes: instances, fixity & rules for constrs
 712 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
 713
 714 abiDecl :: IfaceDeclABI -> IfaceDecl
 715 abiDecl (_, decl, _) = decl
 716
 717 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
 718 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
 719                          ifName (abiDecl abi2)
 720
 721 freeNamesDeclABI :: IfaceDeclABI -> NameSet
 722 freeNamesDeclABI (_mod, decl, extras) =
 723   freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
 724
 725 data IfaceDeclExtras
 726   = IfaceIdExtras    Fixity [IfaceRule]
 727   | IfaceDataExtras  Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
 728   | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
 729   | IfaceOtherDeclExtras
 730
 731 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
 732 freeNamesDeclExtras (IfaceIdExtras    _ rules)
 733   = unionManyNameSets (map freeNamesIfRule rules)
 734 freeNamesDeclExtras (IfaceDataExtras  _ _insts subs)
 735   = unionManyNameSets (map freeNamesSub subs)
 736 freeNamesDeclExtras (IfaceClassExtras _insts subs)
 737   = unionManyNameSets (map freeNamesSub subs)
 738 freeNamesDeclExtras IfaceOtherDeclExtras
 739   = emptyNameSet
 740
 741 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
 742 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
 743
 744 instance Binary IfaceDeclExtras where
 745   get _bh = panic "no get for IfaceDeclExtras"
 746   put_ bh (IfaceIdExtras fix rules) = do
 747    putByte bh 1; put_ bh fix; put_ bh rules
 748   put_ bh (IfaceDataExtras fix insts cons) = do
 749    putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
 750   put_ bh (IfaceClassExtras insts methods) = do
 751    putByte bh 3; put_ bh insts; put_ bh methods
 752   put_ bh IfaceOtherDeclExtras = do
 753    putByte bh 4
 754
 755 declExtras :: (OccName -> Fixity)
 756            -> OccEnv [IfaceRule]
 757            -> OccEnv [IfaceInst]
 758            -> IfaceDecl
 759            -> IfaceDeclExtras
 760
 761 declExtras fix_fn rule_env inst_env decl
 762   = case decl of
 763       IfaceId{} -> IfaceIdExtras (fix_fn n)
 764                         (lookupOccEnvL rule_env n)
 765       IfaceData{ifCons=cons} ->
 766                      IfaceDataExtras (fix_fn n)
 767                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
 768                         (map (id_extras . ifConOcc) (visibleIfConDecls cons))
 769       IfaceClass{ifSigs=sigs} ->
 770                      IfaceClassExtras
 771                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
 772                         [id_extras op | IfaceClassOp op _ _ <- sigs]
 773       _other -> IfaceOtherDeclExtras
 774   where
 775         n = ifName decl
 776         id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
 777
 778 -- When hashing an instance, we omit the DFun.  This is because if a
 779 -- DFun is used it will already have a separate entry in the usages
 780 -- list, and we don't want changes to the DFun to cause the hash of
 781 -- the instnace to change - that would cause unnecessary changes to
 782 -- orphans, for example.
 783 newtype IfaceInstABI = IfaceInstABI IfaceInst
 784
 785 instance Binary IfaceInstABI where
 786   get = panic "no get for IfaceInstABI"
 787   put_ bh (IfaceInstABI inst) = do
 788     let ud  = getUserData bh
 789         bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
 790     put_ bh' inst
 791
 792 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
 793 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
 794
 795 -- used when we want to fingerprint a structure without depending on the
 796 -- fingerprints of external Names that it refers to.
 797 putNameLiterally :: BinHandle -> Name -> IO ()
 798 putNameLiterally bh name = do
 799   put_ bh $! nameModule name
 800   put_ bh $! nameOccName name
 801
 802 computeFingerprint :: Binary a
 803                    => DynFlags
 804                    -> (BinHandle -> Name -> IO ())
 805                    -> a
 806                    -> IO Fingerprint
 807
 808 computeFingerprint _dflags put_name a = do
 809   bh <- openBinMem (3*1024) -- just less than a block
 810   ud <- newWriteState put_name putFS
 811   bh <- return $ setUserData bh ud
 812   put_ bh a
 813   fingerprintBinMem bh
 814
 815 {-
 816 -- for testing: use the md5sum command to generate fingerprints and
 817 -- compare the results against our built-in version.
 818   fp' <- oldMD5 dflags bh
 819   if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
 820                else return fp
 821
 822 oldMD5 dflags bh = do
 823   tmp <- newTempName dflags "bin"
 824   writeBinMem bh tmp
 825   tmp2 <- newTempName dflags "md5"
 826   let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
 827   r <- system cmd
 828   case r of
 829     ExitFailure _ -> ghcError (PhaseFailed cmd r)
 830     ExitSuccess -> do
 831         hash_str <- readFile tmp2
 832         return $! readHexFingerprint hash_str
 833 -}
 834
 835 pprOrphans :: [IfaceInst] -> [IfaceRule] -> Maybe SDoc
 836 pprOrphans insts rules
 837   | null insts && null rules = Nothing
 838   | otherwise
 839   = Just $ vcat [
 840         if null insts then empty else
 841              hang (ptext (sLit "Warning: orphan instances:"))
 842                 2 (vcat (map ppr insts)),
 843         if null rules then empty else
 844              hang (ptext (sLit "Warning: orphan rules:"))
 845                 2 (vcat (map ppr rules))
 846     ]
 847
 848 ----------------------
 849 -- mkOrphMap partitions instance decls or rules into
 850 --      (a) an OccEnv for ones that are not orphans,
 851 --          mapping the local OccName to a list of its decls
 852 --      (b) a list of orphan decls
 853 mkOrphMap :: (decl -> Maybe OccName)    -- (Just occ) for a non-orphan decl, keyed by occ
 854                                         -- Nothing for an orphan decl
 855           -> [decl]                     -- Sorted into canonical order
 856           -> (OccEnv [decl],            -- Non-orphan decls associated with their key;
 857                                         --      each sublist in canonical order
 858               [decl])                   -- Orphan decls; in canonical order
 859 mkOrphMap get_key decls
 860   = foldl go (emptyOccEnv, []) decls
 861   where
 862     go (non_orphs, orphs) d
 863         | Just occ <- get_key d
 864         = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
 865         | otherwise = (non_orphs, d:orphs)
 866 \end{code}
 867
 868
 869 %*********************************************************
 870 %*                                                      *
 871 \subsection{Keeping track of what we've slurped, and fingerprints}
 872 %*                                                      *
 873 %*********************************************************
 874
 875
 876 \begin{code}
 877 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
 878 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
 879   = do  { eps <- hscEPS hsc_env
 880         ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
 881                                      dir_imp_mods used_names
 882         ; usages `seqList`  return usages }
 883          -- seq the list of Usages returned: occasionally these
 884          -- don't get evaluated for a while and we can end up hanging on to
 885          -- the entire collection of Ifaces.
 886
 887 mk_usage_info :: PackageIfaceTable
 888               -> HscEnv
 889               -> Module
 890               -> ImportedMods
 891               -> NameSet
 892               -> [Usage]
 893 mk_usage_info pit hsc_env this_mod direct_imports used_names
 894   = mapCatMaybes mkUsage usage_mods
 895   where
 896     hpt = hsc_HPT hsc_env
 897     dflags = hsc_dflags hsc_env
 898     this_pkg = thisPackage dflags
 899
 900     used_mods    = moduleEnvKeys ent_map
 901     dir_imp_mods = (moduleEnvKeys direct_imports)
 902     all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
 903     usage_mods   = sortBy stableModuleCmp all_mods
 904                         -- canonical order is imported, to avoid interface-file
 905                         -- wobblage.
 906
 907     -- ent_map groups together all the things imported and used
 908     -- from a particular module
 909     ent_map :: ModuleEnv [OccName]
 910     ent_map  = foldNameSet add_mv emptyModuleEnv used_names
 911      where
 912       add_mv name mv_map
 913         | isWiredInName name = mv_map  -- ignore wired-in names
 914         | otherwise
 915         = case nameModule_maybe name of
 916              Nothing  -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
 917              Just mod -> extendModuleEnv_C (++) mv_map mod [occ]
 918                    where occ = nameOccName name
 919
 920     -- We want to create a Usage for a home module if
 921     --  a) we used something from it; has something in used_names
 922     --  b) we imported it, even if we used nothing from it
 923     --     (need to recompile if its export list changes: export_fprint)
 924     mkUsage :: Module -> Maybe Usage
 925     mkUsage mod
 926       | isNothing maybe_iface           -- We can't depend on it if we didn't
 927                                         -- load its interface.
 928       || mod == this_mod                -- We don't care about usages of
 929                                         -- things in *this* module
 930       = Nothing
 931
 932       | modulePackageId mod /= this_pkg
 933       = Just UsagePackageModule{ usg_mod      = mod,
 934                                  usg_mod_hash = mod_hash }
 935         -- for package modules, we record the module hash only
 936
 937       | (null used_occs
 938           && isNothing export_hash
 939           && not is_direct_import
 940           && not finsts_mod)
 941       = Nothing                 -- Record no usage info
 942         -- for directly-imported modules, we always want to record a usage
 943         -- on the orphan hash.  This is what triggers a recompilation if
 944         -- an orphan is added or removed somewhere below us in the future.
 945
 946       | otherwise
 947       = Just UsageHomeModule {
 948                       usg_mod_name = moduleName mod,
 949                       usg_mod_hash = mod_hash,
 950                       usg_exports  = export_hash,
 951                       usg_entities = fmToList ent_hashs }
 952       where
 953         maybe_iface  = lookupIfaceByModule dflags hpt pit mod
 954                 -- In one-shot mode, the interfaces for home-package
 955                 -- modules accumulate in the PIT not HPT.  Sigh.
 956
 957         is_direct_import = mod `elemModuleEnv` direct_imports
 958
 959         Just iface   = maybe_iface
 960         finsts_mod   = mi_finsts    iface
 961         hash_env     = mi_hash_fn   iface
 962         mod_hash     = mi_mod_hash  iface
 963         export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
 964                     | otherwise             = Nothing
 965
 966         used_occs = lookupModuleEnv ent_map mod `orElse` []
 967
 968         -- Making a FiniteMap here ensures that (a) we remove duplicates
 969         -- when we have usages on several subordinates of a single parent,
 970         -- and (b) that the usages emerge in a canonical order, which
 971         -- is why we use FiniteMap rather than OccEnv: FiniteMap works
 972         -- using Ord on the OccNames, which is a lexicographic ordering.
 973         ent_hashs :: FiniteMap OccName Fingerprint
 974         ent_hashs = listToFM (map lookup_occ used_occs)
 975
 976         lookup_occ occ =
 977             case hash_env occ of
 978                 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
 979                 Just r  -> r
 980
 981         depend_on_exports mod =
 982            case lookupModuleEnv direct_imports mod of
 983                 Just _ -> True
 984                   -- Even if we used 'import M ()', we have to register a
 985                   -- usage on the export list because we are sensitive to
 986                   -- changes in orphan instances/rules.
 987                 Nothing -> False
 988                   -- In GHC 6.8.x the above line read "True", and in
 989                   -- fact it recorded a dependency on *all* the
 990                   -- modules underneath in the dependency tree.  This
 991                   -- happens to make orphans work right, but is too
 992                   -- expensive: it'll read too many interface files.
 993                   -- The 'isNothing maybe_iface' check above saved us
 994                   -- from generating many of these usages (at least in
 995                   -- one-shot mode), but that's even more bogus!
 996 \end{code}
 997
 998 \begin{code}
 999 mkIfaceExports :: [AvailInfo]
1000                -> [(Module, [GenAvailInfo OccName])]
1001   -- Group by module and sort by occurrence
1002   -- This keeps the list in canonical order
1003 mkIfaceExports exports
1004   = [ (mod, eltsFM avails)
1005     | (mod, avails) <- fmToList groupFM
1006     ]
1007   where
1008         -- Group by the module where the exported entities are defined
1009         -- (which may not be the same for all Names in an Avail)
1010         -- Deliberately use FiniteMap rather than UniqFM so we
1011         -- get a canonical ordering
1012     groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1013     groupFM = foldl add emptyModuleEnv exports
1014
1015     add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1016             -> Module -> GenAvailInfo OccName
1017             -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1018     add_one env mod avail
1019       =  extendModuleEnv_C plusFM env mod
1020                 (unitFM (occNameFS (availName avail)) avail)
1021
1022         -- NB: we should not get T(X) and T(Y) in the export list
1023         --     else the plusFM will simply discard one!  They
1024         --     should have been combined by now.
1025     add env (Avail n)
1026       = add_one env (nameModule n) (Avail (nameOccName n))
1027
1028     add env (AvailTC tc ns)
1029       = foldl add_for_mod env mods
1030       where
1031         tc_occ = nameOccName tc
1032         mods   = nub (map nameModule ns)
1033                 -- Usually just one, but see Note [Original module]
1034
1035         add_for_mod env mod
1036             = add_one env mod (AvailTC tc_occ (sort names_from_mod))
1037               -- NB. sort the children, we need a canonical order
1038             where
1039               names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
1040 \end{code}
1041
1042 Note [Orignal module]
1043 ~~~~~~~~~~~~~~~~~~~~~
1044 Consider this:
1045         module X where { data family T }
1046         module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1047 The exported Avail from Y will look like
1048         X.T{X.T, Y.MkT}
1049 That is, in Y,
1050   - only MkT is brought into scope by the data instance;
1051   - but the parent (used for grouping and naming in T(..) exports) is X.T
1052   - and in this case we export X.T too
1053
1054 In the result of MkIfaceExports, the names are grouped by defining module,
1055 so we may need to split up a single Avail into multiple ones.
1056
1057
1058 %************************************************************************
1059 %*                                                                      *
1060         Load the old interface file for this module (unless
1061         we have it aleady), and check whether it is up to date
1062
1063 %*                                                                      *
1064 %************************************************************************
1065
1066 \begin{code}
1067 checkOldIface :: HscEnv
1068               -> ModSummary
1069               -> Bool                   -- Source unchanged
1070               -> Maybe ModIface         -- Old interface from compilation manager, if any
1071               -> IO (RecompileRequired, Maybe ModIface)
1072
1073 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1074   = do  { showPass (hsc_dflags hsc_env)
1075                    ("Checking old interface for " ++
1076                         showSDoc (ppr (ms_mod mod_summary))) ;
1077
1078         ; initIfaceCheck hsc_env $
1079           check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1080      }
1081
1082 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1083                 -> IfG (Bool, Maybe ModIface)
1084 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1085  =  do  -- CHECK WHETHER THE SOURCE HAS CHANGED
1086     { when (not source_unchanged)
1087            (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1088
1089      -- If the source has changed and we're in interactive mode, avoid reading
1090      -- an interface; just return the one we might have been supplied with.
1091     ; let dflags = hsc_dflags hsc_env
1092     ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1093          return (outOfDate, maybe_iface)
1094       else
1095       case maybe_iface of {
1096         Just old_iface -> do -- Use the one we already have
1097           { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1098           ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1099           ; return (recomp, Just old_iface) }
1100
1101       ; Nothing -> do
1102
1103         -- Try and read the old interface for the current module
1104         -- from the .hi file left from the last time we compiled it
1105     { let iface_path = msHiFilePath mod_summary
1106     ; read_result <- readIface (ms_mod mod_summary) iface_path False
1107     ; case read_result of {
1108          Failed err -> do       -- Old interface file not found, or garbled; give up
1109                 { traceIf (text "FYI: cannot read old interface file:"
1110                                  $$ nest 4 err)
1111                 ; return (outOfDate, Nothing) }
1112
1113       ;  Succeeded iface -> do
1114
1115         -- We have got the old iface; check its versions
1116     { traceIf (text "Read the interface file" <+> text iface_path)
1117     ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1118     ; return (recomp, Just iface)
1119     }}}}}
1120
1121 \end{code}
1122
1123 @recompileRequired@ is called from the HscMain.   It checks whether
1124 a recompilation is required.  It needs access to the persistent state,
1125 finder, etc, because it may have to load lots of interface files to
1126 check their versions.
1127
1128 \begin{code}
1129 type RecompileRequired = Bool
1130 upToDate, outOfDate :: Bool
1131 upToDate  = False       -- Recompile not required
1132 outOfDate = True        -- Recompile required
1133
1134 checkVersions :: HscEnv
1135               -> Bool           -- True <=> source unchanged
1136               -> ModSummary
1137               -> ModIface       -- Old interface
1138               -> IfG RecompileRequired
1139 checkVersions hsc_env source_unchanged mod_summary iface
1140   | not source_unchanged
1141   = return outOfDate
1142   | otherwise
1143   = do  { traceHiDiffs (text "Considering whether compilation is required for" <+>
1144                         ppr (mi_module iface) <> colon)
1145
1146         ; recomp <- checkDependencies hsc_env mod_summary iface
1147         ; if recomp then return outOfDate else do {
1148
1149         -- Source code unchanged and no errors yet... carry on
1150         --
1151         -- First put the dependent-module info, read from the old
1152         -- interface, into the envt, so that when we look for
1153         -- interfaces we look for the right one (.hi or .hi-boot)
1154         --
1155         -- It's just temporary because either the usage check will succeed
1156         -- (in which case we are done with this module) or it'll fail (in which
1157         -- case we'll compile the module from scratch anyhow).
1158         --
1159         -- We do this regardless of compilation mode, although in --make mode
1160         -- all the dependent modules should be in the HPT already, so it's
1161         -- quite redundant
1162           updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
1163
1164         ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1165         ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1166     }}
1167   where
1168         -- This is a bit of a hack really
1169     mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1170     mod_deps = mkModDeps (dep_mods (mi_deps iface))
1171
1172
1173 -- If the direct imports of this module are resolved to targets that
1174 -- are not among the dependencies of the previous interface file,
1175 -- then we definitely need to recompile.  This catches cases like
1176 --   - an exposed package has been upgraded
1177 --   - we are compiling with different package flags
1178 --   - a home module that was shadowing a package module has been removed
1179 --   - a new home module has been added that shadows a package module
1180 -- See bug #1372.
1181 --
1182 -- Returns True if recompilation is required.
1183 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1184 checkDependencies hsc_env summary iface
1185  = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1186   where
1187    prev_dep_mods = dep_mods (mi_deps iface)
1188    prev_dep_pkgs = dep_pkgs (mi_deps iface)
1189
1190    this_pkg = thisPackage (hsc_dflags hsc_env)
1191
1192    orM = foldr f (return False)
1193     where f m rest = do b <- m; if b then return True else rest
1194
1195    dep_missing (L _ mod) = do
1196      find_res <- liftIO $ findImportedModule hsc_env mod Nothing
1197      case find_res of
1198         Found _ mod
1199           | pkg == this_pkg
1200            -> if moduleName mod `notElem` map fst prev_dep_mods
1201                  then do traceHiDiffs $
1202                            text "imported module " <> quotes (ppr mod) <>
1203                            text " not among previous dependencies"
1204                          return outOfDate
1205                  else
1206                          return upToDate
1207           | otherwise
1208            -> if pkg `notElem` prev_dep_pkgs
1209                  then do traceHiDiffs $
1210                            text "imported module " <> quotes (ppr mod) <>
1211                            text " is from package " <> quotes (ppr pkg) <>
1212                            text ", which is not among previous dependencies"
1213                          return outOfDate
1214                  else
1215                          return upToDate
1216            where pkg = modulePackageId mod
1217         _otherwise  -> return outOfDate
1218
1219 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1220               -> IfG RecompileRequired
1221 needInterface mod continue
1222   = do  -- Load the imported interface if possible
1223     let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1224     traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1225
1226     mb_iface <- loadInterface doc_str mod ImportBySystem
1227         -- Load the interface, but don't complain on failure;
1228         -- Instead, get an Either back which we can test
1229
1230     case mb_iface of
1231         Failed _ ->  (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1232                                        ppr mod]));
1233                 -- Couldn't find or parse a module mentioned in the
1234                 -- old interface file.  Don't complain: it might
1235                 -- just be that the current module doesn't need that
1236                 -- import and it's been deleted
1237         Succeeded iface -> continue iface
1238
1239
1240 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1241 -- Given the usage information extracted from the old
1242 -- M.hi file for the module being compiled, figure out
1243 -- whether M needs to be recompiled.
1244
1245 checkModUsage _this_pkg UsagePackageModule{
1246                                 usg_mod = mod,
1247                                 usg_mod_hash = old_mod_hash }
1248   = needInterface mod $ \iface -> do
1249     checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1250         -- We only track the ABI hash of package modules, rather than
1251         -- individual entity usages, so if the ABI hash changes we must
1252         -- recompile.  This is safe but may entail more recompilation when
1253         -- a dependent package has changed.
1254
1255 checkModUsage this_pkg UsageHomeModule{
1256                                 usg_mod_name = mod_name,
1257                                 usg_mod_hash = old_mod_hash,
1258                                 usg_exports = maybe_old_export_hash,
1259                                 usg_entities = old_decl_hash }
1260   = do
1261     let mod = mkModule this_pkg mod_name
1262     needInterface mod $ \iface -> do
1263
1264     let
1265         new_mod_hash    = mi_mod_hash    iface
1266         new_decl_hash   = mi_hash_fn     iface
1267         new_export_hash = mi_exp_hash    iface
1268
1269         -- CHECK MODULE
1270     recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1271     if not recompile then return upToDate else do
1272
1273         -- CHECK EXPORT LIST
1274     checkMaybeHash maybe_old_export_hash new_export_hash
1275         (ptext (sLit "  Export list changed")) $ do
1276
1277         -- CHECK ITEMS ONE BY ONE
1278     recompile <- checkList [ checkEntityUsage new_decl_hash u
1279                            | u <- old_decl_hash]
1280     if recompile
1281       then return outOfDate     -- This one failed, so just bail out now
1282       else up_to_date (ptext (sLit "  Great!  The bits I use are up to date"))
1283
1284 ------------------------
1285 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1286 checkModuleFingerprint old_mod_hash new_mod_hash
1287   | new_mod_hash == old_mod_hash
1288   = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1289
1290   | otherwise
1291   = out_of_date_hash (ptext (sLit "  Module fingerprint has changed"))
1292                      old_mod_hash new_mod_hash
1293
1294 ------------------------
1295 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1296                -> IfG RecompileRequired -> IfG RecompileRequired
1297 checkMaybeHash maybe_old_hash new_hash doc continue
1298   | Just hash <- maybe_old_hash, hash /= new_hash
1299   = out_of_date_hash doc hash new_hash
1300   | otherwise
1301   = continue
1302
1303 ------------------------
1304 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1305                  -> (OccName, Fingerprint)
1306                  -> IfG Bool
1307 checkEntityUsage new_hash (name,old_hash)
1308   = case new_hash name of
1309
1310         Nothing       ->        -- We used it before, but it ain't there now
1311                           out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1312
1313         Just (_, new_hash)      -- It's there, but is it up to date?
1314           | new_hash == old_hash -> do traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
1315                                        return upToDate
1316           | otherwise            -> out_of_date_hash (ptext (sLit "  Out of date:") <+> ppr name)
1317                                                      old_hash new_hash
1318
1319 up_to_date, out_of_date :: SDoc -> IfG Bool
1320 up_to_date  msg = traceHiDiffs msg >> return upToDate
1321 out_of_date msg = traceHiDiffs msg >> return outOfDate
1322
1323 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1324 out_of_date_hash msg old_hash new_hash
1325   = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1326
1327 ----------------------
1328 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1329 -- This helper is used in two places
1330 checkList []             = return upToDate
1331 checkList (check:checks) = do recompile <- check
1332                               if recompile
1333                                 then return outOfDate
1334                                 else checkList checks
1335 \end{code}
1336
1337 %************************************************************************
1338 %*                                                                      *
1339                 Converting things to their Iface equivalents
1340 %*                                                                      *
1341 %************************************************************************
1342
1343 \begin{code}
1344 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1345 -- Assumption: the thing is already tidied, so that locally-bound names
1346 --             (lambdas, for-alls) already have non-clashing OccNames
1347 -- Reason: Iface stuff uses OccNames, and the conversion here does
1348 --         not do tidying on the way
1349 tyThingToIfaceDecl (AnId id)
1350   = IfaceId { ifName   = getOccName id,
1351               ifType   = toIfaceType (idType id),
1352               ifIdInfo = info }
1353   where
1354     info = case toIfaceIdInfo (idInfo id) of
1355                 []    -> NoInfo
1356                 items -> HasInfo items
1357
1358 tyThingToIfaceDecl (AClass clas)
1359   = IfaceClass { ifCtxt   = toIfaceContext sc_theta,
1360                  ifName   = getOccName clas,
1361                  ifTyVars = toIfaceTvBndrs clas_tyvars,
1362                  ifFDs    = map toIfaceFD clas_fds,
1363                  ifATs    = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1364                  ifSigs   = map toIfaceClassOp op_stuff,
1365                  ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
1366   where
1367     (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1368       = classExtraBigSig clas
1369     tycon = classTyCon clas
1370
1371     toIfaceClassOp (sel_id, def_meth)
1372         = ASSERT(sel_tyvars == clas_tyvars)
1373           IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1374         where
1375                 -- Be careful when splitting the type, because of things
1376                 -- like         class Foo a where
1377                 --                op :: (?x :: String) => a -> a
1378                 -- and          class Baz a where
1379                 --                op :: (Ord a) => a -> a
1380           (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1381           op_ty                = funResultTy rho_ty
1382
1383     toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1384
1385 tyThingToIfaceDecl (ATyCon tycon)
1386   | isSynTyCon tycon
1387   = IfaceSyn {  ifName    = getOccName tycon,
1388                 ifTyVars  = toIfaceTvBndrs tyvars,
1389                 ifOpenSyn = syn_isOpen,
1390                 ifSynRhs  = toIfaceType syn_tyki,
1391                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1392              }
1393
1394   | isAlgTyCon tycon
1395   = IfaceData { ifName    = getOccName tycon,
1396                 ifTyVars  = toIfaceTvBndrs tyvars,
1397                 ifCtxt    = toIfaceContext (tyConStupidTheta tycon),
1398                 ifCons    = ifaceConDecls (algTyConRhs tycon),
1399                 ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
1400                 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1401                 ifGeneric = tyConHasGenerics tycon,
1402                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1403
1404   | isForeignTyCon tycon
1405   = IfaceForeign { ifName    = getOccName tycon,
1406                    ifExtName = tyConExtName tycon }
1407
1408   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1409   where
1410     tyvars = tyConTyVars tycon
1411     (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
1412                                OpenSynTyCon ki _ -> (True , ki)
1413                                SynonymTyCon ty   -> (False, ty)
1414
1415     ifaceConDecls (NewTyCon { data_con = con })     =
1416       IfNewTyCon  (ifaceConDecl con)
1417     ifaceConDecls (DataTyCon { data_cons = cons })  =
1418       IfDataTyCon (map ifaceConDecl cons)
1419     ifaceConDecls OpenTyCon {}                      = IfOpenDataTyCon
1420     ifaceConDecls AbstractTyCon                     = IfAbstractTyCon
1421         -- The last case happens when a TyCon has been trimmed during tidying
1422         -- Furthermore, tyThingToIfaceDecl is also used
1423         -- in TcRnDriver for GHCi, when browsing a module, in which case the
1424         -- AbstractTyCon case is perfectly sensible.
1425
1426     ifaceConDecl data_con
1427         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
1428                     ifConInfix   = dataConIsInfix data_con,
1429                     ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1430                     ifConExTvs   = toIfaceTvBndrs (dataConExTyVars data_con),
1431                     ifConEqSpec  = to_eq_spec (dataConEqSpec data_con),
1432                     ifConCtxt    = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1433                     ifConArgTys  = map toIfaceType (dataConOrigArgTys data_con),
1434                     ifConFields  = map getOccName
1435                                        (dataConFieldLabels data_con),
1436                     ifConStricts = dataConStrictMarks data_con }
1437
1438     to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1439
1440     famInstToIface Nothing                    = Nothing
1441     famInstToIface (Just (famTyCon, instTys)) =
1442       Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1443
1444 tyThingToIfaceDecl (ADataCon dc)
1445  = pprPanic "toIfaceDecl" (ppr dc)      -- Should be trimmed out earlier
1446
1447
1448 getFS :: NamedThing a => a -> FastString
1449 getFS x = occNameFS (getOccName x)
1450
1451 --------------------------
1452 instanceToIfaceInst :: Instance -> IfaceInst
1453 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1454                                 is_cls = cls_name, is_tcs = mb_tcs })
1455   = ASSERT( cls_name == className cls )
1456     IfaceInst { ifDFun    = dfun_name,
1457                 ifOFlag   = oflag,
1458                 ifInstCls = cls_name,
1459                 ifInstTys = map do_rough mb_tcs,
1460                 ifInstOrph = orph }
1461   where
1462     do_rough Nothing  = Nothing
1463     do_rough (Just n) = Just (toIfaceTyCon_name n)
1464
1465     dfun_name = idName dfun_id
1466     mod       = nameModule dfun_name
1467     is_local name = nameIsLocalOrFrom mod name
1468
1469         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1470     (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1471                 -- Slightly awkward: we need the Class to get the fundeps
1472     (tvs, fds) = classTvsFds cls
1473     arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1474     orph | is_local cls_name = Just (nameOccName cls_name)
1475          | all isJust mb_ns  = head mb_ns
1476          | otherwise         = Nothing
1477
1478     mb_ns :: [Maybe OccName]    -- One for each fundep; a locally-defined name
1479                                 -- that is not in the "determined" arguments
1480     mb_ns | null fds   = [choose_one arg_names]
1481           | otherwise  = map do_one fds
1482     do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1483                                           , not (tv `elem` rtvs)]
1484
1485     choose_one :: [NameSet] -> Maybe OccName
1486     choose_one nss = case nameSetToList (unionManyNameSets nss) of
1487                         []      -> Nothing
1488                         (n : _) -> Just (nameOccName n)
1489
1490 --------------------------
1491 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1492 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1493                                  fi_fam = fam,
1494                                  fi_tcs = mb_tcs })
1495   = IfaceFamInst { ifFamInstTyCon  = toIfaceTyCon tycon
1496                  , ifFamInstFam    = fam
1497                  , ifFamInstTys    = map do_rough mb_tcs }
1498   where
1499     do_rough Nothing  = Nothing
1500     do_rough (Just n) = Just (toIfaceTyCon_name n)
1501
1502 --------------------------
1503 toIfaceLetBndr :: Id -> IfaceLetBndr
1504 toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
1505                                (toIfaceType (idType id))
1506                                prag_info
1507   where
1508         -- Stripped-down version of tcIfaceIdInfo
1509         -- Change this if you want to export more IdInfo for
1510         -- non-top-level Ids.  Don't forget to change
1511         -- CoreTidy.tidyLetBndr too!
1512         --
1513         -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1514     id_info = idInfo id
1515     inline_prag = inlinePragInfo id_info
1516     prag_info | isAlwaysActive inline_prag = NoInfo
1517               | otherwise                  = HasInfo [HsInline inline_prag]
1518
1519 --------------------------
1520 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1521 toIfaceIdInfo id_info
1522   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1523                inline_hsinfo, wrkr_hsinfo,  unfold_hsinfo]
1524   where
1525     ------------  Arity  --------------
1526     arity_info = arityInfo id_info
1527     arity_hsinfo | arity_info == 0 = Nothing
1528                  | otherwise       = Just (HsArity arity_info)
1529
1530     ------------ Caf Info --------------
1531     caf_info   = cafInfo id_info
1532     caf_hsinfo = case caf_info of
1533                    NoCafRefs -> Just HsNoCafRefs
1534                    _other    -> Nothing
1535
1536     ------------  Strictness  --------------
1537         -- No point in explicitly exporting TopSig
1538     strict_hsinfo = case newStrictnessInfo id_info of
1539                         Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1540                         _other                        -> Nothing
1541
1542     ------------  Worker  --------------
1543     work_info   = workerInfo id_info
1544     has_worker  = workerExists work_info
1545     wrkr_hsinfo = case work_info of
1546                     HasWorker work_id wrap_arity ->
1547                         Just (HsWorker ((idName work_id)) wrap_arity)
1548                     NoWorker -> Nothing
1549
1550     ------------  Unfolding  --------------
1551     -- The unfolding is redundant if there is a worker
1552     unfold_info  = unfoldingInfo id_info
1553     rhs          = unfoldingTemplate unfold_info
1554     no_unfolding = neverUnfold unfold_info
1555                         -- The CoreTidy phase retains unfolding info iff
1556                         -- we want to expose the unfolding, taking into account
1557                         -- unconditional NOINLINE, etc.  See TidyPgm.addExternal
1558     unfold_hsinfo | no_unfolding = Nothing
1559                   | has_worker   = Nothing      -- Unfolding is implicit
1560                   | otherwise    = Just (HsUnfold (toIfaceExpr rhs))
1561
1562     ------------  Inline prag  --------------
1563     inline_prag = inlinePragInfo id_info
1564     inline_hsinfo | isAlwaysActive inline_prag     = Nothing
1565                   | no_unfolding && not has_worker = Nothing
1566                         -- If the iface file give no unfolding info, we
1567                         -- don't need to say when inlining is OK!
1568                   | otherwise                      = Just (HsInline inline_prag)
1569
1570 --------------------------
1571 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1572 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1573   = pprTrace "toHsRule: builtin" (ppr fn) $
1574     bogusIfaceRule fn
1575
1576 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1577                                 ru_act = act, ru_bndrs = bndrs,
1578                                 ru_args = args, ru_rhs = rhs })
1579   = IfaceRule { ifRuleName  = name, ifActivation = act,
1580                 ifRuleBndrs = map toIfaceBndr bndrs,
1581                 ifRuleHead  = fn,
1582                 ifRuleArgs  = map do_arg args,
1583                 ifRuleRhs   = toIfaceExpr rhs,
1584                 ifRuleOrph  = orph }
1585   where
1586         -- For type args we must remove synonyms from the outermost
1587         -- level.  Reason: so that when we read it back in we'll
1588         -- construct the same ru_rough field as we have right now;
1589         -- see tcIfaceRule
1590     do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1591     do_arg arg       = toIfaceExpr arg
1592
1593         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1594         -- A rule is an orphan only if none of the variables
1595         -- mentioned on its left-hand side are locally defined
1596     lhs_names = fn : nameSetToList (exprsFreeNames args)
1597                 -- No need to delete bndrs, because
1598                 -- exprsFreeNames finds only External names
1599
1600     orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1601                         (n : _) -> Just (nameOccName n)
1602                         []      -> Nothing
1603
1604 bogusIfaceRule :: Name -> IfaceRule
1605 bogusIfaceRule id_name
1606   = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1607         ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1608         ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1609
1610 ---------------------
1611 toIfaceExpr :: CoreExpr -> IfaceExpr
1612 toIfaceExpr (Var v)       = toIfaceVar v
1613 toIfaceExpr (Lit l)       = IfaceLit l
1614 toIfaceExpr (Type ty)     = IfaceType (toIfaceType ty)
1615 toIfaceExpr (Lam x b)     = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1616 toIfaceExpr (App f a)     = toIfaceApp f [a]
1617 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1618 toIfaceExpr (Let b e)     = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1619 toIfaceExpr (Cast e co)   = IfaceCast (toIfaceExpr e) (toIfaceType co)
1620 toIfaceExpr (Note n e)    = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1621
1622 ---------------------
1623 toIfaceNote :: Note -> IfaceNote
1624 toIfaceNote (SCC cc)      = IfaceSCC cc
1625 toIfaceNote InlineMe      = IfaceInlineMe
1626 toIfaceNote (CoreNote s)  = IfaceCoreNote s
1627
1628 ---------------------
1629 toIfaceBind :: Bind Id -> IfaceBinding
1630 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1631 toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1632
1633 ---------------------
1634 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1635            -> (IfaceConAlt, [FastString], IfaceExpr)
1636 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1637
1638 ---------------------
1639 toIfaceCon :: AltCon -> IfaceConAlt
1640 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1641                         | otherwise       = IfaceDataAlt (getName dc)
1642                         where
1643                           tc = dataConTyCon dc
1644
1645 toIfaceCon (LitAlt l) = IfaceLitAlt l
1646 toIfaceCon DEFAULT    = IfaceDefault
1647
1648 ---------------------
1649 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1650 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1651 toIfaceApp (Var v) as
1652   = case isDataConWorkId_maybe v of
1653         -- We convert the *worker* for tuples into IfaceTuples
1654         Just dc |  isTupleTyCon tc && saturated
1655                 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1656           where
1657             val_args  = dropWhile isTypeArg as
1658             saturated = val_args `lengthIs` idArity v
1659             tup_args  = map toIfaceExpr val_args
1660             tc        = dataConTyCon dc
1661
1662         _ -> mkIfaceApps (toIfaceVar v) as
1663
1664 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1665
1666 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1667 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1668
1669 ---------------------
1670 toIfaceVar :: Id -> IfaceExpr
1671 toIfaceVar v
1672   | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1673           -- Foreign calls have special syntax
1674   | isExternalName name             = IfaceExt name
1675   | Just (TickBox m ix) <- isTickBoxOp_maybe v
1676                                     = IfaceTick m ix
1677   | otherwise                       = IfaceLcl (getFS name)
1678   where
1679     name = idName v
1680 \end{code}