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,         -- :: [PackageConfig] -> IO (),
   9     findModule,         -- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
  10     mkHomeModuleLocn,   -- :: ModuleName -> String -> Maybe FilePath
  11                         --      -> IO ModuleLocation
  12     emptyHomeDirCache,  -- :: IO ()
  13     flushPackageCache   -- :: [PackageConfig] -> IO ()
  14   ) where
  15
  16 #include "HsVersions.h"
  17
  18 import HscTypes         ( ModuleLocation(..) )
  19 import CmStaticInfo
  20 import DriverPhases
  21 import DriverState
  22 import DriverUtil
  23 import Module
  24 import FiniteMap
  25 import FastString
  26 import Util
  27 import Panic            ( panic )
  28 import Config
  29
  30 import IOExts
  31 import List
  32 import Directory
  33 import IO
  34 import Monad
  35 import Outputable
  36 \end{code}
  37
  38 The Finder provides a thin filesystem abstraction to the rest of the
  39 compiler.  For a given module, it knows (a) which package the module
  40 lives in, so it can make a Module from a ModuleName, and (b) where the
  41 source, interface, and object files for a module live.
  42
  43 \begin{code}
  44 initFinder :: [PackageConfig] -> IO ()
  45 initFinder pkgs = return ()
  46
  47 -- empty, and lazilly fill in the package cache
  48 flushPackageCache :: [PackageConfig] -> IO ()
  49 flushPackageCache pkgs = return ()
  50
  51 emptyHomeDirCache :: IO ()
  52 emptyHomeDirCache = return ()
  53
  54 findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
  55 findModule name
  56   = do  { j <- maybeHomeModule name
  57         ; case j of
  58             Just home_module -> return (Just home_module)
  59             Nothing          -> maybePackageModule name
  60         }
  61
  62 maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
  63 maybeHomeModule mod_name = do
  64    home_path <- readIORef v_Import_paths
  65
  66    let mod_str  = moduleNameUserString mod_name
  67        basename = map (\c -> if c == '.' then '/' else c) mod_str
  68        hs  = basename ++ ".hs"
  69        lhs = basename ++ ".lhs"
  70
  71    found <- findOnPath home_path hs
  72    case found of {
  73           -- special case to avoid getting "./foo.hs" all the time
  74         Just "."  -> mkHomeModuleLocn mod_name basename (Just hs);
  75         Just path -> mkHomeModuleLocn mod_name
  76                         (path ++ '/':basename) (Just (path ++ '/':hs));
  77         Nothing -> do
  78
  79    found <- findOnPath home_path lhs
  80    case found of {
  81           -- special case to avoid getting "./foo.hs" all the time
  82         Just "."  -> mkHomeModuleLocn mod_name basename (Just lhs);
  83         Just path ->  mkHomeModuleLocn mod_name
  84                         (path ++ '/':basename) (Just (path ++ '/':lhs));
  85         Nothing -> do
  86
  87    -- can't find a source file anywhere, check for a lone .hi file.
  88    hisuf <- readIORef v_Hi_suf
  89    let hi = basename ++ '.':hisuf
  90    found <- findOnPath home_path hi
  91    case found of {
  92         Just path ->  mkHiOnlyModuleLocn mod_name hi;
  93         Nothing -> do
  94
  95    -- last chance: .hi-boot-<ver> and .hi-boot
  96    let hi_boot = basename ++ ".hi-boot"
  97    let hi_boot_ver = basename ++ ".hi-boot-" ++ cHscIfaceFileVersion
  98    found <- findOnPath home_path hi_boot_ver
  99    case found of {
 100         Just path -> mkHiOnlyModuleLocn mod_name hi;
 101         Nothing -> do
 102    found <- findOnPath home_path hi_boot
 103    case found of {
 104         Just path -> mkHiOnlyModuleLocn mod_name hi;
 105         Nothing -> return Nothing
 106    }}}}}
 107
 108
 109 mkHiOnlyModuleLocn mod_name hi_file = do
 110    return (Just (mkHomeModule mod_name,
 111                  ModuleLocation{
 112                     ml_hspp_file = Nothing,
 113                     ml_hs_file   = Nothing,
 114                     ml_hi_file   = hi_file,
 115                     ml_obj_file  = Nothing
 116                  }
 117         ))
 118
 119 -- The .hi file always follows the module name, whereas the object
 120 -- file may follow the name of the source file in the case where the
 121 -- two differ (see summariseFile in compMan/CompManager.lhs).
 122
 123 mkHomeModuleLocn mod_name basename maybe_source_fn = do
 124
 125    hisuf  <- readIORef v_Hi_suf
 126    hidir  <- readIORef v_Hi_dir
 127
 128    let hi_rest = basename ++ '.':hisuf
 129        hi_file | Just d <- hidir = d ++ '/':hi_rest
 130                | otherwise       = hi_rest
 131
 132    -- figure out the .o file name.  It also lives in the same dir
 133    -- as the source, but can be overriden by a -odir flag.
 134    o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
 135
 136    return (Just (mkHomeModule mod_name,
 137                  ModuleLocation{
 138                     ml_hspp_file = Nothing,
 139                     ml_hs_file   = maybe_source_fn,
 140                     ml_hi_file   = hi_file,
 141                     ml_obj_file  = Just o_file
 142                  }
 143         ))
 144
 145
 146 maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 147 maybePackageModule mod_name = do
 148   pkgs <- getPackageInfo
 149
 150   -- hi-suffix for packages depends on the build tag.
 151   package_hisuf <-
 152         do tag <- readIORef v_Build_tag
 153            if null tag
 154                 then return "hi"
 155                 else return (tag ++ "_hi")
 156
 157   let basename = moduleNameUserString mod_name
 158       hi = basename ++ '.':package_hisuf
 159
 160   found <- findOnPackagePath pkgs hi
 161   case found of
 162         Nothing -> return Nothing
 163         Just (pkg_name,path) ->
 164             return (Just (mkModule mod_name pkg_name,
 165                           ModuleLocation{
 166                                 ml_hspp_file = Nothing,
 167                                 ml_hs_file   = Nothing,
 168                                 ml_hi_file   = path,
 169                                 ml_obj_file  = Nothing
 170                            }
 171                    ))
 172
 173 findOnPackagePath :: [PackageConfig] -> String
 174    -> IO (Maybe (PackageName,FilePath))
 175 findOnPackagePath pkgs file = loop pkgs
 176  where
 177   loop [] = return Nothing
 178   loop (p:ps) = do
 179     found <- findOnPath (import_dirs p) file
 180     case found of
 181         Nothing   -> loop ps
 182         Just path -> return (Just (mkFastString (name p), path ++ '/':file))
 183
 184 findOnPath :: [String] -> String -> IO (Maybe FilePath)
 185 findOnPath path s = loop path
 186  where
 187   loop [] = return Nothing
 188   loop (d:ds) = do
 189     let file = d ++ '/':s
 190     b <- doesFileExist file
 191     if b then return (Just d) else loop ds
 192 \end{code}