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