From: David Cock <david.cock@inf.ethz.ch>
Date: Mon, 24 Aug 2015 08:13:29 +0000 (+0200)
Subject: Keep directory lists sorted
X-Git-Tag: release2015-09-03~32
X-Git-Url: http://git.barrelfish.org/?p=barrelfish;a=commitdiff_plain;h=f87cb6113a2393a95b0ff0cae4e4045650f84437

Keep directory lists sorted
---

diff --git a/hake/RuleDefs.hs b/hake/RuleDefs.hs
index 92fcfd7..071889d 100644
--- a/hake/RuleDefs.hs
+++ b/hake/RuleDefs.hs
@@ -52,7 +52,8 @@ withSuffix srcDB hakepath extension =
 
 withSuffices :: TreeDB -> String -> [String] -> [String]
 withSuffices srcDB hakepath extensions =
-    concat [ withSuffix srcDB hakepath ext | ext <- extensions ]
+    map (\f -> "/" </> f) $
+        fromMaybe [] $ tdbByDirExts (takeDirectory hakepath) extensions srcDB
 
 --
 -- Find files with a given suffix in a given dir
diff --git a/hake/TreeDB.hs b/hake/TreeDB.hs
index d1ca526..1114123 100644
--- a/hake/TreeDB.hs
+++ b/hake/TreeDB.hs
@@ -1,16 +1,17 @@
 module TreeDB(
     DirList,
-    dlEmpty, dlByExt, dlAdd, dlAddByExt,
+    dlEmpty, dlByExt, dlByExts, dlAdd, dlAddByExt,
 
     TreeDB,
     tdbEmpty, tdbByDir, tdbAdd, tdbAddDir,
     tdbBuild,
 
-    tdbByDirExt
+    tdbByDirExt, tdbByDirExts
     )
 where
 
 import qualified Data.ByteString.Char8 as C
+import Data.List
 import Data.Trie(Trie)
 import qualified Data.Trie as T
 import Data.Typeable
@@ -29,19 +30,36 @@ dlEmpty = []
 dlByExt :: String -> DirList -> [String]
 dlByExt _ [] = []
 dlByExt ext ((ext', names) : dirlist)
-    | ext == ext' = names
+    | ext' == ext = [n <.> ext' | n <- names]
     | otherwise = dlByExt ext dirlist
 
+-- Search for multiple extensions at once.  'exts' must be sorted, with no
+-- duplicates.
+dlByExts :: [String] -> DirList -> [String]
+dlByExts _ [] = []
+dlByExts [] _ = []
+dlByExts (ext:exts) ((ext', names):dirlist) =
+    case compare ext ext' of
+        -- 'ext' isn't in the list.
+        LT -> dlByExts exts ((ext', names):dirlist)
+        -- 'ext' is right here.
+        EQ -> [n <.> ext' | n <- names] ++ dlByExts exts dirlist
+        -- 'ext' may be in the remainder.  Nothing else can match here.
+        GT -> dlByExts (ext:exts) dirlist
+
 -- Insert a file, given its extension.  Again linear.
 dlAdd :: FilePath -> DirList -> DirList
 dlAdd file dirList =
     dlAddByExt (takeExtension file) (dropExtension file) dirList
 
+-- Keeps the list sorted by extension
 dlAddByExt ::  String -> String -> DirList -> DirList
 dlAddByExt ext name [] = [(ext, [name])]
-dlAddByExt ext name ((ext', names):dirlist)
-    | ext == ext' = (ext', name:names):dirlist
-    | otherwise = (ext', names):(dlAddByExt ext name dirlist)
+dlAddByExt ext name ((ext', names):dirlist) =
+    case compare ext ext' of
+        LT -> (ext, [name]):(ext', names):dirlist
+        EQ -> (ext', name:names):dirlist
+        GT -> (ext', names):(dlAddByExt ext name dirlist)
 
 --
 -- A map from directory to contents, excluding subdirectories.
@@ -90,5 +108,12 @@ tdbBuild files = foldr tdbAdd tdbEmpty files
 tdbByDirExt :: FilePath -> String -> TreeDB -> Maybe [FilePath]
 tdbByDirExt path ext treeDB = do
     dirList <- tdbByDir path treeDB
-    let basenames = dlByExt ext dirList
-    return [ path </> base <.> ext | base <- basenames ]
+    let filenames = dlByExt ext dirList
+    return [ path </> file | file <- filenames ]
+
+-- Look for multiple extensions.  'exts' need not be sorted.
+tdbByDirExts :: FilePath -> [String] -> TreeDB -> Maybe [FilePath]
+tdbByDirExts path exts treeDB = do
+    dirList <- tdbByDir path treeDB
+    let filenames = dlByExts (sort exts) dirList
+    return [ path </> file | file <- filenames ]