[project @ 2000-11-17 13:33:17 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / Finder.lhs
index 732047b..5431719 100644 (file)
@@ -20,6 +20,7 @@ import Module
 import FiniteMap
 import Util
 import Panic           ( panic )
+import Config
 
 import IOExts
 import Directory
@@ -51,10 +52,6 @@ initFinder pkgs
        ; 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 ()
@@ -63,16 +60,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)
@@ -100,19 +87,40 @@ 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;
+       Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) 
+                                               (path ++ '/':hs);
        Nothing ->
 
    case lookupFM home_map lhs of {
-       Just path ->  mkHomeModuleLocn mod_name (path ++ '/':basename) lhs;
-       Nothing -> return Nothing
+       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)
+                                                (path ++ '/':hs);
+       Nothing -> do
+
+   -- 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_ver of {
+       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
+   }}}}}
 
 mkHomeModuleLocn mod_name basename source_fn = do