From: sewardj <unknown>
Date: Mon, 30 Oct 2000 11:36:09 +0000 (+0000)
Subject: [project @ 2000-10-30 11:36:09 by sewardj]
X-Git-Tag: Approximately_9120_patches~3466
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6eaf5c6c69483cab51ba2967b75655459fa5cc96;p=ghc-hetmet.git

[project @ 2000-10-30 11:36:09 by sewardj]
Don't be so promiscuous about hoovering up any and all files into the
home/package directory caches.
---

diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs
index c67e0cb..673bdb9 100644
--- a/ghc/compiler/main/Finder.lhs
+++ b/ghc/compiler/main/Finder.lhs
@@ -85,7 +85,8 @@ maybeHomeModule mod_name = do
 	   home_imports <- readIORef v_Import_paths
 	   let extendFM fm path = do
 		   contents <- getDirectoryContents' path
-		   return (addListToFM fm (zip contents (repeat path)))
+                   let clean_contents = filter isUsefulFile contents
+		   return (addListToFM fm (zip clean_contents (repeat path)))
 	   home_map <- foldM extendFM emptyFM home_imports
 	   writeIORef v_HomeDirCache (Just home_map)
 	   return home_map
@@ -136,7 +137,8 @@ newPkgCache pkgs = do
     		pkg_name = _PK_ (name pkg)
     	    let addDir fm dir = do
     		    contents <- getDirectoryContents' dir
-    		    return (addListToFM fm (zip contents 
+		    let clean_contents = filter isUsefulFile contents
+    		    return (addListToFM fm (zip clean_contents 
     					       (repeat (pkg_name,dir))))
     	    foldM addDir fm dirs
     
@@ -169,6 +171,10 @@ maybePackageModule mod_name = do
 			   }
 		   ))
 
+isUsefulFile fn
+   = let suffix = (reverse . takeWhile (/= '.') . reverse) fn
+     in  suffix `elem` ["hi", "hs", "lhs", "hi-boot", "hi-boot-5"]
+
 getDirectoryContents' d
    = IO.catch (getDirectoryContents d)
 	  (\_ -> do hPutStr stderr