ghc/compiler/main/Finder.lhs

   1 %
   2 % (c) The University of Glasgow, 2000
   3 %
   4 \section[Finder]{Module Finder}
   5
   6 \begin{code}
   7 module Finder (
   8     Finder,             -- =  ModuleName -> IO (Maybe (Module, ModuleLocation))
   9     newFinder,          -- :: PackageConfigInfo -> IO Finder,
  10     ModuleLocation(..)
  11   ) where
  12
  13 #include "HsVersions.h"
  14
  15 import CmStaticInfo
  16 import DriverPhases
  17 import DriverState
  18 import Module
  19 import FiniteMap
  20 import Util
  21 import Panic
  22
  23 import IOExts
  24 import Directory
  25 import List
  26 import IO
  27 import Monad
  28 \end{code}
  29
  30 \begin{code}
  31 type Finder = ModuleName -> IO (Maybe (Module, ModuleLocation))
  32
  33 data ModuleLocation
  34    = ModuleLocation {
  35         hs_file  :: FilePath,
  36         hi_file  :: FilePath,
  37         obj_file :: FilePath
  38       }
  39
  40 -- caches contents of package directories, never expunged
  41 GLOBAL_VAR(pkgDirCache,    Nothing,  Maybe (FiniteMap String (PackageName, FilePath)))
  42
  43 -- caches contents of home directories, expunged whenever we
  44 -- create a new finder.
  45 GLOBAL_VAR(homeDirCache,   emptyFM,  FiniteMap String FilePath)
  46
  47 -- caches finder mapping, expunged whenever we create a new finder.
  48 GLOBAL_VAR(finderMapCache, emptyFM, FiniteMap ModuleName Module)
  49
  50
  51 newFinder :: PackageConfigInfo -> IO Finder
  52 newFinder (PackageConfigInfo pkgs) = do
  53   -- expunge our caches
  54   writeIORef homeDirCache   emptyFM
  55   writeIORef finderMapCache emptyFM
  56
  57   -- populate the home dir cache, using the import path (the import path
  58   -- is changed by -i flags on the command line, and defaults to ["."]).
  59   home_imports <- readIORef import_paths
  60   let extendFM fm path = do
  61           contents <- getDirectoryContents' path
  62           return (addListToFM fm (zip contents (repeat path)))
  63   home_map <- foldM extendFM emptyFM home_imports
  64   writeIORef homeDirCache home_map
  65
  66   -- populate the package cache, if necessary
  67   pkg_cache <- readIORef pkgDirCache
  68   case pkg_cache of
  69     Nothing -> do
  70
  71         let extendFM fm pkg = do
  72                 let dirs = import_dirs pkg
  73                     pkg_name = _PK_ (name pkg)
  74                 let addDir fm dir = do
  75                         contents <- getDirectoryContents' dir
  76                         return (addListToFM fm (zip contents
  77                                                    (repeat (pkg_name,dir))))
  78                 foldM addDir fm dirs
  79
  80         pkg_map <- foldM extendFM emptyFM pkgs
  81         writeIORef pkgDirCache (Just pkg_map)
  82
  83     Just _ ->
  84         return ()
  85
  86   -- and return the finder
  87   return finder
  88
  89
  90 finder :: ModuleName -> IO (Maybe (Module, ModuleLocation))
  91 finder name = do
  92   j <- maybeHomeModule name
  93   case j of
  94         Just home_module -> return (Just home_module)
  95         Nothing -> maybePackageModule name
  96
  97 maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
  98 maybeHomeModule mod_name = do
  99    home_cache <- readIORef homeDirCache
 100
 101    let basename = moduleNameString mod_name
 102        hs  = basename ++ ".hs"
 103        lhs = basename ++ ".lhs"
 104
 105    case lookupFM home_cache hs of {
 106         Just path -> mkHomeModuleLocn mod_name basename path hs;
 107         Nothing ->
 108
 109    case lookupFM home_cache lhs of {
 110         Just path ->  mkHomeModuleLocn mod_name basename path lhs;
 111         Nothing -> return Nothing
 112
 113    }}
 114
 115 mkHomeModuleLocn mod_name basename path source_fn = do
 116
 117    -- figure out the .hi file name: it lives in the same dir as the
 118    -- source, unless there's a -ohi flag on the command line.
 119    ohi    <- readIORef output_hi
 120    hisuf  <- readIORef hi_suf
 121    let hifile = case ohi of
 122                    Nothing -> path ++ '/':basename ++ hisuf
 123                    Just fn -> fn
 124
 125    -- figure out the .o file name.  It also lives in the same dir
 126    -- as the source, but can be overriden by a -odir flag.
 127    o_file <- odir_ify (path ++ '/':basename ++ '.':phaseInputExt Ln)
 128
 129    return (Just (mkHomeModule mod_name,
 130                  ModuleLocation{
 131                     hs_file  = source_fn,
 132                     hi_file  = hifile,
 133                     obj_file = o_file
 134                  }
 135         ))
 136
 137 maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 138 maybePackageModule mod_name = do
 139   maybe_pkg_cache <- readIORef pkgDirCache
 140   case maybe_pkg_cache of {
 141      Nothing -> panic "maybePackageModule: no pkg_cache";
 142      Just pkg_cache -> do
 143
 144   -- hi-suffix for packages depends on the build tag.
 145   package_hisuf <-
 146         do tag <- readIORef build_tag
 147            if null tag
 148                 then return "hi"
 149                 else return (tag ++ "_hi")
 150
 151   let basename = moduleNameString mod_name
 152       hi  = basename ++ '.':package_hisuf
 153
 154   case lookupFM pkg_cache hi of
 155         Nothing -> return Nothing
 156         Just (pkg_name,path) ->
 157             return (Just (mkModule mod_name pkg_name,
 158                           ModuleLocation{
 159                                 hs_file  = error "package module; no source",
 160                                 hi_file  = hi,
 161                                 obj_file = error "package module; no object"
 162                            }
 163                    ))
 164
 165    }
 166
 167 getDirectoryContents' d
 168    = IO.catch (getDirectoryContents d)
 169           (\_ -> do hPutStr stderr
 170                           ("WARNING: error while reading directory " ++ d)
 171                     return []
 172           )
 173
 174 \end{code}