on master help sign in
Faster dependency chasing
778bd17Edwin Brady
src/Idris/Chaser.hs+48−22
@@ -23,6 +23,7 @@ import Idris.Unlit
23import Control.Monad.State
23import Control.Monad.State
24import Data.List
24import Data.List
25import qualified Data.Set as S
25import qualified Data.Set as S
26+import qualified Data.Map as M
26import Data.Time.Clock
27import Data.Time.Clock
27import System.Directory
28import System.Directory
28import Util.System (readSource)
29import Util.System (readSource)
@@ -37,8 +38,7 @@ latest :: UTCTime -> [IFileType] -> [ModuleTree] -> UTCTime
37latest tm done [] = tm
38latest tm done [] = tm
38latest tm done (m : ms)
39latest tm done (m : ms)
39 | mod_path m `elem` done = latest tm done ms
40 | mod_path m `elem` done = latest tm done ms
40− | otherwise = latest (max tm (mod_time m)) (mod_path m : done)
41+ | otherwise = latest (max tm (mod_time m)) (mod_path m : done) ms
41− (ms ++ mod_deps m)
42
42
43modName :: IFileType -> String
43modName :: IFileType -> String
44modName (IDR fp) = fp
44modName (IDR fp) = fp
@@ -50,29 +50,51 @@ modName (IBC fp src) = modName src
50-- source, otherwise return the IBC
50-- source, otherwise return the IBC
51getModuleFiles :: [ModuleTree] -> [IFileType]
51getModuleFiles :: [ModuleTree] -> [IFileType]
52getModuleFiles ts
52getModuleFiles ts
53− = let (files, rebuild) = execState (modList ts) ([], S.empty) in
53+ = let (files, (rebuild, _)) = runState (modList ts) (S.empty, M.empty) in
54− updateToSrc rebuild (nub files)
54+ updateToSrc rebuild (reverse files)
55 where
55 where
56 -- Get the order of building modules. As we go we'll find things that
56 -- Get the order of building modules. As we go we'll find things that
57 -- need rebuilding, which we keep track of in the Set.
57 -- 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
59 -- in the list first. We'll remove any repetition later.
59 -- in the list first. We'll remove any repetition later.
60+ modList :: [ModuleTree] ->
60− modList :: [ModuleTree] -> State ([IFileType], S.Set IFileType) ()
61+ State (S.Set IFileType,
62+ M.Map IFileType (Bool, [IFileType])) [IFileType]
61− modList [] = return ()
63+ modList [] = return []
62− modList (m : ms) = do modTree S.empty m; modList ms
64+ modList (m : ms) = do (_, fs) <- modTree S.empty m
63−
65+ fs' <- modList ms
66+ pure (fs ++ fs')
67+
64− modTree path (MTree p rechk tm deps)
68+ modTree path m@(MTree p rechk tm deps)
65 = do let file = chkReload rechk p
69 = do let file = chkReload rechk p
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+
66− -- Needs rechecking if 'rechk' is true, or if any of the
80+ -- Needs rechecking if 'rechk' is true, or if any of the
67− -- modification times in 'deps' are later than tm
81+ -- modification times in 'deps' are later than tm, or
82+ -- if any dependency needed rechecking
68− let depMod = latest tm [] deps
83+ let depMod = latest tm [] deps
69− let needsRechk = rechk || depMod > tm
84+ let needsRechk = rechkDep || rechk || depMod > tm
70−
85+
71− (st, rebuild) <- get
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
72− if needsRechk then put $ (getSrc file : st, S.union path rebuild)
95+ then S.union path rebuild
73− else put $ (file : st, rebuild)
96+ else rebuild, M.insert file ret res)
74− (st, rebuild) <- get
97+ pure ret
75− mapM_ (modTree (S.insert (getSrc p) path)) deps
76
98
77 chkReload False p = p
99 chkReload False p = p
78 chkReload True (IBC fn src) = chkReload True src
100 chkReload True (IBC fn src) = chkReload True src
@@ -182,8 +204,12 @@ buildTree built importlists fp = evalStateT (btree [] fp) []
182 do [MTree _ _ _ ms'] <- mkChildren file src
204 do [MTree _ _ _ ms'] <- mkChildren file src
183 return ms'
205 return ms'
184 else return []
206 else return []
185− mt <- lift $ idrisCatch (runIO $ getModificationTime fn)
207+ -- Modification time is the later of the source/ibc modification time
186− (\c -> runIO $ getIModTime src)
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)
187 -- FIXME: It's also not up to date if anything it imports has
213 -- FIXME: It's also not up to date if anything it imports has
188 -- been modified since its own ibc has.
214 -- been modified since its own ibc has.
189 --
215 --
src/Idris/Imports.hs+7−1
@@ -24,7 +24,13 @@ import System.Directory
24import System.FilePath
24import System.FilePath
25
25
26data IFileType = IDR FilePath | LIDR FilePath | IBC FilePath IFileType
26data 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
28
34
29newtype PkgName = PkgName String
35newtype PkgName = PkgName String
30
36