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     newFinder,          -- :: PackageConfigInfo -> IO (),
   9     findModule,         -- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
  10     ModuleLocation(..),
  11     mkHomeModuleLocn,
  12   ) where
  13
  14 #include "HsVersions.h"
  15
  16 import HscTypes         ( 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,    error "no pkg cache!",  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 ()
  47 newFinder (PackageConfigInfo pkgs) = do
  48   -- expunge our home cache
  49   writeIORef v_HomeDirCache Nothing
  50
  51   -- lazilly fill in the package cache
  52   writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
  53
  54
  55 findModule :: [Package] -> ModuleName -> IO (Maybe (Module, ModuleLocation))
  56 findModule pkgs name = do
  57   j <- maybeHomeModule name
  58   case j of
  59         Just home_module -> return (Just home_module)
  60         Nothing -> maybePackageModule 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
 119 newPkgCache :: [Package] -> IO (FiniteMap String (PackageName, FilePath))
 120 newPkgCache pkgs = do
 121     let extendFM fm pkg = do
 122             let dirs = import_dirs pkg
 123                 pkg_name = _PK_ (name pkg)
 124             let addDir fm dir = do
 125                     contents <- getDirectoryContents' dir
 126                     return (addListToFM fm (zip contents
 127                                                (repeat (pkg_name,dir))))
 128             foldM addDir fm dirs
 129
 130     pkg_map <- foldM extendFM emptyFM pkgs
 131     return pkg_map
 132
 133
 134 maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 135 maybePackageModule mod_name = do
 136   pkg_cache <- readIORef v_PkgDirCache
 137
 138   -- hi-suffix for packages depends on the build tag.
 139   package_hisuf <-
 140         do tag <- readIORef v_Build_tag
 141            if null tag
 142                 then return "hi"
 143                 else return (tag ++ "_hi")
 144
 145   let basename = moduleNameString mod_name
 146       hi = basename ++ '.':package_hisuf
 147
 148   case lookupFM pkg_cache hi of
 149         Nothing -> return Nothing
 150         Just (pkg_name,path) ->
 151             return (Just (mkModule mod_name pkg_name,
 152                           ModuleLocation{
 153                                 hs_file  = error "package module; no source",
 154                                 hi_file  = hi,
 155                                 obj_file = error "package module; no object"
 156                            }
 157                    ))
 158
 159 getDirectoryContents' d
 160    = IO.catch (getDirectoryContents d)
 161           (\_ -> do hPutStr stderr
 162                           ("WARNING: error while reading directory " ++ d)
 163                     return []
 164           )
 165
 166 \end{code}