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        std_exts
  76          | isCompManagerMode mode || mode == DoMkDependHS =
  77                 [ ("hs",   \ _ fName path -> mkHomeModuleLocn mod_name path fName)
  78                 , ("lhs",  \ _ fName path -> mkHomeModuleLocn mod_name path fName)
  79                 ]
  80          | otherwise =
  81                 [ (hisuf,  \ _ fName path -> mkHiOnlyModuleLocn mod_name fName) ]
  82
  83         -- last chance: .hi-boot-<ver> and .hi-boot
  84        hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion
  85
  86        boot_exts =
  87         [ (hi_boot_ver, \ _ fName path -> mkHiOnlyModuleLocn mod_name fName)
  88         , ("hi-boot",   \ _ fName path -> mkHiOnlyModuleLocn mod_name fName)
  89         ]
  90
  91    searchPathExts
  92         (map ((,) undefined) home_path)
  93         basename
  94         (if is_source then (boot_exts++std_exts) else std_exts ++ boot_exts)
  95                         -- for SOURCE imports, check the hi-boot extensions
  96                         -- before the source/iface ones, to avoid
  97                         -- creating circ Makefile deps.
  98
  99 mkHiOnlyModuleLocn mod_name hi_file =
 100  return
 101    ( mkHomeModule mod_name
 102    , ModuleLocation{ ml_hspp_file = Nothing
 103                    , ml_hs_file   = Nothing
 104                    , ml_hi_file   = hi_file
 105                    , ml_obj_file  = Nothing
 106                    }
 107    )
 108
 109 -- The .hi file always follows the module name, whereas the object
 110 -- file may follow the name of the source file in the case where the
 111 -- two differ (see summariseFile in compMan/CompManager.lhs).
 112
 113 mkHomeModuleLocn mod_name
 114         basename                -- everything but the extension
 115         source_fn               -- full path to the source (required)
 116   = do
 117
 118    hisuf  <- readIORef v_Hi_suf
 119    hidir  <- readIORef v_Hi_dir
 120
 121    -- take the *last* component of the module name (if a hierarchical name),
 122    -- and append it to the directory to get the .hi file name.
 123    let (_,mod_str) = split_longest_prefix (moduleNameUserString mod_name) (=='.')
 124        hi_filename = mod_str ++ '.':hisuf
 125        hi_path | Just d <- hidir = d
 126                | otherwise       = getdir basename
 127        hi = hi_path ++ '/':hi_filename
 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 (mkHomeModule mod_name,
 134            ModuleLocation{ ml_hspp_file = Nothing
 135                          , ml_hs_file   = Just source_fn
 136                          , ml_hi_file   = hi
 137                          , ml_obj_file  = Just o_file
 138                          })
 139
 140 findPackageMod :: ModuleName
 141                -> Bool
 142                -> IO (Maybe (Module, ModuleLocation))
 143 findPackageMod mod_name hiOnly = 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   let imp_dirs = concatMap (\ pkg -> map ((,) pkg) (import_dirs pkg)) pkgs
 153       mod_str  = moduleNameUserString mod_name
 154       basename = map (\c -> if c == '.' then '/' else c) mod_str
 155
 156       mkPackageModule mod_name pkg mbFName path =
 157         return ( mkModule mod_name (mkFastString (name pkg))
 158                , ModuleLocation{ ml_hspp_file = Nothing
 159                                , ml_hs_file   = mbFName
 160                                , ml_hi_file   = path ++ '.':package_hisuf
 161                                , ml_obj_file  = Nothing
 162                                })
 163
 164   searchPathExts
 165         imp_dirs basename
 166         ((package_hisuf,\ pkg fName path -> mkPackageModule mod_name pkg Nothing path) :
 167           -- can packages contain hi-boots?
 168          (if hiOnly then [] else
 169           [ ("hs",  \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path)
 170           , ("lhs", \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path)
 171           ]))
 172  where
 173
 174 findPackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 175 findPackageModule mod_name = findPackageMod mod_name True
 176
 177 searchPathExts :: [(a, FilePath)]
 178                -> String
 179                -> [(String, a -> FilePath -> String -> IO (Module, ModuleLocation))]
 180                -> IO (Maybe (Module, ModuleLocation))
 181 searchPathExts path basename exts = search exts
 182   where
 183     search         [] = return Nothing
 184     search ((x,f):xs) = do
 185         let fName = (basename ++ '.':x)
 186         found <- findOnPath path fName
 187         case found of
 188             -- special case to avoid getting "./foo.<ext>" all the time
 189           Just (v,".")  -> fmap Just (f v fName basename)
 190           Just (v,path) -> fmap Just (f v (path ++ '/':fName)
 191                                           (path ++ '/':basename))
 192           Nothing   -> search xs
 193
 194 findOnPath :: [(a,String)] -> String -> IO (Maybe (a, FilePath))
 195 findOnPath path s = loop path
 196  where
 197   loop [] = return Nothing
 198   loop ((a,d):ds) = do
 199     let file = d ++ '/':s
 200     b <- doesFileExist file
 201     if b then return (Just (a,d)) else loop ds
 202 \end{code}