on master help sign in
Faster dependency chasing

Caching dependency data rather than recomputing. This is a fairly big win when systems start to grow, though probably not noticeable for small systems. Also fixed a bug where the wrong modification time could be used for a dependency (not sure why this ever worked...)

commit778bd174a5cdc38623d8197599d96be7d23010ab authorEdwin Brady <ecb10@st-andrews.ac.uk> dateWed 25 Apr 2018, 20:15 (8 years ago) parent6408457
2 files changed+55−23
src/Idris/Chaser.hs+48−22 src/Idris/Imports.hs+7−1
src/Idris/Chaser.hs+48−22
@@ -23,6 +23,7 @@ import Idris.Unlit
2323import Control.Monad.State
2424import Data.List
2525import qualified Data.Set as S
26+import qualified Data.Map as M
2627import Data.Time.Clock
2728import System.Directory
2829import Util.System (readSource)
@@ -37,8 +38,7 @@ latest :: UTCTime -> [IFileType] -> [ModuleTree] -> UTCTime
3738latest tm done [] = tm
3839latest tm done (m : ms)
3940 | mod_path m `elem` done = latest tm done ms
40− | otherwise = latest (max tm (mod_time m)) (mod_path m : done)
41− (ms ++ mod_deps m)
41+ | otherwise = latest (max tm (mod_time m)) (mod_path m : done) ms
4242
4343modName :: IFileType -> String
4444modName (IDR fp) = fp
@@ -50,29 +50,51 @@ modName (IBC fp src) = modName src
5050-- source, otherwise return the IBC
5151getModuleFiles :: [ModuleTree] -> [IFileType]
5252getModuleFiles ts
53− = let (files, rebuild) = execState (modList ts) ([], S.empty) in
54− updateToSrc rebuild (nub files)
53+ = let (files, (rebuild, _)) = runState (modList ts) (S.empty, M.empty) in
54+ updateToSrc rebuild (reverse files)
5555 where
5656 -- Get the order of building modules. As we go we'll find things that
5757 -- need rebuilding, which we keep track of in the Set.
58− -- The order of the list matters - things which get build first appear
58+ -- The order of the list matters - things which get built first appear
5959 -- in the list first. We'll remove any repetition later.
60− modList :: [ModuleTree] -> State ([IFileType], S.Set IFileType) ()
61− modList [] = return ()
62− modList (m : ms) = do modTree S.empty m; modList ms
63−
64− modTree path (MTree p rechk tm deps)
60+ modList :: [ModuleTree] ->
61+ State (S.Set IFileType,
62+ M.Map IFileType (Bool, [IFileType])) [IFileType]
63+ modList [] = return []
64+ modList (m : ms) = do (_, fs) <- modTree S.empty m
65+ fs' <- modList ms
66+ pure (fs ++ fs')
67+
68+ modTree path m@(MTree p rechk tm deps)
6569 = do let file = chkReload rechk p
66− -- Needs rechecking if 'rechk' is true, or if any of the
67− -- modification times in 'deps' are later than tm
68− let depMod = latest tm [] deps
69− let needsRechk = rechk || depMod > tm
70−
71− (st, rebuild) <- get
72− if needsRechk then put $ (getSrc file : st, S.union path rebuild)
73− else put $ (file : st, rebuild)
74− (st, rebuild) <- get
75− mapM_ (modTree (S.insert (getSrc p) path)) deps
70+ (rebuild, res) <- get
71+ case M.lookup file res of
72+ Just ms -> pure ms
73+ Nothing -> do
74+ toBuildsAll <- mapM (modTree (S.insert (getSrc p) path)) deps
75+ let (rechkDep_in, toBuilds) = unzip toBuildsAll
76+ let rechkDep = or rechkDep_in
77+
78+ (rebuild, res) <- get
79+
80+ -- Needs rechecking if 'rechk' is true, or if any of the
81+ -- modification times in 'deps' are later than tm, or
82+ -- if any dependency needed rechecking
83+ let depMod = latest tm [] deps
84+ let needsRechk = rechkDep || rechk || depMod > tm
85+
86+ -- Remove duplicates, but keep the last...
87+ let rnub = reverse . nub . reverse
88+
89+ let ret = if needsRechk
90+ then (needsRechk, rnub (getSrc file : concat toBuilds))
91+ else (needsRechk, rnub (file : concat toBuilds))
92+
93+ -- Cache the result
94+ put (if needsRechk
95+ then S.union path rebuild
96+ else rebuild, M.insert file ret res)
97+ pure ret
7698
7799 chkReload False p = p
78100 chkReload True (IBC fn src) = chkReload True src
@@ -182,8 +204,12 @@ buildTree built importlists fp = evalStateT (btree [] fp) []
182204 do [MTree _ _ _ ms'] <- mkChildren file src
183205 return ms'
184206 else return []
185− mt <- lift $ idrisCatch (runIO $ getModificationTime fn)
186− (\c -> runIO $ getIModTime src)
207+ -- Modification time is the later of the source/ibc modification time
208+ smt <- lift $ idrisCatch (runIO $ getIModTime src)
209+ (\c -> runIO $ getModificationTime fn)
210+ mt <- lift $ idrisCatch (do t <- runIO $ getModificationTime fn
211+ return (max smt t))
212+ (\c -> return smt)
187213 -- FIXME: It's also not up to date if anything it imports has
188214 -- been modified since its own ibc has.
189215 --
src/Idris/Imports.hs+7−1
@@ -24,7 +24,13 @@ import System.Directory
2424import System.FilePath
2525
2626data IFileType = IDR FilePath | LIDR FilePath | IBC FilePath IFileType
27− deriving (Show, Ord, Eq)
27+ deriving (Show, Ord)
28+
29+instance Eq IFileType where
30+ IDR x == IDR y = x == y
31+ LIDR x == LIDR y = x == y
32+ IBC x _ == IBC y _ = x == y
33+ _ == _ = False
2834
2935newtype PkgName = PkgName String
3036