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