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