New recompilation avoidance scheme is broken
The recompilation avoidance scheme introduced in the driver refactor (25977ab5, !5661 (merged)) is quite broken.
-- | Find object files corresponding to the transitive closure of given home
-- modules and direct object files for pkg dependencies
mkObjectUsage :: PackageIfaceTable -> HscEnv -> ModuleNameWithIsBoot -> IO [Usage]
mkObjectUsage pit hsc_env mnwib = do
case hsc_interp hsc_env of
Just interp -> do
mps <- getLoaderState interp
case mps of
Just ps -> do
let ls = fromMaybe [] $ Map.lookup mnwib (module_deps ps)
ds = hs_objs_loaded ps
concat <$> sequence (map linkableToUsage ls ++ map librarySpecToUsage ds)
Nothing -> return []
Nothing -> return []
In particular, it records the hashes of all the objects that appear in the LoaderState
at the time the Usages
for the module is calculated.
This captures a lot of spurious dependencies:
- If a module doesn't use any splices, then we don't need to depend on any of the object code for its dependencies
- The object files for libraries that were loaded at any point previously (maybe due to other modules) are marked as dependencies due to
hs_objs_loaded
This is not correct - we need to track package dependencies per module also -
module_deps
can also contain spurious elements. If GHCi is being used, thenmodule_deps
will contain all the linkables needed by any expression in the module. However, we only want to track the linkables needed by splice expressions.
In addition to this, adding object file hashes to the interface file breaks interface file determinism. We should only record object file hashes if TH splices (or plugins) were used, since it is very hard to guarantee interface file determinism in the presence of those anyway.
Here is a small program demonstrating some of the issues:
{-# LANGUAGE TemplateHaskell #-}
module A where
x = $([| True |])
module A1 where
import A
$ ghc A1.hs
[1 of 2] Compiling A ( A.hs, A.o )
[2 of 2] Compiling A1 ( A1.hs, A1.o )
$ ghc --show-iface A1.hi | grep addDependentFile
addDependentFile "/home/zubin/ghc/_build_devel2/stage1/lib/../lib/x86_64-linux-ghc-9.3.20211011/ghc-boot-th-9.3/HSghc-boot-th-9.3.o" 6df4b8028fd47cd291fea78438a8250b
addDependentFile "/home/zubin/ghc/_build_devel2/stage1/lib/../lib/x86_64-linux-ghc-9.3.20211011/template-haskell-2.18.0.0/HStemplate-haskell-2.18.0.0.o" da4fd244da67d45d8e94a312ac792aaf
addDependentFile "/home/zubin/ghc/_build_devel2/stage1/lib/../lib/x86_64-linux-ghc-9.3.20211011/pretty-1.1.3.6/HSpretty-1.1.3.6.o" 9670d3caeb961caf44e1ac46788079b1
addDependentFile "/home/zubin/ghc/_build_devel2/stage1/lib/../lib/x86_64-linux-ghc-9.3.20211011/deepseq-1.4.4.0/HSdeepseq-1.4.4.0.o" 0aac1c4af6e53e59b3f75af35bd4aab0
addDependentFile "/home/zubin/ghc/_build_devel2/stage1/lib/../lib/x86_64-linux-ghc-9.3.20211011/array-0.5.4.0/HSarray-0.5.4.0.o" a3a8757cd570e6f05c6f199e690cb024
addDependentFile "/home/zubin/ghc/_build_devel2/stage1/lib/../lib/x86_64-linux-ghc-9.3.20211011/base-4.16.0.0/HSbase-4.16.0.0.o" 02b5d686cb9c79360c6e0f0dad4f774c
addDependentFile "/home/zubin/ghc/_build_devel2/stage1/lib/../lib/x86_64-linux-ghc-9.3.20211011/ghc-bignum-1.2/HSghc-bignum-1.2.o" 7760f8c24acb1873f013b367e1ab6e07
addDependentFile "/home/zubin/ghc/_build_devel2/stage1/lib/../lib/x86_64-linux-ghc-9.3.20211011/ghc-prim-0.8.0/HSghc-prim-0.8.0.o" 9fa874d534ef0fad8ea8cca54ffbdaf1
$ rm A1.hi
$ ghc A1.hs
[2 of 2] Compiling A1 ( A1.hs, A1.o )
$ ghc --show-iface A1.hi | grep addDependentFile
$ echo $? # no matches
1
Edited by Zubin