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