X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=4e4844d46005fa41ddf1c526d0498bceb78be1b9;hb=50027272414438955dbc41696541cbd25da55883;hp=c833bf6c11399841c7f126375020e075e5105bd2;hpb=6e1433a6d80682401b04acde47f3440f00da1aa3;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs
index c833bf6..4e4844d 100644
--- a/ghc/compiler/main/Finder.lhs
+++ b/ghc/compiler/main/Finder.lhs
@@ -5,8 +5,10 @@
 
 \begin{code}
 module Finder (
-    initFinder, 	-- :: PackageConfigInfo -> IO (), 
+    initFinder, 	-- :: [PackageConfig] -> IO (), 
     findModule,		-- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
+    mkHomeModuleLocn,	-- :: ModuleName -> String -> FilePath 
+			--	-> IO ModuleLocation
     emptyHomeDirCache	-- :: IO ()
   ) where
 
@@ -16,6 +18,7 @@ import HscTypes		( ModuleLocation(..) )
 import CmStaticInfo
 import DriverPhases
 import DriverState
+import DriverUtil
 import Module
 import FiniteMap
 import Util
@@ -27,7 +30,7 @@ import Directory
 import List
 import IO
 import Monad
-import Outputable	( showSDoc, ppr )	-- debugging only
+import Outputable
 \end{code}
 
 The Finder provides a thin filesystem abstraction to the rest of the
@@ -46,16 +49,12 @@ GLOBAL_VAR(v_PkgDirCache, panic "no pkg cache!",
 GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath))
 
 
-initFinder :: PackageConfigInfo -> IO ()
+initFinder :: [PackageConfig] -> IO ()
 initFinder pkgs 
   = do	{	-- expunge our home cache
 	; writeIORef v_HomeDirCache Nothing
 		-- lazilly fill in the package cache
 	; writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
-	
--- Debug output
---	; pkg_dbg_info <- readIORef v_PkgDirCache
---	; putStrLn (unlines (map show (fmToList pkg_dbg_info)))
 	}
 
 emptyHomeDirCache :: IO ()
@@ -64,16 +63,6 @@ emptyHomeDirCache
 
 findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 findModule name
-  = do 	{ hPutStr stderr ("findModule: " ++ moduleNameUserString name ++ " ... ")
-	; maybe_m <- findModule_wrk name
-	; case maybe_m of
-	     Nothing -> hPutStrLn stderr "Not Found"
-	     Just mm -> hPutStrLn stderr (showSDoc (ppr (snd mm)))
-	; return maybe_m
-	}
-
-findModule_wrk :: ModuleName -> IO (Maybe (Module, ModuleLocation))
-findModule_wrk name
   = do	{ j <- maybeHomeModule name
 	; case j of
 	    Just home_module -> return (Just home_module)
@@ -101,36 +90,50 @@ maybeHomeModule mod_name = do
 
         Just home_map -> return home_map
 
-   let basename = moduleNameString mod_name
+   let basename = moduleNameUserString mod_name 
        hs  = basename ++ ".hs"
        lhs = basename ++ ".lhs"
 
    case lookupFM home_map hs of {
-	Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) hs;
+	  -- special case to avoid getting "./foo.hs" all the time
+	Just "."  -> mkHomeModuleLocn mod_name basename hs;
+	Just path -> mkHomeModuleLocn mod_name 
+			(path ++ '/':basename) (path ++ '/':hs);
 	Nothing ->
 
    case lookupFM home_map lhs of {
-	Just path ->  mkHomeModuleLocn mod_name (path ++ '/':basename) lhs;
+	  -- special case to avoid getting "./foo.hs" all the time
+	Just "."  -> mkHomeModuleLocn mod_name basename lhs;
+	Just path ->  mkHomeModuleLocn mod_name
+			(path ++ '/':basename) (path ++ '/':lhs);
 	Nothing -> do
 
    -- can't find a source file anywhere, check for a lone .hi file.
    hisuf <- readIORef v_Hi_suf
    let hi = basename ++ '.':hisuf
    case lookupFM home_map hi of {
-	Just path ->  mkHomeModuleLocn mod_name (path ++ '/':basename) hs;
+	Just path ->  mkHomeModuleLocn mod_name
+			(path ++ '/':basename) (path ++ '/':hs);
 	Nothing -> do
 
-   -- last chance: .hi-boot and .hi-boot-<ver>
+   -- last chance: .hi-boot-<ver> and .hi-boot
    let hi_boot = basename ++ ".hi-boot"
    let hi_boot_ver = basename ++ ".hi-boot-" ++ cHscIfaceFileVersion
-   case lookupFM home_map hi_boot of {
-	Just path ->  mkHomeModuleLocn mod_name (path ++ '/':basename) hs;
-	Nothing -> do
    case lookupFM home_map hi_boot_ver of {
-	Just path ->  mkHomeModuleLocn mod_name (path ++ '/':basename) hs;
+	Just path ->  mkHomeModuleLocn mod_name
+			(path ++ '/':basename) (path ++ '/':hs);
+	Nothing -> do
+   case lookupFM home_map hi_boot of {
+	Just path ->  mkHomeModuleLocn mod_name 
+			(path ++ '/':basename) (path ++ '/':hs);
 	Nothing -> return Nothing
    }}}}}
 
+
+-- The .hi file always follows the module name, whereas the object
+-- file may follow the name of the source file in the case where the
+-- two differ (see summariseFile in compMan/CompManager.lhs).
+
 mkHomeModuleLocn mod_name basename source_fn = do
 
    -- figure out the .hi file name: it lives in the same dir as the
@@ -138,7 +141,9 @@ mkHomeModuleLocn mod_name basename source_fn = do
    ohi    <- readIORef v_Output_hi
    hisuf  <- readIORef v_Hi_suf
    let hifile = case ohi of
-		   Nothing -> basename ++ '.':hisuf
+		   Nothing -> getdir basename 
+				++ '/':moduleNameUserString mod_name 
+				++ '.':hisuf
 		   Just fn -> fn
 
    -- figure out the .o file name.  It also lives in the same dir
@@ -155,15 +160,14 @@ mkHomeModuleLocn mod_name basename source_fn = do
 	))
 
 
-newPkgCache :: [Package] -> IO (FiniteMap String (PackageName, FilePath))
+newPkgCache :: [PackageConfig] -> IO (FiniteMap String (PackageName, FilePath))
 newPkgCache pkgs = do
     let extendFM fm pkg = do
     	    let dirs = import_dirs pkg
     		pkg_name = _PK_ (name pkg)
     	    let addDir fm dir = do
     		    contents <- getDirectoryContents' dir
-		    let clean_contents = filter isUsefulFile contents
-    		    return (addListToFM fm (zip clean_contents 
+    		    return (addListToFM fm (zip contents 
     					       (repeat (pkg_name,dir))))
     	    foldM addDir fm dirs
     
@@ -182,7 +186,7 @@ maybePackageModule mod_name = do
 		then return "hi"
 		else return (tag ++ "_hi")
 
-  let basename = moduleNameString mod_name
+  let basename = moduleNameUserString mod_name
       hi = basename ++ '.':package_hisuf
 
   case lookupFM pkg_cache hi of
@@ -207,5 +211,5 @@ getDirectoryContents' d
 		          ("WARNING: error while reading directory " ++ d)
 		    return []
 	  )
-	 
+
 \end{code}