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 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(v_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(v_HomeDirCache,   Nothing,  Maybe (FiniteMap String FilePath))
  45
  46
  47 newFinder :: PackageConfigInfo -> IO Finder
  48 newFinder (PackageConfigInfo pkgs) = do
  49   -- expunge our home cache
  50   writeIORef v_HomeDirCache Nothing
  51
  52   -- populate the package cache, if necessary
  53   pkg_cache <- readIORef v_PkgDirCache
  54   case pkg_cache of
  55     Nothing -> do
  56
  57         let extendFM fm pkg = do
  58                 let dirs = import_dirs pkg
  59                     pkg_name = _PK_ (name pkg)
  60                 let addDir fm dir = do
  61                         contents <- getDirectoryContents' dir
  62                         return (addListToFM fm (zip contents
  63                                                    (repeat (pkg_name,dir))))
  64                 foldM addDir fm dirs
  65
  66         pkg_map <- foldM extendFM emptyFM pkgs
  67         writeIORef v_PkgDirCache (Just pkg_map)
  68
  69     Just _ ->
  70         return ()
  71
  72   -- and return the finder
  73   return finder
  74
  75
  76 finder :: ModuleName -> IO (Maybe (Module, ModuleLocation))
  77 finder name = do
  78   j <- maybeHomeModule name
  79   case j of
  80         Just home_module -> return (Just home_module)
  81         Nothing -> maybePackageModule name
  82
  83 maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
  84 maybeHomeModule mod_name = do
  85    home_cache <- readIORef v_HomeDirCache
  86
  87    home_map <-
  88      case home_cache of
  89         Nothing -> do
  90            -- populate the home dir cache, using the import path (the import
  91            -- path is changed by -i flags on the command line, and defaults
  92            -- to ["."]).
  93            home_imports <- readIORef v_Import_paths
  94            let extendFM fm path = do
  95                    contents <- getDirectoryContents' path
  96                    return (addListToFM fm (zip contents (repeat path)))
  97            home_map <- foldM extendFM emptyFM home_imports
  98            writeIORef v_HomeDirCache (Just home_map)
  99            return home_map
 100
 101         Just home_map -> return home_map
 102
 103    let basename = moduleNameString mod_name
 104        hs  = basename ++ ".hs"
 105        lhs = basename ++ ".lhs"
 106
 107    case lookupFM home_map hs of {
 108         Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) hs;
 109         Nothing ->
 110
 111    case lookupFM home_map lhs of {
 112         Just path ->  mkHomeModuleLocn mod_name (path ++ '/':basename) lhs;
 113         Nothing -> return Nothing
 114
 115    }}
 116
 117 mkHomeModuleLocn mod_name basename source_fn = do
 118
 119    -- figure out the .hi file name: it lives in the same dir as the
 120    -- source, unless there's a -ohi flag on the command line.
 121    ohi    <- readIORef v_Output_hi
 122    hisuf  <- readIORef v_Hi_suf
 123    let hifile = case ohi of
 124                    Nothing -> basename ++ '.':hisuf
 125                    Just fn -> fn
 126
 127    -- figure out the .o file name.  It also lives in the same dir
 128    -- as the source, but can be overriden by a -odir flag.
 129    o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
 130
 131    return (Just (mkHomeModule mod_name,
 132                  ModuleLocation{
 133                     hs_file  = source_fn,
 134                     hi_file  = hifile,
 135                     obj_file = o_file
 136                  }
 137         ))
 138
 139 maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 140 maybePackageModule mod_name = do
 141   maybe_pkg_cache <- readIORef v_PkgDirCache
 142   case maybe_pkg_cache of {
 143      Nothing -> panic "maybePackageModule: no pkg_cache";
 144      Just pkg_cache -> do
 145
 146   -- hi-suffix for packages depends on the build tag.
 147   package_hisuf <-
 148         do tag <- readIORef v_Build_tag
 149            if null tag
 150                 then return "hi"
 151                 else return (tag ++ "_hi")
 152
 153   let basename = moduleNameString mod_name
 154       hi  = basename ++ '.':package_hisuf
 155
 156   case lookupFM pkg_cache hi of
 157         Nothing -> return Nothing
 158         Just (pkg_name,path) ->
 159             return (Just (mkModule mod_name pkg_name,
 160                           ModuleLocation{
 161                                 hs_file  = error "package module; no source",
 162                                 hi_file  = hi,
 163                                 obj_file = error "package module; no object"
 164                            }
 165                    ))
 166
 167    }
 168
 169 getDirectoryContents' d
 170    = IO.catch (getDirectoryContents d)
 171           (\_ -> do hPutStr stderr
 172                           ("WARNING: error while reading directory " ++ d)
 173                     return []
 174           )
 175
 176 \end{code}