Commit 526c3af1 authored by Simon Marlow's avatar Simon Marlow

Use MD5 checksums for recompilation checking (fixes #1372, #1959)

This is a much more robust way to do recompilation checking.  The idea
is to create a fingerprint of the ABI of an interface, and track
dependencies by recording the fingerprints of ABIs that a module
depends on.  If any of those ABIs have changed, then we need to
recompile.

In bug #1372 we weren't recording dependencies on package modules,
this patch fixes that by recording fingerprints of package modules
that we depend on.  Within a package there is still fine-grained
recompilation avoidance as before.

We currently use MD5 for fingerprints, being a good compromise between
efficiency and security.  We're not worried about attackers, but we
are worried about accidental collisions.

All the MD5 sums do make interface files a bit bigger, but compile
times on the whole are about the same as before.  Recompilation
avoidance should be a bit more accurate than in 6.8.2 due to fixing
#1959, especially when using -O.
parent 842e9d66
......@@ -572,7 +572,7 @@ SRC_MKDEPENDC_OPTS += -I$(GHC_INCLUDE_DIR)
SRC_HC_OPTS += \
-cpp -fglasgow-exts -fno-generics -Rghc-timing \
-I. -Iparser
-I. -Iparser -Iutil
# Omitted: -I$(GHC_INCLUDE_DIR)
# We should have -I$(GHC_INCLUDE_DIR) in SRC_HC_OPTS,
......
......@@ -42,6 +42,7 @@ module Module
modulePackageId, moduleName,
pprModule,
mkModule,
stableModuleCmp,
-- * The ModuleLocation type
ModLocation(..),
......@@ -71,6 +72,7 @@ import FiniteMap
import LazyUniqFM
import FastString
import Binary
import Util
import System.FilePath
\end{code}
......@@ -182,6 +184,7 @@ mkModuleNameFS s = ModuleName s
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes = dots_to_slashes . moduleNameString
where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
\end{code}
%************************************************************************
......@@ -205,8 +208,13 @@ instance Binary Module where
put_ bh (Module p n) = put_ bh p >> put_ bh n
get bh = do p <- get bh; n <- get bh; return (Module p n)
instance Uniquable PackageId where
getUnique pid = getUnique (packageIdFS pid)
-- This gives a stable ordering, as opposed to the Ord instance which
-- gives an ordering based on the Uniques of the components, which may
-- not be stable from run to run of the compiler.
stableModuleCmp :: Module -> Module -> Ordering
stableModuleCmp (Module p1 n1) (Module p2 n2)
= (packageIdFS p1 `compare` packageIdFS p2) `thenCmp`
(moduleNameFS n1 `compare` moduleNameFS n2)
mkModule :: PackageId -> ModuleName -> Module
mkModule = Module
......@@ -235,9 +243,17 @@ pprPackagePrefix p mod = getPprStyle doc
%************************************************************************
\begin{code}
newtype PackageId = PId FastString deriving( Eq, Ord ) -- includes the version
newtype PackageId = PId FastString deriving( Eq ) -- includes the version
-- here to avoid module loops with PackageConfig
instance Uniquable PackageId where
getUnique pid = getUnique (packageIdFS pid)
-- Note: *not* a stable lexicographic ordering, a faster unique-based
-- ordering.
instance Ord PackageId where
nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
instance Outputable PackageId where
ppr pid = text (packageIdString pid)
......
......@@ -40,16 +40,13 @@ import {-# SOURCE #-} TypeRep( TyThing )
import OccName
import Module
import SrcLoc
import UniqFM
import Unique
import Maybes
import Binary
import FastMutInt
import FastTypes
import FastString
import Outputable
import Data.IORef
import Data.Array
\end{code}
......@@ -309,20 +306,9 @@ instance NamedThing Name where
\begin{code}
instance Binary Name where
put_ bh name = do
case getUserData bh of {
UserData { ud_symtab_map = symtab_map_ref,
ud_symtab_next = symtab_next } -> do
symtab_map <- readIORef symtab_map_ref
case lookupUFM symtab_map name of
Just (off,_) -> put_ bh off
Nothing -> do
off <- readFastMutInt symtab_next
writeFastMutInt symtab_next (off+1)
writeIORef symtab_map_ref
$! addToUFM symtab_map name (off,name)
put_ bh off
}
put_ bh name =
case getUserData bh of
UserData{ ud_put_name = put_name } -> put_name bh name
get bh = do
i <- get bh
......
......@@ -5,6 +5,7 @@
\begin{code}
module OccName (
mk_deriv,
-- * The NameSpace type; abstact
NameSpace, tcName, clsName, tcClsName, dataName, varName,
tvName, srcDataName,
......
......@@ -363,6 +363,17 @@ lintCoreExpr e@(Case scrut var alt_ty alts) =
do { scrut_ty <- lintCoreExpr scrut
; alt_ty <- lintTy alt_ty
; var_ty <- lintTy (idType var)
; let mb_tc_app = splitTyConApp_maybe (idType var)
; case mb_tc_app of
Just (tycon, _)
| debugIsOn &&
isAlgTyCon tycon &&
null (tyConDataCons tycon) ->
pprTrace "case binder's type has no constructors" (ppr e)
$ return ()
_otherwise -> return ()
-- Don't use lintIdBndr on var, because unboxed tuple is legitimate
; subst <- getTvSubst
......
......@@ -1635,7 +1635,8 @@ showPackages = do
pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags
io $ putStrLn $ showSDoc $ vcat $
text "packages currently loaded:"
: map (nest 2 . text . packageIdString) (sort pkg_ids)
: map (nest 2 . text . packageIdString)
(sortBy (compare `on` packageIdFS) pkg_ids)
where showFlag (ExposePackage p) = text $ " -package " ++ p
showFlag (HidePackage p) = text $ " -hide-package " ++ p
showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p
......
......@@ -32,7 +32,9 @@ import SrcLoc
import ErrUtils
import Config
import FastMutInt
import Unique
import Outputable
import FastString
import Data.List
import Data.Word
......@@ -149,7 +151,19 @@ writeBinIface dflags hi_path mod_iface = do
put_ bh symtab_p_p
-- Make some intial state
ud <- newWriteState
symtab_next <- newFastMutInt
writeFastMutInt symtab_next 0
symtab_map <- newIORef emptyUFM
let bin_symtab = BinSymbolTable {
bin_symtab_next = symtab_next,
bin_symtab_map = symtab_map }
dict_next_ref <- newFastMutInt
writeFastMutInt dict_next_ref 0
dict_map_ref <- newIORef emptyUFM
let bin_dict = BinDictionary {
bin_dict_next = dict_next_ref,
bin_dict_map = dict_map_ref }
ud <- newWriteState (putName bin_symtab) (putFastString bin_dict)
-- Put the main thing,
bh <- return $ setUserData bh ud
......@@ -161,8 +175,8 @@ writeBinIface dflags hi_path mod_iface = do
seekBin bh symtab_p -- Seek back to the end of the file
-- Write the symbol table itself
symtab_next <- readFastMutInt (ud_symtab_next ud)
symtab_map <- readIORef (ud_symtab_map ud)
symtab_next <- readFastMutInt symtab_next
symtab_map <- readIORef symtab_map
putSymbolTable bh symtab_next symtab_map
debugTraceMsg dflags 3 (text "writeBinIface:" <+> int symtab_next
<+> text "Names")
......@@ -176,8 +190,8 @@ writeBinIface dflags hi_path mod_iface = do
seekBin bh dict_p -- Seek back to the end of the file
-- Write the dictionary itself
dict_next <- readFastMutInt (ud_dict_next ud)
dict_map <- readIORef (ud_dict_map ud)
dict_next <- readFastMutInt dict_next_ref
dict_map <- readIORef dict_map_ref
putDictionary bh dict_next dict_map
debugTraceMsg dflags 3 (text "writeBinIface:" <+> int dict_next
<+> text "dict entries")
......@@ -248,6 +262,51 @@ serialiseName bh name _ = do
let mod = nameModule name
put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
putName :: BinSymbolTable -> BinHandle -> Name -> IO ()
putName BinSymbolTable{
bin_symtab_map = symtab_map_ref,
bin_symtab_next = symtab_next } bh name
= do
symtab_map <- readIORef symtab_map_ref
case lookupUFM symtab_map name of
Just (off,_) -> put_ bh off
Nothing -> do
off <- readFastMutInt symtab_next
writeFastMutInt symtab_next (off+1)
writeIORef symtab_map_ref
$! addToUFM symtab_map name (off,name)
put_ bh off
data BinSymbolTable = BinSymbolTable {
bin_symtab_next :: !FastMutInt, -- The next index to use
bin_symtab_map :: !(IORef (UniqFM (Int,Name)))
-- indexed by Name
}
putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()
putFastString BinDictionary { bin_dict_next = j_r,
bin_dict_map = out_r} bh f
= do
out <- readIORef out_r
let uniq = getUnique f
case lookupUFM out uniq of
Just (j, _) -> put_ bh j
Nothing -> do
j <- readFastMutInt j_r
put_ bh j
writeFastMutInt j_r (j + 1)
writeIORef out_r $! addToUFM out uniq (j, f)
data BinDictionary = BinDictionary {
bin_dict_next :: !FastMutInt, -- The next index to use
bin_dict_map :: !(IORef (UniqFM (Int,FastString)))
-- indexed by FastString
}
-- -----------------------------------------------------------------------------
-- All the binary instances
......@@ -300,70 +359,74 @@ instance Binary ModIface where
put_ bh (ModIface {
mi_module = mod,
mi_boot = is_boot,
mi_mod_vers = mod_vers,
mi_iface_hash= iface_hash,
mi_mod_hash = mod_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_deps = deps,
mi_usages = usages,
mi_exports = exports,
mi_exp_vers = exp_vers,
mi_exp_hash = exp_hash,
mi_fixities = fixities,
mi_deprecs = deprecs,
mi_decls = decls,
mi_insts = insts,
mi_fam_insts = fam_insts,
mi_rules = rules,
mi_rule_vers = rule_vers,
mi_orphan_hash = orphan_hash,
mi_vect_info = vect_info,
mi_hpc = hpc_info }) = do
put_ bh mod
put_ bh is_boot
put_ bh mod_vers
put_ bh iface_hash
put_ bh mod_hash
put_ bh orphan
put_ bh hasFamInsts
lazyPut bh deps
lazyPut bh usages
put_ bh exports
put_ bh exp_vers
put_ bh exp_hash
put_ bh fixities
lazyPut bh deprecs
put_ bh decls
put_ bh insts
put_ bh fam_insts
lazyPut bh rules
put_ bh rule_vers
put_ bh orphan_hash
put_ bh vect_info
put_ bh hpc_info
get bh = do
mod_name <- get bh
is_boot <- get bh
mod_vers <- get bh
iface_hash <- get bh
mod_hash <- get bh
orphan <- get bh
hasFamInsts <- get bh
deps <- lazyGet bh
usages <- {-# SCC "bin_usages" #-} lazyGet bh
exports <- {-# SCC "bin_exports" #-} get bh
exp_vers <- get bh
exp_hash <- get bh
fixities <- {-# SCC "bin_fixities" #-} get bh
deprecs <- {-# SCC "bin_deprecs" #-} lazyGet bh
decls <- {-# SCC "bin_tycldecls" #-} get bh
insts <- {-# SCC "bin_insts" #-} get bh
fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
rules <- {-# SCC "bin_rules" #-} lazyGet bh
rule_vers <- get bh
orphan_hash <- get bh
vect_info <- get bh
hpc_info <- get bh
return (ModIface {
mi_module = mod_name,
mi_boot = is_boot,
mi_mod_vers = mod_vers,
mi_iface_hash = iface_hash,
mi_mod_hash = mod_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_deps = deps,
mi_usages = usages,
mi_exports = exports,
mi_exp_vers = exp_vers,
mi_exp_hash = exp_hash,
mi_fixities = fixities,
mi_deprecs = deprecs,
mi_decls = decls,
......@@ -371,13 +434,13 @@ instance Binary ModIface where
mi_insts = insts,
mi_fam_insts = fam_insts,
mi_rules = rules,
mi_rule_vers = rule_vers,
mi_orphan_hash = orphan_hash,
mi_vect_info = vect_info,
mi_hpc = hpc_info,
-- And build the cached values
mi_dep_fn = mkIfaceDepCache deprecs,
mi_fix_fn = mkIfaceFixCache fixities,
mi_ver_fn = mkIfaceVerCache decls })
mi_hash_fn = mkIfaceHashCache decls })
getWayDescr :: IO String
getWayDescr = do
......@@ -421,22 +484,31 @@ instance (Binary name) => Binary (GenAvailInfo name) where
return (AvailTC ab ac)
instance Binary Usage where
put_ bh usg = do
put_ bh (usg_name usg)
put_ bh (usg_mod usg)
put_ bh usg@UsagePackageModule{} = do
putByte bh 0
put_ bh (usg_mod usg)
put_ bh (usg_mod_hash usg)
put_ bh usg@UsageHomeModule{} = do
putByte bh 1
put_ bh (usg_mod_name usg)
put_ bh (usg_mod_hash usg)
put_ bh (usg_exports usg)
put_ bh (usg_entities usg)
put_ bh (usg_rules usg)
get bh = do
nm <- get bh
mod <- get bh
exps <- get bh
ents <- get bh
rules <- get bh
return (Usage { usg_name = nm, usg_mod = mod,
usg_exports = exps, usg_entities = ents,
usg_rules = rules })
h <- getByte bh
case h of
0 -> do
nm <- get bh
mod <- get bh
return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod }
_ -> do
nm <- get bh
mod <- get bh
exps <- get bh
ents <- get bh
return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
usg_exports = exps, usg_entities = ents }
instance Binary Deprecations where
put_ bh NoDeprecs = putByte bh 0
......
This diff is collapsed.
......@@ -51,6 +51,7 @@ import BinIface
import Panic
import Util
import FastString
import Fingerprint
import Control.Monad
import Data.List
......@@ -323,7 +324,7 @@ addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
addDeclsToPTE pte things = extendNameEnvList pte things
loadDecls :: Bool
-> [(Version, IfaceDecl)]
-> [(Fingerprint, IfaceDecl)]
-> IfL [(Name,TyThing)]
loadDecls ignore_prags ver_decls
= do { mod <- getIfModule
......@@ -333,7 +334,7 @@ loadDecls ignore_prags ver_decls
loadDecl :: Bool -- Don't load pragmas into the decl pool
-> Module
-> (Version, IfaceDecl)
-> (Fingerprint, IfaceDecl)
-> IfL [(Name,TyThing)] -- The list can be poked eagerly, but the
-- TyThings are forkM'd thunks
loadDecl ignore_prags mod (_version, decl)
......@@ -616,13 +617,16 @@ pprModIface :: ModIface -> SDoc
-- Show a ModIface
pprModIface iface
= vcat [ ptext (sLit "interface")
<+> ppr (mi_module iface) <+> pp_boot
<+> ppr (mi_mod_vers iface) <+> pp_sub_vers
<+> ppr (mi_module iface) <+> pp_boot
<+> (if mi_orphan iface then ptext (sLit "[orphan module]") else empty)
<+> (if mi_finsts iface then ptext (sLit "[family instance module]") else empty)
<+> (if mi_hpc iface then ptext (sLit "[hpc]") else empty)
<+> integer opt_HiVersion
<+> ptext (sLit "where")
, nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface))
, nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface))
, nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
, nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
, nest 2 (ptext (sLit "where"))
, vcat (map pprExport (mi_exports iface))
, pprDeps (mi_deps iface)
, vcat (map pprUsage (mi_usages iface))
......@@ -637,12 +641,6 @@ pprModIface iface
where
pp_boot | mi_boot iface = ptext (sLit "[boot]")
| otherwise = empty
exp_vers = mi_exp_vers iface
rule_vers = mi_rule_vers iface
pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty
| otherwise = brackets (ppr exp_vers <+> ppr rule_vers)
\end{code}
When printing export lists, we print like this:
......@@ -666,16 +664,16 @@ pprExport (mod, items)
pp_export names = braces (hsep (map ppr names))
pprUsage :: Usage -> SDoc
pprUsage usage
= hsep [ptext (sLit "import"), ppr (usg_name usage),
int (usg_mod usage),
pp_export_version (usg_exports usage),
int (usg_rules usage),
pp_versions (usg_entities usage) ]
where
pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ]
pp_export_version Nothing = empty
pp_export_version (Just v) = int v
pprUsage usage@UsagePackageModule{}
= hsep [ptext (sLit "import"), ppr (usg_mod usage),
ppr (usg_mod_hash usage)]
pprUsage usage@UsageHomeModule{}
= hsep [ptext (sLit "import"), ppr (usg_mod_name usage),
ppr (usg_mod_hash usage)] $$
nest 2 (
maybe empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$
vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]
)
pprDeps :: Dependencies -> SDoc
pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
......@@ -690,13 +688,9 @@ pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
ppr_boot True = text "[boot]"
ppr_boot False = empty
pprIfaceDecl :: (Version, IfaceDecl) -> SDoc
pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc
pprIfaceDecl (ver, decl)
= ppr_vers ver <+> ppr decl
where
-- Print the version for the decl
ppr_vers v | v == initialVersion = empty
| otherwise = int v
= ppr ver $$ nest 2 (ppr decl)
pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities [] = empty
......
This diff is collapsed.
......@@ -216,7 +216,7 @@ deSugarModule hsc_env mod_summary tc_result
makeSimpleIface :: HscEnv -> Maybe ModIface -> TcGblEnv -> ModDetails
-> IO (ModIface,Bool)
makeSimpleIface hsc_env maybe_old_iface tc_result details = do
mkIfaceTc hsc_env maybe_old_iface details tc_result
mkIfaceTc hsc_env (fmap mi_iface_hash maybe_old_iface) details tc_result
-- | Make a 'ModDetails' from the results of typechecking. Used when
-- typechecking only, as opposed to full compilation.
......@@ -548,7 +548,7 @@ hscSimpleIface tc_result
details <- mkBootModDetailsTc hsc_env tc_result
(new_iface, no_change)
<- {-# SCC "MkFinalIface" #-}
mkIfaceTc hsc_env maybe_old_iface details tc_result
mkIfaceTc hsc_env (fmap mi_iface_hash maybe_old_iface) details tc_result
-- And the answer is ...
dumpIfaceStats hsc_env
return (new_iface, no_change, details, tc_result)
......@@ -573,7 +573,8 @@ hscNormalIface simpl_result
-- until after code output
(new_iface, no_change)
<- {-# SCC "MkFinalIface" #-}
mkIface hsc_env maybe_old_iface details simpl_result
mkIface hsc_env (fmap mi_iface_hash maybe_old_iface)
details simpl_result
-- Emit external core
-- This should definitely be here and not after CorePrep,
-- because CorePrep produces unqualified constructor wrapper declarations,
......
......@@ -32,7 +32,7 @@ module HscTypes (
icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
substInteractiveContext,
ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
ModIface(..), mkIfaceDepCache, mkIfaceHashCache, mkIfaceFixCache,
emptyIfaceDepCache,
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
......@@ -101,8 +101,7 @@ import PrelNames ( gHC_PRIM )
import Packages hiding ( Version(..) )
import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
import BasicTypes ( Version, initialVersion, IPName,
Fixity, defaultFixity, DeprecTxt )
import BasicTypes ( IPName, Fixity, defaultFixity, DeprecTxt )
import IfaceSyn
import FiniteMap ( FiniteMap )
import CoreSyn ( CoreRule )
......@@ -114,6 +113,7 @@ import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString
import StringBuffer ( StringBuffer )
import Fingerprint
import System.FilePath
import System.Time ( ClockTime )
......@@ -408,7 +408,8 @@ the declarations into a single indexed map in the @PersistentRenamerState@.
data ModIface
= ModIface {
mi_module :: !Module,
mi_mod_vers :: !Version, -- Module version: changes when anything changes
mi_iface_hash :: !Fingerprint, -- Hash of the whole interface
mi_mod_hash :: !Fingerprint, -- Hash of the ABI only
mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans
mi_finsts :: !WhetherHasFamInst, -- Whether module has family insts
......@@ -420,7 +421,7 @@ data ModIface
-- Usages; kept sorted so that it's easy to decide
-- whether to write a new iface file (changing usages
-- doesn't affect the version of this module)
-- doesn't affect the hash of this module)
mi_usages :: [Usage],
-- NOT STRICT! we read this field lazily from the interface file
-- It is *only* consulted by the recompilation checker
......@@ -428,7 +429,7 @@ data ModIface
-- Exports
-- Kept sorted by (mod,occ), to make version comparisons easier
mi_exports :: ![IfaceExport],
mi_exp_vers :: !Version, -- Version number of export list
mi_exp_hash :: !Fingerprint, -- Hash of export list
-- Fixities
mi_fixities :: [(OccName,Fixity)],
......@@ -439,11 +440,11 @@ data ModIface
-- NOT STRICT! we read this field lazily from the interface file
-- Type, class and variable declarations
-- The version of an Id changes if its fixity or deprecations change
-- The hash of an Id changes if its fixity or deprecations change
-- (as well as its type of course)
-- Ditto data constructors, class operations, except that
-- the version of the parent class/tycon changes
mi_decls :: [(Version,IfaceDecl)], -- Sorted
-- the hash of the parent class/tycon changes
mi_decls :: [(Fingerprint,IfaceDecl)], -- Sorted
mi_globals :: !(Maybe GlobalRdrEnv),
-- Binds all the things defined at the top level in
......@@ -464,7 +465,7 @@ data ModIface
mi_insts :: [IfaceInst], -- Sorted
mi_fam_insts :: [IfaceFamInst], -- Sorted
mi_rules :: [IfaceRule], -- Sorted
mi_rule_vers :: !Version, -- Version number for rules and
mi_orphan_hash :: !Fingerprint, -- Hash for orphan rules and
-- instances (for classes and families)
-- combined
......@@ -476,9 +477,9 @@ data ModIface
-- and are not put into the interface file
mi_dep_fn :: Name -> Maybe DeprecTxt, -- Cached lookup for mi_deprecs
mi_fix_fn :: OccName -> Fixity, -- Cached lookup for mi_fixities
mi_ver_fn :: OccName -> Maybe (OccName, Version),
mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
-- Cached lookup for mi_decls
-- The Nothing in mi_ver_fn means that the thing
-- The Nothing in mi_hash_fn means that the thing
-- isn't in decls. It's useful to know that when
-- seeing if we are up to date wrt the old interface
-- The 'OccName' is the parent of the name, if it has one.
......@@ -512,7 +513,7 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv,
-- being compiled right now. Once it is compiled, a ModIface and
-- ModDetails are extracted and the ModGuts is dicarded.
type ImportedMods = ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)])
type ImportedMods = ModuleEnv [(ModuleName, Bool, SrcSpan)]
data ModGuts
= ModGuts {
......@@ -635,14 +636,15 @@ data ForeignStubs = NoStubs
emptyModIface :: Module -> ModIface
emptyModIface mod
= ModIface { mi_module = mod,
mi_mod_vers = initialVersion,
mi_iface_hash = fingerprint0,
mi_mod_hash = fingerprint0,
mi_orphan = False,
mi_finsts = False,
mi_boot = False,
mi_deps = noDependencies,
mi_usages = [],
mi_exports = [],
mi_exp_vers = initialVersion,
mi_exp_hash = fingerprint0,
mi_fixities = [],
mi_deprecs = NoDeprecs,
mi_insts = [],
......@@ -650,12 +652,12 @@ emptyModIface mod
mi_rules = [],
mi_decls = [],
mi_globals = Nothing,
mi_rule_vers = initialVersion,
mi_orphan_hash = fingerprint0,
mi_vect_info = noIfaceVectInfo,
mi_dep_fn = emptyIfaceDepCache,
mi_fix_fn = emptyIfaceFixCache,
mi_ver_fn = emptyIfaceVerCache,
mi_hpc = False
mi_dep_fn = emptyIfaceDepCache,
mi_fix_fn = emptyIfaceFixCache,
mi_hash_fn = emptyIfaceHashCache,
mi_hpc = False
}
\end{code}
......@@ -965,19 +967,10 @@ tyThingId (ADataCon dc) = dataConWrapId dc
tyThingId other = pprPanic "tyThingId" (pprTyThing other)
\end{code}