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 -> Maybe 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 Module
  25 import FastString
  26 import Config
  27
  28 import IOExts
  29 import List
  30 import Directory
  31 import IO
  32 import Monad
  33 import Outputable
  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 (Just fName))
  78         , ("lhs",
  79            \ _ fName path -> mkHomeModuleLocn mod_name path (Just 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 basename maybe_source_fn = do
 110
 111    hisuf  <- readIORef v_Hi_suf
 112    hidir  <- readIORef v_Hi_dir
 113
 114    let hi_rest = basename ++ '.':hisuf
 115        hi_file | Just d <- hidir = d ++ '/':hi_rest
 116                | otherwise       = hi_rest
 117
 118    -- figure out the .o file name.  It also lives in the same dir
 119    -- as the source, but can be overriden by a -odir flag.
 120    o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
 121
 122    return (mkHomeModule mod_name,
 123            ModuleLocation{ ml_hspp_file = Nothing
 124                          , ml_hs_file   = maybe_source_fn
 125                          , ml_hi_file   = hi_file
 126                          , ml_obj_file  = Just o_file
 127                          })
 128
 129 findPackageMod :: ModuleName
 130                -> Bool
 131                -> IO (Maybe (Module, ModuleLocation))
 132 findPackageMod mod_name hiOnly = do
 133   pkgs <- getPackageInfo
 134
 135    -- hi-suffix for packages depends on the build tag.
 136   package_hisuf <-
 137         do tag <- readIORef v_Build_tag
 138            if null tag
 139                 then return "hi"
 140                 else return (tag ++ "_hi")
 141   let imp_dirs = concatMap (\ pkg -> map ((,) pkg) (import_dirs pkg)) pkgs
 142       mod_str  = moduleNameUserString mod_name
 143       basename = map (\c -> if c == '.' then '/' else c) mod_str
 144   searchPathExts
 145         imp_dirs basename
 146         ((package_hisuf,\ pkg fName path -> mkPackageModule mod_name pkg Nothing path) :
 147           -- can packages contain hi-boots?
 148          (if hiOnly then [] else
 149           [ ("hs",  \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path)
 150           , ("lhs", \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path)
 151           ]))
 152  where
 153   mkPackageModule mod_name pkg mbFName path =
 154     return ( mkModule mod_name (mkFastString (name pkg))
 155            , ModuleLocation{ ml_hspp_file = Nothing
 156                            , ml_hs_file   = mbFName
 157                            , ml_hi_file   = path ++".hi"
 158                            , ml_obj_file  = Nothing
 159                            })
 160
 161 findPackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 162 findPackageModule mod_name = findPackageMod mod_name True
 163
 164 searchPathExts :: [(a, FilePath)]
 165                -> String
 166                -> [(String, a -> FilePath -> String -> IO (Module, ModuleLocation))]
 167                -> IO (Maybe (Module, ModuleLocation))
 168 searchPathExts path basename exts = search exts
 169   where
 170     search         [] = return Nothing
 171     search ((x,f):xs) = do
 172         let fName = (basename ++ '.':x)
 173         found <- findOnPath path fName
 174         case found of
 175             -- special case to avoid getting "./foo.<ext>" all the time
 176           Just (v,".")  -> fmap Just (f v fName basename)
 177           Just (v,path) -> fmap Just (f v (path ++ '/':fName)
 178                                           (path ++ '/':basename))
 179           Nothing   -> search xs
 180
 181 findOnPath :: [(a,String)] -> String -> IO (Maybe (a, FilePath))
 182 findOnPath path s = loop path
 183  where
 184   loop [] = return Nothing
 185   loop ((a,d):ds) = do
 186     let file = d ++ '/':s
 187     b <- doesFileExist file
 188     if b then return (Just (a,d)) else loop ds
 189 \end{code}