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     flushFinderCache,   -- :: IO ()
   9     FindResult(..),
  10     findModule,         -- :: ModuleName -> Bool -> IO FindResult
  11     findPackageModule,  -- :: ModuleName -> Bool -> IO FindResult
  12     mkHomeModLocation,  -- :: ModuleName -> FilePath -> IO ModLocation
  13     findLinkable,       -- :: ModuleName -> ModLocation -> IO (Maybe Linkable)
  14
  15     hiBootFilePath,     -- :: ModLocation -> IO FilePath
  16     hiBootExt,          -- :: String
  17     hiBootVerExt,       -- :: String
  18
  19   ) where
  20
  21 #include "HsVersions.h"
  22
  23 import Module
  24 import UniqFM           ( filterUFM )
  25 import HscTypes         ( Linkable(..), Unlinked(..) )
  26 import Packages
  27 import DriverState
  28 import DriverUtil
  29 import FastString
  30 import Config
  31 import Util
  32 import CmdLineOpts      ( DynFlags(..) )
  33
  34 import DATA_IOREF       ( IORef, writeIORef, readIORef )
  35
  36 import Data.List
  37 import System.Directory
  38 import System.IO
  39 import Control.Monad
  40 import Data.Maybe       ( isNothing )
  41
  42 -- -----------------------------------------------------------------------------
  43 -- The Finder
  44
  45 -- The Finder provides a thin filesystem abstraction to the rest of
  46 -- the compiler.  For a given module, it can tell you where the
  47 -- source, interface, and object files for that module live.
  48 --
  49 -- It does *not* know which particular package a module lives in.  Use
  50 -- Packages.moduleToPackageConfig for that.
  51
  52 -- -----------------------------------------------------------------------------
  53 -- The finder's cache
  54
  55 GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv FinderCacheEntry)
  56
  57 type FinderCacheEntry = (ModLocation,Maybe (PackageConfig,Bool))
  58
  59 -- remove all the home modules from the cache; package modules are
  60 -- assumed to not move around during a session.
  61 flushFinderCache :: IO ()
  62 flushFinderCache = do
  63   fm <- readIORef finder_cache
  64   writeIORef finder_cache (filterUFM (\(loc,m) -> isNothing m) fm)
  65
  66 addToFinderCache :: Module -> FinderCacheEntry -> IO ()
  67 addToFinderCache mod_name entry = do
  68   fm <- readIORef finder_cache
  69   writeIORef finder_cache (extendModuleEnv fm mod_name entry)
  70
  71 lookupFinderCache :: Module -> IO (Maybe FinderCacheEntry)
  72 lookupFinderCache mod_name = do
  73   fm <- readIORef finder_cache
  74   return $! lookupModuleEnv fm mod_name
  75
  76 -- -----------------------------------------------------------------------------
  77 -- Locating modules
  78
  79 -- This is the main interface to the finder, which maps ModuleNames to
  80 -- Modules and ModLocations.
  81 --
  82 -- The Module contains one crucial bit of information about a module:
  83 -- whether it lives in the current ("home") package or not (see Module
  84 -- for more details).
  85 --
  86 -- The ModLocation contains the names of all the files associated with
  87 -- that module: its source file, .hi file, object file, etc.
  88
  89 data FindResult
  90   = Found ModLocation PackageIdH
  91         -- the module was found
  92   | PackageHidden PackageId
  93         -- for an explicit source import: the package containing the module is
  94         -- not exposed.
  95   | ModuleHidden  PackageId
  96         -- for an explicit source import: the package containing the module is
  97         -- exposed, but the module itself is hidden.
  98   | NotFound [FilePath]
  99         -- the module was not found, the specified places were searched.
 100
 101 findModule :: DynFlags -> Module -> Bool -> IO FindResult
 102 findModule = cached findModule'
 103
 104 findModule' :: DynFlags -> Module -> Bool -> IO FindResult
 105 findModule' dflags name explicit = do
 106     r <- findPackageModule' dflags name explicit
 107     case r of
 108         NotFound pkg_files -> do
 109            j <- maybeHomeModule dflags name
 110            case j of
 111                 NotFound home_files ->
 112                         return (NotFound (home_files ++ pkg_files))
 113                 other_result
 114                         -> return other_result
 115         other_result
 116                 -> return other_result
 117
 118 cached fn dflags name explicit = do
 119   m <- lookupFinderCache name
 120   case m of
 121     Nothing -> fn dflags name explicit
 122     Just (loc,maybe_pkg)
 123         | Just err <- visible explicit maybe_pkg  ->  return err
 124         | otherwise -> return (Found loc (pkgInfoToId maybe_pkg))
 125
 126 pkgInfoToId :: Maybe (PackageConfig,Bool) -> PackageIdH
 127 pkgInfoToId (Just (pkg,_)) = ExtPackage (mkPackageId (package pkg))
 128 pkgInfoToId Nothing        = HomePackage
 129
 130 -- Is a module visible or not?  Returns Nothing if the import is ok,
 131 -- or Just err if there's a visibility error.
 132 visible :: Bool -> Maybe (PackageConfig,Bool) -> Maybe FindResult
 133 visible explicit maybe_pkg
 134    | Nothing <- maybe_pkg  =  Nothing   -- home module ==> YES
 135    | not explicit          =  Nothing   -- implicit import ==> YES
 136    | Just (pkg, exposed_module) <- maybe_pkg
 137     = case () of
 138         _ | not exposed_module -> Just (ModuleHidden pkgname)
 139           | not (exposed pkg)  -> Just (PackageHidden pkgname)
 140           | otherwise          -> Nothing
 141           where
 142                 pkgname = packageConfigId pkg
 143
 144
 145 hiBootExt = "hi-boot"
 146 hiBootVerExt = "hi-boot-" ++ cHscIfaceFileVersion
 147
 148 maybeHomeModule :: DynFlags -> Module -> IO FindResult
 149 maybeHomeModule dflags mod = do
 150    let home_path = importPaths dflags
 151    hisuf     <- readIORef v_Hi_suf
 152    mode      <- readIORef v_GhcMode
 153
 154    let
 155      source_exts =
 156       [ ("hs",   mkHomeModLocationSearched mod)
 157       , ("lhs",  mkHomeModLocationSearched mod)
 158       ]
 159
 160      hi_exts = [ (hisuf,  mkHiOnlyModLocation hisuf mod) ]
 161
 162      boot_exts =
 163        [ (hiBootVerExt, mkHiOnlyModLocation hisuf mod)
 164        , (hiBootExt,    mkHiOnlyModLocation hisuf mod)
 165        ]
 166
 167         -- In compilation manager modes, we look for source files in the home
 168         -- package because we can compile these automatically.  In one-shot
 169         -- compilation mode we look for .hi and .hi-boot files only.
 170         --
 171         -- When generating dependencies, we're interested in either category.
 172         --
 173      exts
 174          | mode == DoMkDependHS   = hi_exts ++ source_exts ++ boot_exts
 175          | isCompManagerMode mode = source_exts
 176          | otherwise {-one-shot-} = hi_exts ++ boot_exts
 177
 178    searchPathExts home_path mod exts
 179
 180 -- -----------------------------------------------------------------------------
 181 -- Looking for a package module
 182
 183 findPackageModule :: DynFlags -> Module -> Bool -> IO FindResult
 184 findPackageModule = cached findPackageModule'
 185
 186 findPackageModule' :: DynFlags -> Module -> Bool -> IO FindResult
 187 findPackageModule' dflags mod explicit = do
 188   mode     <- readIORef v_GhcMode
 189
 190   case moduleToPackageConfig dflags mod of
 191     Nothing -> return (NotFound [])
 192     pkg_info@(Just (pkg_conf, module_exposed))
 193         | Just err <- visible explicit pkg_info  ->  return err
 194         | otherwise  ->  findPackageIface mode mod paths pkg_info
 195       where
 196             paths   = importDirs pkg_conf
 197
 198 findPackageIface
 199         :: GhcMode
 200         -> Module
 201         -> [FilePath]
 202         -> Maybe (PackageConfig,Bool)
 203         -> IO FindResult
 204 findPackageIface mode mod imp_dirs pkg_info = do
 205    -- hi-suffix for packages depends on the build tag.
 206   package_hisuf <-
 207         do tag <- readIORef v_Build_tag
 208            if null tag
 209                 then return "hi"
 210                 else return (tag ++ "_hi")
 211
 212   let
 213      hi_exts =
 214         [ (package_hisuf,
 215             mkPackageModLocation pkg_info package_hisuf mod) ]
 216
 217      source_exts =
 218        [ ("hs",   mkPackageModLocation pkg_info package_hisuf mod)
 219        , ("lhs",  mkPackageModLocation pkg_info package_hisuf mod)
 220        ]
 221
 222      -- mkdependHS needs to look for source files in packages too, so
 223      -- that we can make dependencies between package before they have
 224      -- been built.
 225      exts
 226       | mode == DoMkDependHS = hi_exts ++ source_exts
 227       | otherwise = hi_exts
 228
 229       -- we never look for a .hi-boot file in an external package;
 230       -- .hi-boot files only make sense for the home package.
 231   searchPathExts imp_dirs mod exts
 232
 233 -- -----------------------------------------------------------------------------
 234 -- General path searching
 235
 236 searchPathExts
 237   :: [FilePath]         -- paths to search
 238   -> Module             -- module name
 239   -> [ (
 240         String,                                      -- suffix
 241         String -> String -> String -> IO FindResult  -- action
 242        )
 243      ]
 244   -> IO FindResult
 245
 246 searchPathExts path mod exts = search to_search
 247   where
 248     basename = dots_to_slashes (moduleUserString mod)
 249
 250     to_search :: [(FilePath, IO FindResult)]
 251     to_search = [ (file, fn p basename ext)
 252                 | p <- path,
 253                   (ext,fn) <- exts,
 254                   let base | p == "."  = basename
 255                            | otherwise = p ++ '/':basename
 256                       file = base ++ '.':ext
 257                 ]
 258
 259     search [] = return (NotFound (map fst to_search))
 260     search ((file, result) : rest) = do
 261       b <- doesFileExist file
 262       if b
 263         then result
 264         else search rest
 265
 266 -- -----------------------------------------------------------------------------
 267 -- Building ModLocations
 268
 269 mkHiOnlyModLocation hisuf mod path basename _ext = do
 270   -- basename == dots_to_slashes (moduleNameUserString mod)
 271   loc <- hiOnlyModLocation path basename hisuf
 272   addToFinderCache mod (loc, Nothing)
 273   return (Found loc HomePackage)
 274
 275 mkPackageModLocation pkg_info hisuf mod path basename _ext = do
 276   -- basename == dots_to_slashes (moduleNameUserString mod)
 277   loc <- hiOnlyModLocation path basename hisuf
 278   addToFinderCache mod (loc, pkg_info)
 279   return (Found loc (pkgInfoToId pkg_info))
 280
 281 hiOnlyModLocation path basename hisuf
 282  = do let full_basename = path++'/':basename
 283       obj_fn <- mkObjPath full_basename basename
 284       return ModLocation{    ml_hspp_file = Nothing,
 285                              ml_hspp_buf  = Nothing,
 286                              ml_hs_file   = Nothing,
 287                              ml_hi_file   = full_basename ++ '.':hisuf,
 288                                 -- Remove the .hi-boot suffix from
 289                                 -- hi_file, if it had one.  We always
 290                                 -- want the name of the real .hi file
 291                                 -- in the ml_hi_file field.
 292                              ml_obj_file  = obj_fn
 293                   }
 294
 295 -- -----------------------------------------------------------------------------
 296 -- Constructing a home module location
 297
 298 -- This is where we construct the ModLocation for a module in the home
 299 -- package, for which we have a source file.  It is called from three
 300 -- places:
 301 --
 302 --  (a) Here in the finder, when we are searching for a module to import,
 303 --      using the search path (-i option).
 304 --
 305 --  (b) The compilation manager, when constructing the ModLocation for
 306 --      a "root" module (a source file named explicitly on the command line
 307 --      or in a :load command in GHCi).
 308 --
 309 --  (c) The driver in one-shot mode, when we need to construct a
 310 --      ModLocation for a source file named on the command-line.
 311 --
 312 -- Parameters are:
 313 --
 314 -- mod
 315 --      The name of the module
 316 --
 317 -- path
 318 --      (a): The search path component where the source file was found.
 319 --      (b) and (c): "."
 320 --
 321 -- src_basename
 322 --      (a): dots_to_slashes (moduleNameUserString mod)
 323 --      (b) and (c): The filename of the source file, minus its extension
 324 --
 325 -- ext
 326 --      The filename extension of the source file (usually "hs" or "lhs").
 327
 328 mkHomeModLocation mod src_filename = do
 329    let (basename,extension) = splitFilename src_filename
 330    mkHomeModLocation' mod basename extension
 331
 332 mkHomeModLocationSearched mod path basename ext = do
 333    loc <- mkHomeModLocation' mod (path ++ '/':basename) ext
 334    return (Found loc HomePackage)
 335
 336 mkHomeModLocation' mod src_basename ext = do
 337    let mod_basename = dots_to_slashes (moduleUserString mod)
 338
 339    obj_fn <- mkObjPath src_basename mod_basename
 340    hi_fn  <- mkHiPath  src_basename mod_basename
 341
 342    let loc = ModLocation{ ml_hspp_file = Nothing,
 343                           ml_hspp_buf  = Nothing,
 344                           ml_hs_file   = Just (src_basename ++ '.':ext),
 345                           ml_hi_file   = hi_fn,
 346                           ml_obj_file  = obj_fn }
 347
 348    addToFinderCache mod (loc, Nothing)
 349    return loc
 350
 351 -- | Constructs the filename of a .o file for a given source file.
 352 -- Does /not/ check whether the .o file exists
 353 mkObjPath
 354   :: FilePath           -- the filename of the source file, minus the extension
 355   -> String             -- the module name with dots replaced by slashes
 356   -> IO FilePath
 357 mkObjPath basename mod_basename
 358   = do  odir   <- readIORef v_Output_dir
 359         osuf   <- readIORef v_Object_suf
 360
 361         let obj_basename | Just dir <- odir = dir ++ '/':mod_basename
 362                          | otherwise        = basename
 363
 364         return (obj_basename ++ '.':osuf)
 365
 366 -- | Constructs the filename of a .hi file for a given source file.
 367 -- Does /not/ check whether the .hi file exists
 368 mkHiPath
 369   :: FilePath           -- the filename of the source file, minus the extension
 370   -> String             -- the module name with dots replaced by slashes
 371   -> IO FilePath
 372 mkHiPath basename mod_basename
 373   = do  hidir   <- readIORef v_Hi_dir
 374         hisuf   <- readIORef v_Hi_suf
 375
 376         let hi_basename | Just dir <- hidir = dir ++ '/':mod_basename
 377                         | otherwise         = basename
 378
 379         return (hi_basename ++ '.':hisuf)
 380
 381
 382 --------------------
 383 hiBootFilePath :: ModLocation -> IO FilePath
 384 -- Return Foo.hi-boot, or Foo.hi-boot-n, as appropriate
 385 hiBootFilePath (ModLocation { ml_hi_file = hi_path })
 386   = do  { hi_ver_exists <- doesFileExist hi_boot_ver_path
 387         ; if hi_ver_exists then return hi_boot_ver_path
 388                            else return hi_boot_path }
 389   where
 390     hi_boot_path       = replaceFilenameSuffix hi_path hiBootExt ;
 391     hi_boot_ver_path   = replaceFilenameSuffix hi_path hiBootVerExt
 392
 393
 394 -- -----------------------------------------------------------------------------
 395 -- findLinkable isn't related to the other stuff in here,
 396 -- but there's no other obvious place for it
 397
 398 findLinkable :: Module -> ModLocation -> IO (Maybe Linkable)
 399 findLinkable mod locn
 400    = do let obj_fn = ml_obj_file locn
 401         obj_exist <- doesFileExist obj_fn
 402         if not obj_exist
 403          then return Nothing
 404          else
 405          do let stub_fn = case splitFilename3 obj_fn of
 406                              (dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o"
 407             stub_exist <- doesFileExist stub_fn
 408             obj_time <- getModificationTime obj_fn
 409             if stub_exist
 410              then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn]))
 411              else return (Just (LM obj_time mod [DotO obj_fn]))
 412
 413 -- -----------------------------------------------------------------------------
 414 -- Utils
 415
 416 dots_to_slashes = map (\c -> if c == '.' then '/' else c)
 417
 418 \end{code}