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
  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++std_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 mkHiOnlyModuleLocn mod_name hi_file =
 108  return
 109    ( mkHomeModule mod_name
 110    , ModuleLocation{ ml_hspp_file = Nothing
 111                    , ml_hs_file   = Nothing
 112                    , ml_hi_file   = hi_file
 113                    , ml_obj_file  = Nothing
 114                    }
 115    )
 116
 117 -- The .hi file always follows the module name, whereas the object
 118 -- file may follow the name of the source file in the case where the
 119 -- two differ (see summariseFile in compMan/CompManager.lhs).
 120
 121 mkHomeModuleLocn mod_name
 122         basename                -- everything but the extension
 123         source_fn               -- full path to the source (required)
 124   = do
 125
 126    hisuf  <- readIORef v_Hi_suf
 127    hidir  <- readIORef v_Hi_dir
 128
 129    -- take the *last* component of the module name (if a hierarchical name),
 130    -- and append it to the directory to get the .hi file name.
 131    let (_,mod_str) = split_longest_prefix (moduleNameUserString mod_name) (=='.')
 132        hi_filename = mod_str ++ '.':hisuf
 133        hi_path | Just d <- hidir = d
 134                | otherwise       = getdir basename
 135        hi = hi_path ++ '/':hi_filename
 136
 137    -- figure out the .o file name.  It also lives in the same dir
 138    -- as the source, but can be overriden by a -odir flag.
 139    o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
 140
 141    return (mkHomeModule mod_name,
 142            ModuleLocation{ ml_hspp_file = Nothing
 143                          , ml_hs_file   = Just source_fn
 144                          , ml_hi_file   = hi
 145                          , ml_obj_file  = Just o_file
 146                          })
 147
 148 findPackageMod :: ModuleName
 149                -> Bool
 150                -> IO (Maybe (Module, ModuleLocation))
 151 findPackageMod mod_name hiOnly = do
 152   pkgs <- getPackageInfo
 153
 154    -- hi-suffix for packages depends on the build tag.
 155   package_hisuf <-
 156         do tag <- readIORef v_Build_tag
 157            if null tag
 158                 then return "hi"
 159                 else return (tag ++ "_hi")
 160   let imp_dirs = concatMap import_dirs pkgs
 161       mod_str  = moduleNameUserString mod_name
 162       basename = map (\c -> if c == '.' then '/' else c) mod_str
 163
 164       retPackageModule mod_name mbFName path =
 165         return ( mkPackageModule mod_name
 166                , ModuleLocation{ ml_hspp_file = Nothing
 167                                , ml_hs_file   = mbFName
 168                                , ml_hi_file   = path ++ '.':package_hisuf
 169                                , ml_obj_file  = Nothing
 170                                })
 171
 172   searchPathExts
 173         imp_dirs basename
 174         ((package_hisuf,\ fName path -> retPackageModule mod_name Nothing path) :
 175           -- can packages contain hi-boots?
 176          (if hiOnly then [] else
 177           [ ("hs",  \ fName path -> retPackageModule mod_name (Just fName) path)
 178           , ("lhs", \ fName path -> retPackageModule mod_name (Just fName) path)
 179           ]))
 180  where
 181
 182 findPackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 183 findPackageModule mod_name = findPackageMod mod_name True
 184
 185 searchPathExts :: [FilePath]
 186                -> String
 187                -> [(String, FilePath -> String -> IO (Module, ModuleLocation))]
 188                -> IO (Maybe (Module, ModuleLocation))
 189 searchPathExts path basename exts = search path
 190   where
 191     search [] = return Nothing
 192     search (p:ps) = loop exts
 193       where
 194         base | p == "."  = basename
 195              | otherwise = p ++ '/':basename
 196
 197         loop [] = search ps
 198         loop ((ext,fn):exts) = do
 199             let file = base ++ '.':ext
 200             b <- doesFileExist file
 201             if b then Just `liftM` fn file base
 202                  else loop exts
 203 \end{code}