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