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) whether the module lives
  38 in the home package or in another package, so it can make a Module
  39 from a ModuleName, and (b) where the source, interface, and object
  40 files for a module live.
  41
  42 It does *not* know which particular package a module lives in, because
  43 that information is only contained in the interface file.
  44
  45 \begin{code}
  46 initFinder :: [PackageConfig] -> IO ()
  47 initFinder pkgs = return ()
  48
  49 -- empty, and lazilly fill in the package cache
  50 flushPackageCache :: [PackageConfig] -> IO ()
  51 flushPackageCache pkgs = return ()
  52
  53 emptyHomeDirCache :: IO ()
  54 emptyHomeDirCache = return ()
  55
  56 findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
  57 findModule name = findModuleDep name False
  58
  59 findModuleDep :: ModuleName -> Bool -> IO (Maybe (Module, ModuleLocation))
  60 findModuleDep name is_source
  61   = do  { j <- maybeHomeModule name is_source
  62         ; case j of
  63             Just home_module -> return (Just home_module)
  64             Nothing          -> findPackageMod name False is_source
  65         }
  66
  67 maybeHomeModule :: ModuleName -> Bool -> IO (Maybe (Module, ModuleLocation))
  68 maybeHomeModule mod_name is_source = do
  69    home_path <- readIORef v_Import_paths
  70    hisuf     <- readIORef v_Hi_suf
  71    mode      <- readIORef v_GhcMode
  72
  73    let mod_str  = moduleNameUserString mod_name
  74        basename = map (\c -> if c == '.' then '/' else c) mod_str
  75
  76         -- In compilation manager modes, we look for source files in the home
  77         -- package because we can compile these automatically.  In one-shot
  78         -- compilation mode we look for .hi files only.
  79         --
  80         -- When generating dependencies, we're interested in either category.
  81         --
  82        source_exts =
  83              [ ("hs",   \ fName path -> mkHomeModuleLocn mod_name path fName)
  84              , ("lhs",  \ fName path -> mkHomeModuleLocn mod_name path fName)
  85              ]
  86        hi_exts = [ (hisuf,  \ fName path -> mkHiOnlyModuleLocn mod_name fName) ]
  87
  88        std_exts
  89          | mode == DoMkDependHS   = hi_exts ++ source_exts
  90          | isCompManagerMode mode = source_exts
  91          | otherwise              = hi_exts
  92
  93         -- last chance: .hi-boot-<ver> and .hi-boot
  94        hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion
  95
  96        boot_exts =
  97         [ (hi_boot_ver, \ fName path -> mkHiOnlyModuleLocn mod_name fName)
  98         , ("hi-boot",   \ fName path -> mkHiOnlyModuleLocn mod_name fName)
  99         ]
 100
 101    searchPathExts home_path basename
 102         (if is_source then boot_exts else (std_exts ++ boot_exts))
 103                         -- for SOURCE imports, check the hi-boot extensions
 104                         -- before the source/iface ones, to avoid
 105                         -- creating circ Makefile deps.
 106
 107
 108 mkHiOnlyModuleLocn mod_name hi_file =
 109  return
 110    ( mkHomeModule mod_name
 111    , ModuleLocation{ ml_hspp_file = Nothing
 112                    , ml_hs_file   = Nothing
 113                    , ml_hi_file   = hi_file
 114                    , ml_obj_file  = Nothing
 115                    }
 116    )
 117
 118 -- The .hi file always follows the module name, whereas the object
 119 -- file may follow the name of the source file in the case where the
 120 -- two differ (see summariseFile in compMan/CompManager.lhs).
 121
 122 mkHomeModuleLocn mod_name
 123         basename                -- everything but the extension
 124         source_fn               -- full path to the source (required)
 125   = do
 126
 127    hisuf  <- readIORef v_Hi_suf
 128    hidir  <- readIORef v_Hi_dir
 129
 130    -- take the *last* component of the module name (if a hierarchical name),
 131    -- and append it to the directory to get the .hi file name.
 132    let (_,mod_str) = split_longest_prefix (moduleNameUserString mod_name) (=='.')
 133        hi_filename = mod_str ++ '.':hisuf
 134        hi_path | Just d <- hidir = d
 135                | otherwise       = getdir basename
 136        hi = hi_path ++ '/':hi_filename
 137
 138    -- figure out the .o file name.  It also lives in the same dir
 139    -- as the source, but can be overriden by a -odir flag.
 140    o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
 141
 142    return (mkHomeModule mod_name,
 143            ModuleLocation{ ml_hspp_file = Nothing
 144                          , ml_hs_file   = Just source_fn
 145                          , ml_hi_file   = hi
 146                          , ml_obj_file  = Just o_file
 147                          })
 148
 149 findPackageMod :: ModuleName
 150                -> Bool
 151                -> Bool
 152                -> IO (Maybe (Module, ModuleLocation))
 153 findPackageMod mod_name hiOnly is_source = do
 154   pkgs <- getPackageInfo
 155
 156    -- hi-suffix for packages depends on the build tag.
 157   package_hisuf <-
 158         do tag <- readIORef v_Build_tag
 159            if null tag
 160                 then return "hi"
 161                 else return (tag ++ "_hi")
 162   let imp_dirs = concatMap import_dirs pkgs
 163       mod_str  = moduleNameUserString mod_name
 164       basename = map (\c -> if c == '.' then '/' else c) mod_str
 165
 166       retPackageModule mod_name mbFName path =
 167         return ( mkPackageModule mod_name
 168                , ModuleLocation{ ml_hspp_file = Nothing
 169                                , ml_hs_file   = mbFName
 170                                , ml_hi_file   = path ++ '.':package_hisuf
 171                                , ml_obj_file  = Nothing
 172                                })
 173
 174        -- last chance: .hi-boot-<ver> and .hi-boot
 175       hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion
 176
 177       boot_exts =
 178         [ (hi_boot_ver, \ fName path -> mkHiOnlyModuleLocn mod_name fName)
 179         , ("hi-boot",   \ fName path -> mkHiOnlyModuleLocn mod_name fName)
 180         ]
 181
 182   searchPathExts
 183         imp_dirs basename
 184         (if is_source then boot_exts else
 185           ((package_hisuf,\ fName path -> retPackageModule mod_name Nothing path) :
 186            (if hiOnly then [] else
 187              [ ("hs",  \ fName path -> retPackageModule mod_name (Just fName) path)
 188              , ("lhs", \ fName path -> retPackageModule mod_name (Just fName) path)
 189              ])))
 190  where
 191
 192 findPackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 193 findPackageModule mod_name = findPackageMod mod_name True False
 194
 195 searchPathExts :: [FilePath]
 196                -> String
 197                -> [(String, FilePath -> String -> IO (Module, ModuleLocation))]
 198                -> IO (Maybe (Module, ModuleLocation))
 199 searchPathExts path basename exts = search path
 200   where
 201     search [] = return Nothing
 202     search (p:ps) = loop exts
 203       where
 204         base | p == "."  = basename
 205              | otherwise = p ++ '/':basename
 206
 207         loop [] = search ps
 208         loop ((ext,fn):exts) = do
 209             let file = base ++ '.':ext
 210             b <- doesFileExist file
 211             if b then Just `liftM` fn file base
 212                  else loop exts
 213 \end{code}