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