[project @ 2000-10-27 11:51:13 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / Finder.lhs

diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs
index f49018c..b92848a 100644 (file)
--- a/ghc/compiler/main/Finder.lhs
+++ b/ghc/compiler/main/Finder.lhs
@@ -5,22 +5,19 @@
 
 \begin{code}
 module Finder (
-    Finder,            -- =  ModuleName -> IO (Maybe (Module, ModuleLocation))
-    newFinder,                 -- :: PackageConfigInfo -> IO Finder, 
-    ModuleLocation(..),
-    mkHomeModuleLocn
+    initFinder,        -- :: PackageConfigInfo -> IO (), 
+    findModule         -- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
   ) where
 
 #include "HsVersions.h"
 
-import HscTypes                ( Finder, ModuleLocation(..) )
+import HscTypes                ( ModuleLocation(..) )
 import CmStaticInfo
 import DriverPhases
 import DriverState
 import Module
 import FiniteMap
 import Util
-import Panic
 
 import IOExts
 import Directory
@@ -37,44 +34,24 @@ source, interface, and object files for a module live.
 \begin{code}
 
 -- caches contents of package directories, never expunged
-GLOBAL_VAR(v_PkgDirCache,    Nothing,  Maybe (FiniteMap String (PackageName, FilePath)))
+GLOBAL_VAR(v_PkgDirCache,    error "no pkg cache!",  FiniteMap String (PackageName, FilePath))
 
 -- caches contents of home directories, expunged whenever we
 -- create a new finder.
 GLOBAL_VAR(v_HomeDirCache,   Nothing,  Maybe (FiniteMap String FilePath))
 
 
-newFinder :: PackageConfigInfo -> IO Finder
-newFinder (PackageConfigInfo pkgs) = do
+initFinder :: PackageConfigInfo -> IO ()
+initFinder (PackageConfigInfo pkgs) = do
   -- expunge our home cache
   writeIORef v_HomeDirCache Nothing
 
-  -- populate the package cache, if necessary
-  pkg_cache <- readIORef v_PkgDirCache
-  case pkg_cache of 
-    Nothing -> do
-
-       let extendFM fm pkg = do
-               let dirs = import_dirs pkg
-                   pkg_name = _PK_ (name pkg)
-               let addDir fm dir = do
-                       contents <- getDirectoryContents' dir
-                       return (addListToFM fm (zip contents 
-                                                  (repeat (pkg_name,dir))))
-                foldM addDir fm dirs
-
-       pkg_map <- foldM extendFM emptyFM pkgs
-       writeIORef v_PkgDirCache (Just pkg_map)
-
-    Just _ -> 
-        return ()
-
-  -- and return the finder
-  return finder
+  -- lazilly fill in the package cache
+  writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
 
   
-finder :: ModuleName -> IO (Maybe (Module, ModuleLocation))
-finder name = do
+findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
+findModule name = do
   j <- maybeHomeModule name
   case j of
        Just home_module -> return (Just home_module)
@@ -136,12 +113,25 @@ mkHomeModuleLocn mod_name basename source_fn = do
                 }
        ))
 
+
+newPkgCache :: [Package] -> 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
+                   return (addListToFM fm (zip contents 
+                                              (repeat (pkg_name,dir))))
+           foldM addDir fm dirs
+    
+    pkg_map <- foldM extendFM emptyFM pkgs
+    return pkg_map
+
+
 maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 maybePackageModule mod_name = do
-  maybe_pkg_cache <- readIORef v_PkgDirCache
-  case maybe_pkg_cache of {
-     Nothing -> panic "maybePackageModule: no pkg_cache";
-     Just pkg_cache -> do
+  pkg_cache <- readIORef v_PkgDirCache
 
   -- hi-suffix for packages depends on the build tag.
   package_hisuf <-
@@ -151,7 +141,7 @@ maybePackageModule mod_name = do
                else return (tag ++ "_hi")
 
   let basename = moduleNameString mod_name
-      hi  = basename ++ '.':package_hisuf
+      hi = basename ++ '.':package_hisuf
 
   case lookupFM pkg_cache hi of
        Nothing -> return Nothing
@@ -164,8 +154,6 @@ maybePackageModule mod_name = do
                           }
                   ))
 
-   }
-
 getDirectoryContents' d
    = IO.catch (getDirectoryContents d)
          (\_ -> do hPutStr stderr