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