Commit 55991bf6 authored by dterei's avatar dterei
Browse files

Fix #437: recompilation check includes flags

parent a238104a
......@@ -301,6 +301,7 @@ Library
LoadIface
MkIface
TcIface
FlagChecker
Annotations
BreakArray
CmdLineParser
......
......@@ -475,6 +475,7 @@ instance Binary ModIface where
mi_boot = is_boot,
mi_iface_hash= iface_hash,
mi_mod_hash = mod_hash,
mi_flag_hash = flag_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_deps = deps,
......@@ -498,6 +499,7 @@ instance Binary ModIface where
put_ bh is_boot
put_ bh iface_hash
put_ bh mod_hash
put_ bh flag_hash
put_ bh orphan
put_ bh hasFamInsts
lazyPut bh deps
......@@ -523,6 +525,7 @@ instance Binary ModIface where
is_boot <- get bh
iface_hash <- get bh
mod_hash <- get bh
flag_hash <- get bh
orphan <- get bh
hasFamInsts <- get bh
deps <- lazyGet bh
......@@ -547,6 +550,7 @@ instance Binary ModIface where
mi_boot = is_boot,
mi_iface_hash = iface_hash,
mi_mod_hash = mod_hash,
mi_flag_hash = flag_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_deps = deps,
......
-- {-# LANGUAGE StandaloneDeriving #-}
-- -----------------------------------------------------------------------------
-- | This module manages storing the various GHC option flags in a modules
-- interface file as part of the recompilation checking infrastructure.
--
module FlagChecker (
fingerprintDynFlags
) where
import Binary
import BinIface ()
import DynFlags
import HscTypes
import Name
import Fingerprint
-- import Data.List (sort)
{-
Note [DynFlags Hash]
~~~~~~~~~~~~~~~~~~~
We only hash fields from DynFlags that are of high importance as they stop
link and build errors occurring (e.g the '--main-is' flag, see trac #437).
An alternative design would be to return two fingerprints where the first one
encodes flags that if different mean that the module itself should be
recompiled but only this module. The second fingerprint is for flags that mean
that not only the module itself should be recompiled but also modules that
depend on it. (i.e the second fingerprint affects the modules ABI).
This design hasn't been implemented as it's tricky to fit in with the current
recompilation manager and its not sure how beneficial it is.
-}
-- | Produce a fingerprint of a @DynFlags@ value. We only base
-- the finger print on important fields in @DynFlags@ so that
-- the recompilation checker can use this fingerprint.
fingerprintDynFlags :: DynFlags -> (BinHandle -> Name -> IO ()) -> IO Fingerprint
fingerprintDynFlags dflags nameio =
let -- DriverPipeline.getLinkInfo handles this info I believe
-- rtsopts = (rtsOptsEnabled dflags, rtsOpts dflags)
-- Probably not a good idea
-- optlvl = optLevel dflags
mainis = (mainModIs dflags, mainFunIs dflags)
-- pkgopts = (thisPackage dflags, sort $ packageFlags dflags)
safeHs = setSafeMode $ safeHaskell dflags
-- oflags = sort $ filter filterOFlags $ flags dflags
-- eflags = sort $ filter filterEFlags $ extensionFlags dflags
flagOpts = (mainis, safeHs)
in computeFingerprint nameio flagOpts
{-
-- | Should the @DynFlag@ be included in the fingerprint?
filterOFlags :: DynFlag -> Bool
filterOFlags Opt_EnableRewriteRules = True
filterOFlags Opt_Vectorise = True
filterOFlags Opt_IgnoreInterfacePragmas = True
filterOFlags Opt_OmitInterfacePragmas = True
filterOFlags Opt_ExposeAllUnfoldings = True
filterOFlags Opt_ReadUserPackageConf = True
filterOFlags Opt_NoHsMain = True
filterOFlags Opt_SSE2 = True
filterOFlags Opt_SSE4_2 = True
filterOFlags Opt_PackageTrust = True
filterOFlags _ = False
-- | Should the @ExtensionFlag@ be included in the fingerprint?
filterEFlags :: ExtensionFlag -> Bool
filterEFlags Opt_ExtendedDefaultRules = True
filterEFlags Opt_InterruptibleFFI = True
filterEFlags Opt_ImplicitParams = True
filterEFlags Opt_ImplicitPrelude = True
filterEFlags Opt_OverloadedStrings = True
filterEFlags Opt_RebindableSyntax = True
filterEFlags _ = False
-}
-- -----------------------------------------------------------------------------
-- Instances needed for Binary
-- -----------------------------------------------------------------------------
{-
deriving instance Ord DynFlag
deriving instance Enum DynFlag
deriving instance Ord ExtensionFlag
deriving instance Enum ExtensionFlag
-- NOTE: We're converting from int to byte8 here, so be careful if we
-- ever get more DynFlag or ExtensionFlag constructors than 256.
instance Binary DynFlag where
put_ bh = (putByte bh . fromIntegral . fromEnum)
get bh = getByte bh >>= (return . toEnum . fromIntegral)
instance Binary ExtensionFlag where
put_ bh = (putByte bh . fromIntegral . fromEnum)
get bh = getByte bh >>= (return . toEnum . fromIntegral)
-- | RtsOptsEnabled Binary Instance
instance Binary RtsOptsEnabled where
put_ bh rtsopts =
case rtsopts of
RtsOptsNone -> putByte bh 0
RtsOptsSafeOnly -> putByte bh 1
RtsOptsAll -> putByte bh 2
get bh = do
x <- getByte bh
case x of
0 -> return RtsOptsNone
1 -> return RtsOptsSafeOnly
2 -> return RtsOptsAll
_ -> error "Unhandled RtsOptsEnabled serilization"
-- | PackageFlag Binary Instance
instance Binary PackageFlag where
put_ bh pflag =
case pflag of
(ExposePackage s) -> store 0 s
(ExposePackageId s) -> store 1 s
(HidePackage s) -> store 2 s
(IgnorePackage s) -> store 3 s
(TrustPackage s) -> store 4 s
(DistrustPackage s) -> store 5 s
where store n s = putByte bh n >> put_ bh s
get bh = do
n <- getByte bh
s <- get bh
return $ case n of
0 -> ExposePackage s
1 -> ExposePackageId s
2 -> HidePackage s
3 -> IgnorePackage s
4 -> TrustPackage s
5 -> DistrustPackage s
_ -> error "Unhandled PackageFlag serilization"
-}
......@@ -660,6 +660,7 @@ pprModIface 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 (text "flag hash:" <+> ppr (mi_flag_hash iface))
, nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
, nest 2 (ptext (sLit "where"))
, ptext (sLit "exports:")
......
......@@ -57,6 +57,8 @@ Basic idea:
import IfaceSyn
import LoadIface
import FlagChecker
import Id
import IdInfo
import Demand
......@@ -285,13 +287,14 @@ mkIface_ hsc_env maybe_old_fingerprint
mi_anns = mkIfaceAnnotations anns,
mi_globals = Just rdr_env,
-- Left out deliberately: filled in by addVersionInfo
-- Left out deliberately: filled in by addFingerprints
mi_iface_hash = fingerprint0,
mi_mod_hash = fingerprint0,
mi_flag_hash = fingerprint0,
mi_exp_hash = fingerprint0,
mi_used_th = used_th,
mi_orphan_hash = fingerprint0,
mi_orphan = False, -- Always set by addVersionInfo, but
mi_orphan = False, -- Always set by addFingerprints, but
-- it's a strict field, so we can't omit it.
mi_finsts = False, -- Ditto
mi_decls = deliberatelyOmitted "decls",
......@@ -337,7 +340,7 @@ mkIface_ hsc_env maybe_old_fingerprint
-- bug #1617: on reload we weren't updating the PrintUnqualified
-- correctly. This stems from the fact that the interface had
-- not changed, so addVersionInfo returns the old ModIface
-- not changed, so addFingerprints returns the old ModIface
-- with the old GlobalRdrEnv (mi_globals).
; let final_iface = new_iface{ mi_globals = Just rdr_env }
......@@ -560,6 +563,12 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
-- put the declarations in a canonical order, sorted by OccName
let sorted_decls = Map.elems $ Map.fromList $
[(ifName d, e) | e@(_, d) <- decls_w_hashes]
-- the flag hash depends on:
-- - (some of) dflags
-- it returns two hashes, one that shouldn't change
-- the abi hash and one that should
flag_hash <- fingerprintDynFlags dflags putNameLiterally
-- the ABI hash depends on:
-- - decls
......@@ -567,6 +576,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
-- - orphans
-- - deprecations
-- - vect info
-- - flag abi hash
mod_hash <- computeFingerprint putNameLiterally
(map fst sorted_decls,
export_hash,
......@@ -575,10 +585,10 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
mi_vect_info iface0)
-- The interface hash depends on:
-- - the ABI hash, plus
-- - usages
-- - deps
-- - hpc
-- - the ABI hash, plus
-- - usages
-- - deps
-- - hpc
iface_hash <- computeFingerprint putNameLiterally
(mod_hash,
mi_usages iface0,
......@@ -593,6 +603,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
mi_iface_hash = iface_hash,
mi_exp_hash = export_hash,
mi_orphan_hash = orphan_hash,
mi_flag_hash = flag_hash,
mi_orphan = not (null orph_rules && null orph_insts
&& null (ifaceVectInfoVar (mi_vect_info iface0))),
mi_finsts = not . null $ mi_fam_insts iface0,
......@@ -1043,12 +1054,18 @@ Trac #5362 for an example. Such Names are always
%************************************************************************
%* *
Load the old interface file for this module (unless
we have it aleady), and check whether it is up to date
we have it already), and check whether it is up to date
%* *
%************************************************************************
\begin{code}
-- | Top level function to check if the version of an old interface file
-- is equivalent to the current source file the user asked us to compile.
-- If the same, we can avoid recompilation. We return a tuple where the
-- first element is a bool saying if we should recompile the object file
-- and the second is maybe the interface file, where Nothng means to
-- rebuild the interface file not use the exisitng one.
checkOldIface :: HscEnv
-> ModSummary
-> SourceModified
......@@ -1066,69 +1083,76 @@ check_old_iface :: HscEnv -> ModSummary -> SourceModified -> Maybe ModIface
check_old_iface hsc_env mod_summary src_modified maybe_iface
= let dflags = hsc_dflags hsc_env
getIface =
case maybe_iface of
Just _ -> do
traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
return maybe_iface
Nothing -> do
let iface_path = msHiFilePath mod_summary
read_result <- readIface (ms_mod mod_summary) iface_path False
case read_result of
Failed err -> do
traceIf (text "FYI: cannont read old interface file:" $$ nest 4 err)
return Nothing
Succeeded iface -> do
traceIf (text "Read the interface file" <+> text iface_path)
return $ Just iface
case maybe_iface of
Just _ -> do
traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
return maybe_iface
Nothing -> loadIface
loadIface = do
let iface_path = msHiFilePath mod_summary
read_result <- readIface (ms_mod mod_summary) iface_path False
case read_result of
Failed err -> do
traceIf (text "FYI: cannont read old interface file:" $$ nest 4 err)
return Nothing
Succeeded iface -> do
traceIf (text "Read the interface file" <+> text iface_path)
return $ Just iface
src_changed
| dopt Opt_ForceRecomp (hsc_dflags hsc_env) = True
| SourceModified <- src_modified = True
| otherwise = False
in do
let src_changed
| dopt Opt_ForceRecomp (hsc_dflags hsc_env) = True
| SourceModified <- src_modified = True
| otherwise = False
when src_changed
(traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
-- If the source has changed and we're in interactive mode,
-- avoid reading an interface; just return the one we might
-- have been supplied with.
if not (isObjectTarget $ hscTarget dflags) && src_changed
then return (outOfDate, maybe_iface)
else do
-- Try and read the old interface for the current module
-- from the .hi file left from the last time we compiled it
when src_changed $
traceHiDiffs (nest 4 $ text "Source file changed or recompilation check turned off")
case src_changed of
-- If the source has changed and we're in interactive mode,
-- avoid reading an interface; just return the one we might
-- have been supplied with.
True | not (isObjectTarget $ hscTarget dflags) ->
return (outOfDate, maybe_iface)
-- Try and read the old interface for the current module
-- from the .hi file left from the last time we compiled it
True -> do
maybe_iface' <- getIface
if src_changed
then return (outOfDate, maybe_iface')
else do
case maybe_iface' of
Nothing -> return (outOfDate, maybe_iface')
Just iface ->
-- We have got the old iface; check its versions
-- even in the SourceUnmodifiedAndStable case we
-- should check versions because some packages
-- might have changed or gone away.
checkVersions hsc_env mod_summary iface
\end{code}
return (outOfDate, maybe_iface')
@recompileRequired@ is called from the HscMain. It checks whether
a recompilation is required. It needs access to the persistent state,
finder, etc, because it may have to load lots of interface files to
check their versions.
\begin{code}
False -> do
maybe_iface' <- getIface
case maybe_iface' of
-- We can't retrieve the iface
Nothing -> return (outOfDate, Nothing)
-- We have got the old iface; check its versions
-- even in the SourceUnmodifiedAndStable case we
-- should check versions because some packages
-- might have changed or gone away.
Just iface -> checkVersions hsc_env mod_summary iface
-- | @recompileRequired@ is called from the HscMain. It checks whether
-- a recompilation is required. It needs access to the persistent state,
-- finder, etc, because it may have to load lots of interface files to
-- check their versions.
type RecompileRequired = Bool
upToDate, outOfDate :: Bool
upToDate = False -- Recompile not required
outOfDate = True -- Recompile required
-- | Check the safe haskell flags haven't changed
-- (e.g different flag on command line now)
safeHsChanged :: HscEnv -> ModIface -> Bool
safeHsChanged hsc_env iface
= (getSafeMode $ mi_trust iface) /= (safeHaskell $ hsc_dflags hsc_env)
upToDate = False -- Recompile not required
outOfDate = True -- Recompile required
-- | Check if a module is still the same 'version'.
--
-- This function is called in the recompilation checker after we have
-- determined that the module M being checked hasn't had any changes
-- to its source file since we last compiled M. So at this point in general
-- two things may have changed that mean we should recompile M:
-- * The interface export by a dependency of M has changed.
-- * The compiler flags specified this time for M have changed
-- in a manner that is significant for recompilaiton.
-- We return not just if we should recompile the object file but also
-- if we should rebuild the interface file.
checkVersions :: HscEnv
-> ModSummary
-> ModIface -- Old interface
......@@ -1137,9 +1161,10 @@ checkVersions hsc_env mod_summary iface
= do { traceHiDiffs (text "Considering whether compilation is required for" <+>
ppr (mi_module iface) <> colon)
; recomp <- checkFlagHash hsc_env iface
; if recomp then return (outOfDate, Nothing) else do {
; recomp <- checkDependencies hsc_env mod_summary iface
; if recomp then return (outOfDate, Just iface) else do {
; if trust_dif then return (outOfDate, Nothing) else do {
-- Source code unchanged and no errors yet... carry on
--
......@@ -1159,12 +1184,21 @@ checkVersions hsc_env mod_summary iface
; return (recomp, Just iface)
}}}
where
this_pkg = thisPackage (hsc_dflags hsc_env)
trust_dif = safeHsChanged hsc_env iface
this_pkg = thisPackage (hsc_dflags hsc_env)
-- This is a bit of a hack really
mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
mod_deps = mkModDeps (dep_mods (mi_deps iface))
-- | Check the safe haskell flags haven't changed
-- (e.g different flag on command line now)
checkFlagHash :: HscEnv -> ModIface -> IfG RecompileRequired
checkFlagHash hsc_env iface = do
let old_hash = mi_flag_hash iface
new_hash <- liftIO $ fingerprintDynFlags (hsc_dflags hsc_env) putNameLiterally
case old_hash == new_hash of
True -> up_to_date (ptext $ sLit "Module flags unchanged")
False -> out_of_date_hash (ptext $ sLit " Module flags have changed")
old_hash new_hash
-- If the direct imports of this module are resolved to targets that
-- are not among the dependencies of the previous interface file,
......@@ -1233,11 +1267,10 @@ needInterface mod continue
Succeeded iface -> continue iface
checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
-- Given the usage information extracted from the old
-- | Given the usage information extracted from the old
-- M.hi file for the module being compiled, figure out
-- whether M needs to be recompiled.
checkModUsage :: PackageId -> Usage -> IfG RecompileRequired
checkModUsage _this_pkg UsagePackageModule{
usg_mod = mod,
usg_mod_hash = old_mod_hash }
......@@ -1283,9 +1316,8 @@ checkModUsage _this_pkg UsageFile{ usg_file_path = file, usg_mtime = old_mtime }
return $ old_mtime /= new_mtime
------------------------
checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG RecompileRequired
checkModuleFingerprint old_mod_hash new_mod_hash
| new_mod_hash == old_mod_hash
= up_to_date (ptext (sLit "Module fingerprint unchanged"))
......@@ -1306,7 +1338,7 @@ checkMaybeHash maybe_old_hash new_hash doc continue
------------------------
checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
-> (OccName, Fingerprint)
-> IfG Bool
-> IfG RecompileRequired
checkEntityUsage new_hash (name,old_hash)
= case new_hash name of
......@@ -1319,11 +1351,11 @@ checkEntityUsage new_hash (name,old_hash)
| otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
old_hash new_hash
up_to_date, out_of_date :: SDoc -> IfG Bool
up_to_date, out_of_date :: SDoc -> IfG RecompileRequired
up_to_date msg = traceHiDiffs msg >> return upToDate
out_of_date msg = traceHiDiffs msg >> return outOfDate
out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG RecompileRequired
out_of_date_hash msg old_hash new_hash
= out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
......
......@@ -622,6 +622,8 @@ data ModIface
mi_module :: !Module, -- ^ Name of the module we are for
mi_iface_hash :: !Fingerprint, -- ^ Hash of the whole interface
mi_mod_hash :: !Fingerprint, -- ^ Hash of the ABI only
mi_flag_hash :: !Fingerprint, -- ^ Hash of the important flags
-- used when compiling this module
mi_orphan :: !WhetherHasOrphans, -- ^ Whether this module has orphans
mi_finsts :: !WhetherHasFamInst, -- ^ Whether this module has family instances
......@@ -732,6 +734,7 @@ emptyModIface mod
= ModIface { mi_module = mod,
mi_iface_hash = fingerprint0,
mi_mod_hash = fingerprint0,
mi_flag_hash = fingerprint0,
mi_orphan = False,
mi_finsts = False,
mi_boot = False,
......@@ -1568,7 +1571,7 @@ data Dependencies
-- instances are from the home or an external package)
}
deriving( Eq )
-- Equality used only for old/new comparison in MkIface.addVersionInfo
-- Equality used only for old/new comparison in MkIface.addFingerprints
-- See 'TcRnTypes.ImportAvails' for details on dependencies.
noDependencies :: Dependencies
......
......@@ -447,20 +447,30 @@ instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where
instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where
put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d
get bh = do a <- get bh
b <- get bh
c <- get bh
d <- get bh
return (a,b,c,d)
get bh = do a <- get bh
b <- get bh
c <- get bh
d <- get bh
return (a,b,c,d)
instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d, e) where
put_ bh (a,b,c,d, e) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e;
get bh = do a <- get bh
b <- get bh
c <- get bh
d <- get bh
e <- get bh
return (a,b,c,d,e)
get bh = do a <- get bh
b <- get bh
c <- get bh
d <- get bh
e <- get bh
return (a,b,c,d,e)
instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a,b,c,d, e, f) where
put_ bh (a,b,c,d, e, f) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f;
get bh = do a <- get bh
b <- get bh
c <- get bh
d <- get bh
e <- get bh
f <- get bh
return (a,b,c,d,e,f)
instance Binary a => Binary (Maybe a) where
put_ bh Nothing = putByte bh 0
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment