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    mode      <- readIORef v_GhcMode
  68
  69    let mod_str  = moduleNameUserString mod_name
  70        basename = map (\c -> if c == '.' then '/' else c) mod_str
  71
  72         -- In compilation manager modes, we look for source files in the home
  73         -- package because we can compile these automatically.  In one-shot
  74         -- compilation mode we look for .hi files only.
  75         --
  76         -- When generating dependencies, we're interested in either category.
  77         --
  78        source_exts =
  79                  [ ("hs",   \ _ fName path -> mkHomeModuleLocn mod_name path fName)
  80                  , ("lhs",  \ _ fName path -> mkHomeModuleLocn mod_name path fName)
  81                  ]
  82        hi_exts = [ (hisuf,  \ _ fName path -> mkHiOnlyModuleLocn mod_name fName) ]
  83
  84        std_exts
  85          | mode == DoMkDependHS   = hi_exts ++ source_exts
  86          | isCompManagerMode mode = source_exts
  87          | otherwise              = hi_exts
  88
  89         -- last chance: .hi-boot-<ver> and .hi-boot
  90        hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion
  91
  92        boot_exts =
  93         [ (hi_boot_ver, \ _ fName path -> mkHiOnlyModuleLocn mod_name fName)
  94         , ("hi-boot",   \ _ fName path -> mkHiOnlyModuleLocn mod_name fName)
  95         ]
  96
  97    searchPathExts
  98         (map ((,) undefined) home_path)
  99         basename
 100         (if is_source then (boot_exts++std_exts) else std_exts ++ boot_exts)
 101                         -- for SOURCE imports, check the hi-boot extensions
 102                         -- before the source/iface ones, to avoid
 103                         -- creating circ Makefile deps.
 104
 105 mkHiOnlyModuleLocn mod_name hi_file =
 106  return
 107    ( mkHomeModule mod_name
 108    , ModuleLocation{ 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
 120         basename                -- everything but the extension
 121         source_fn               -- full path to the source (required)
 122   = do
 123
 124    hisuf  <- readIORef v_Hi_suf
 125    hidir  <- readIORef v_Hi_dir
 126
 127    -- take the *last* component of the module name (if a hierarchical name),
 128    -- and append it to the directory to get the .hi file name.
 129    let (_,mod_str) = split_longest_prefix (moduleNameUserString mod_name) (=='.')
 130        hi_filename = mod_str ++ '.':hisuf
 131        hi_path | Just d <- hidir = d
 132                | otherwise       = getdir basename
 133        hi = hi_path ++ '/':hi_filename
 134
 135    -- figure out the .o file name.  It also lives in the same dir
 136    -- as the source, but can be overriden by a -odir flag.
 137    o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
 138
 139    return (mkHomeModule mod_name,
 140            ModuleLocation{ ml_hspp_file = Nothing
 141                          , ml_hs_file   = Just source_fn
 142                          , ml_hi_file   = hi
 143                          , ml_obj_file  = Just o_file
 144                          })
 145
 146 findPackageMod :: ModuleName
 147                -> Bool
 148                -> IO (Maybe (Module, ModuleLocation))
 149 findPackageMod mod_name hiOnly = do
 150   pkgs <- getPackageInfo
 151
 152    -- hi-suffix for packages depends on the build tag.
 153   package_hisuf <-
 154         do tag <- readIORef v_Build_tag
 155            if null tag
 156                 then return "hi"
 157                 else return (tag ++ "_hi")
 158   let imp_dirs = concatMap (\ pkg -> map ((,) pkg) (import_dirs pkg)) pkgs
 159       mod_str  = moduleNameUserString mod_name
 160       basename = map (\c -> if c == '.' then '/' else c) mod_str
 161
 162       mkPackageModule mod_name pkg mbFName path =
 163         return ( mkModule mod_name (mkFastString (name pkg))
 164                , ModuleLocation{ ml_hspp_file = Nothing
 165                                , ml_hs_file   = mbFName
 166                                , ml_hi_file   = path ++ '.':package_hisuf
 167                                , ml_obj_file  = Nothing
 168                                })
 169
 170   searchPathExts
 171         imp_dirs basename
 172         ((package_hisuf,\ pkg fName path -> mkPackageModule mod_name pkg Nothing path) :
 173           -- can packages contain hi-boots?
 174          (if hiOnly then [] else
 175           [ ("hs",  \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path)
 176           , ("lhs", \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path)
 177           ]))
 178  where
 179
 180 findPackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 181 findPackageModule mod_name = findPackageMod mod_name True
 182
 183 searchPathExts :: [(a, FilePath)]
 184                -> String
 185                -> [(String, a -> FilePath -> String -> IO (Module, ModuleLocation))]
 186                -> IO (Maybe (Module, ModuleLocation))
 187 searchPathExts path basename exts = search exts
 188   where
 189     search         [] = return Nothing
 190     search ((x,f):xs) = do
 191         let fName = (basename ++ '.':x)
 192         found <- findOnPath path fName
 193         case found of
 194             -- special case to avoid getting "./foo.<ext>" all the time
 195           Just (v,".")  -> fmap Just (f v fName basename)
 196           Just (v,path) -> fmap Just (f v (path ++ '/':fName)
 197                                           (path ++ '/':basename))
 198           Nothing   -> search xs
 199
 200 findOnPath :: [(a,String)] -> String -> IO (Maybe (a, FilePath))
 201 findOnPath path s = loop path
 202  where
 203   loop [] = return Nothing
 204   loop ((a,d):ds) = do
 205     let file = d ++ '/':s
 206     b <- doesFileExist file
 207     if b then return (Just (a,d)) else loop ds
 208 \end{code}