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     mkHomeModLocation2,         -- :: ModuleName -> FilePath -> String -> IO ModLocation
  14     addHomeModuleToFinder,      -- :: HscEnv -> Module -> ModLocation -> IO ()
  15     uncacheModule,              -- :: HscEnv -> Module -> IO ()
  16     mkStubPaths,
  17
  18     findObjectLinkableMaybe,
  19     findObjectLinkable,
  20
  21     cantFindError,      -- :: DynFlags -> Module -> FindResult -> SDoc
  22   ) where
  23
  24 #include "HsVersions.h"
  25
  26 import Module
  27 import UniqFM           ( filterUFM, delFromUFM )
  28 import HscTypes
  29 import Packages
  30 import FastString
  31 import Util
  32 import DynFlags         ( DynFlags(..), isOneShot, GhcMode(..) )
  33 import Outputable
  34 import Maybes           ( expectJust )
  35
  36 import DATA_IOREF       ( IORef, writeIORef, readIORef )
  37
  38 import Data.List
  39 import System.Directory
  40 import System.IO
  41 import Control.Monad
  42 import Data.Maybe       ( isNothing )
  43 import Time             ( ClockTime )
  44
  45
  46 type FileExt = String   -- Filename extension
  47 type BaseName = String  -- Basename of file
  48
  49 -- -----------------------------------------------------------------------------
  50 -- The Finder
  51
  52 -- The Finder provides a thin filesystem abstraction to the rest of
  53 -- the compiler.  For a given module, it can tell you where the
  54 -- source, interface, and object files for that module live.
  55
  56 -- It does *not* know which particular package a module lives in.  Use
  57 -- Packages.lookupModuleInAllPackages for that.
  58
  59 -- -----------------------------------------------------------------------------
  60 -- The finder's cache
  61
  62 -- remove all the home modules from the cache; package modules are
  63 -- assumed to not move around during a session.
  64 flushFinderCache :: IORef FinderCache -> IO ()
  65 flushFinderCache finder_cache = do
  66   fm <- readIORef finder_cache
  67   writeIORef finder_cache $! filterUFM (\(loc,m) -> isNothing m) fm
  68
  69 addToFinderCache :: IORef FinderCache -> Module -> FinderCacheEntry -> IO ()
  70 addToFinderCache finder_cache mod_name entry = do
  71   fm <- readIORef finder_cache
  72   writeIORef finder_cache $! extendModuleEnv fm mod_name entry
  73
  74 removeFromFinderCache :: IORef FinderCache -> Module -> IO ()
  75 removeFromFinderCache finder_cache mod_name = do
  76   fm <- readIORef finder_cache
  77   writeIORef finder_cache $! delFromUFM fm mod_name
  78
  79 lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FinderCacheEntry)
  80 lookupFinderCache finder_cache mod_name = do
  81   fm <- readIORef finder_cache
  82   return $! lookupModuleEnv fm mod_name
  83
  84 -- -----------------------------------------------------------------------------
  85 -- The two external entry points
  86
  87 -- This is the main interface to the finder, which maps ModuleNames to
  88 -- Modules and ModLocations.
  89 --
  90 -- The Module contains one crucial bit of information about a module:
  91 -- whether it lives in the current ("home") package or not (see Module
  92 -- for more details).
  93 --
  94 -- The ModLocation contains the names of all the files associated with
  95 -- that module: its source file, .hi file, object file, etc.
  96
  97 data FindResult
  98   = Found ModLocation PackageIdH
  99         -- the module was found
 100   | FoundMultiple [PackageId]
 101         -- *error*: both in multiple packages
 102   | PackageHidden PackageId
 103         -- for an explicit source import: the package containing the module is
 104         -- not exposed.
 105   | ModuleHidden  PackageId
 106         -- for an explicit source import: the package containing the module is
 107         -- exposed, but the module itself is hidden.
 108   | NotFound [FilePath]
 109         -- the module was not found, the specified places were searched.
 110
 111 findModule :: HscEnv -> Module -> Bool -> IO FindResult
 112 findModule = findModule' True
 113
 114 findPackageModule :: HscEnv -> Module -> Bool -> IO FindResult
 115 findPackageModule = findModule' False
 116
 117
 118 data LocalFindResult
 119   = Ok FinderCacheEntry
 120   | CantFindAmongst [FilePath]
 121   | MultiplePackages [PackageId]
 122
 123 findModule' :: Bool -> HscEnv -> Module -> Bool -> IO FindResult
 124 findModule' home_allowed hsc_env name explicit
 125   = do  -- First try the cache
 126   mb_entry <- lookupFinderCache cache name
 127   case mb_entry of
 128      Just old_entry -> return $! found old_entry
 129      Nothing        -> not_cached
 130
 131  where
 132   cache  = hsc_FC hsc_env
 133   dflags = hsc_dflags hsc_env
 134
 135         -- We've found the module, so the remaining question is
 136         -- whether it's visible or not
 137   found :: FinderCacheEntry -> FindResult
 138   found (loc, Nothing)
 139         | home_allowed  = Found loc HomePackage
 140         | otherwise     = NotFound []
 141   found (loc, Just (pkg, exposed_mod))
 142         | explicit && not exposed_mod   = ModuleHidden pkg_name
 143         | explicit && not (exposed pkg) = PackageHidden pkg_name
 144         | otherwise =
 145                 Found loc (ExtPackage (mkPackageId (package pkg)))
 146         where
 147           pkg_name = packageConfigId pkg
 148
 149   found_new entry = do
 150         addToFinderCache cache name entry
 151         return $! found entry
 152
 153   not_cached
 154         | not home_allowed = do
 155             j <- findPackageModule' dflags name
 156             case j of
 157                Ok entry              -> found_new entry
 158                MultiplePackages pkgs -> return (FoundMultiple pkgs)
 159                CantFindAmongst paths -> return (NotFound paths)
 160
 161         | otherwise = do
 162             j <- findHomeModule' dflags name
 163             case j of
 164                 Ok entry              -> found_new entry
 165                 MultiplePackages pkgs -> return (FoundMultiple pkgs)
 166                 CantFindAmongst home_files -> do
 167                     r <- findPackageModule' dflags name
 168                     case r of
 169                         CantFindAmongst pkg_files ->
 170                                 return (NotFound (home_files ++ pkg_files))
 171                         MultiplePackages pkgs ->
 172                                 return (FoundMultiple pkgs)
 173                         Ok entry ->
 174                                 found_new entry
 175
 176 addHomeModuleToFinder :: HscEnv -> Module -> ModLocation -> IO ()
 177 addHomeModuleToFinder hsc_env mod loc
 178   = addToFinderCache (hsc_FC hsc_env) mod (loc, Nothing)
 179
 180 uncacheModule :: HscEnv -> Module -> IO ()
 181 uncacheModule hsc_env mod = removeFromFinderCache (hsc_FC hsc_env) mod
 182
 183 -- -----------------------------------------------------------------------------
 184 --      The internal workers
 185
 186 findHomeModule' :: DynFlags -> Module -> IO LocalFindResult
 187 findHomeModule' dflags mod = do
 188    let home_path = importPaths dflags
 189        hisuf = hiSuf dflags
 190
 191    let
 192      source_exts =
 193       [ ("hs",   mkHomeModLocationSearched dflags mod "hs")
 194       , ("lhs",  mkHomeModLocationSearched dflags  mod "lhs")
 195       ]
 196
 197      hi_exts = [ (hisuf,                mkHiOnlyModLocation dflags hisuf)
 198                , (addBootSuffix hisuf,  mkHiOnlyModLocation dflags hisuf)
 199                ]
 200
 201         -- In compilation manager modes, we look for source files in the home
 202         -- package because we can compile these automatically.  In one-shot
 203         -- compilation mode we look for .hi and .hi-boot files only.
 204      exts | isOneShot (ghcMode dflags) = hi_exts
 205           | otherwise                  = source_exts
 206
 207    searchPathExts home_path mod exts
 208
 209 findPackageModule' :: DynFlags -> Module -> IO LocalFindResult
 210 findPackageModule' dflags mod
 211   = case lookupModuleInAllPackages dflags mod of
 212         []          -> return (CantFindAmongst [])
 213         [pkg_info]  -> findPackageIface dflags mod pkg_info
 214         many        -> return (MultiplePackages (map (mkPackageId.package.fst) many))
 215
 216 findPackageIface :: DynFlags -> Module -> (PackageConfig,Bool) -> IO LocalFindResult
 217 findPackageIface dflags mod pkg_info@(pkg_conf, _) = do
 218   let
 219      tag = buildTag dflags
 220
 221            -- hi-suffix for packages depends on the build tag.
 222      package_hisuf | null tag  = "hi"
 223                    | otherwise = tag ++ "_hi"
 224      hi_exts =
 225         [ (package_hisuf,
 226             mkPackageModLocation dflags pkg_info package_hisuf) ]
 227
 228      source_exts =
 229        [ ("hs",   mkPackageModLocation dflags pkg_info package_hisuf)
 230        , ("lhs",  mkPackageModLocation dflags pkg_info package_hisuf)
 231        ]
 232
 233      -- mkdependHS needs to look for source files in packages too, so
 234      -- that we can make dependencies between package before they have
 235      -- been built.
 236      exts
 237       | MkDepend <- ghcMode dflags = hi_exts ++ source_exts
 238       | otherwise                  = hi_exts
 239       -- we never look for a .hi-boot file in an external package;
 240       -- .hi-boot files only make sense for the home package.
 241
 242   searchPathExts (importDirs pkg_conf) mod exts
 243
 244 -- -----------------------------------------------------------------------------
 245 -- General path searching
 246
 247 searchPathExts
 248   :: [FilePath]         -- paths to search
 249   -> Module             -- module name
 250   -> [ (
 251         FileExt,                                     -- suffix
 252         FilePath -> BaseName -> IO FinderCacheEntry  -- action
 253        )
 254      ]
 255   -> IO LocalFindResult
 256
 257 searchPathExts paths mod exts
 258    = do result <- search to_search
 259 {-
 260         hPutStrLn stderr (showSDoc $
 261                 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
 262                     , nest 2 (vcat (map text paths))
 263                     , case result of
 264                         Succeeded (loc, p) -> text "Found" <+> ppr loc
 265                         Failed fs          -> text "not found"])
 266 -}
 267         return result
 268
 269   where
 270     basename = dots_to_slashes (moduleString mod)
 271
 272     to_search :: [(FilePath, IO FinderCacheEntry)]
 273     to_search = [ (file, fn path basename)
 274                 | path <- paths,
 275                   (ext,fn) <- exts,
 276                   let base | path == "." = basename
 277                            | otherwise   = path `joinFileName` basename
 278                       file = base `joinFileExt` ext
 279                 ]
 280
 281     search [] = return (CantFindAmongst (map fst to_search))
 282     search ((file, mk_result) : rest) = do
 283       b <- doesFileExist file
 284       if b
 285         then do { res <- mk_result; return (Ok res) }
 286         else search rest
 287
 288 mkHomeModLocationSearched :: DynFlags -> Module -> FileExt
 289                           -> FilePath -> BaseName -> IO FinderCacheEntry
 290 mkHomeModLocationSearched dflags mod suff path basename = do
 291    loc <- mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff
 292    return (loc, Nothing)
 293
 294 mkHiOnlyModLocation :: DynFlags -> FileExt -> FilePath -> BaseName
 295                     -> IO FinderCacheEntry
 296 mkHiOnlyModLocation dflags hisuf path basename = do
 297   loc <- hiOnlyModLocation dflags path basename hisuf
 298   return (loc, Nothing)
 299
 300 mkPackageModLocation :: DynFlags -> (PackageConfig, Bool) -> FileExt
 301                      -> FilePath -> BaseName -> IO FinderCacheEntry
 302 mkPackageModLocation dflags pkg_info hisuf path basename = do
 303   loc <- hiOnlyModLocation dflags path basename hisuf
 304   return (loc, Just pkg_info)
 305
 306 -- -----------------------------------------------------------------------------
 307 -- Constructing a home module location
 308
 309 -- This is where we construct the ModLocation for a module in the home
 310 -- package, for which we have a source file.  It is called from three
 311 -- places:
 312 --
 313 --  (a) Here in the finder, when we are searching for a module to import,
 314 --      using the search path (-i option).
 315 --
 316 --  (b) The compilation manager, when constructing the ModLocation for
 317 --      a "root" module (a source file named explicitly on the command line
 318 --      or in a :load command in GHCi).
 319 --
 320 --  (c) The driver in one-shot mode, when we need to construct a
 321 --      ModLocation for a source file named on the command-line.
 322 --
 323 -- Parameters are:
 324 --
 325 -- mod
 326 --      The name of the module
 327 --
 328 -- path
 329 --      (a): The search path component where the source file was found.
 330 --      (b) and (c): "."
 331 --
 332 -- src_basename
 333 --      (a): dots_to_slashes (moduleNameUserString mod)
 334 --      (b) and (c): The filename of the source file, minus its extension
 335 --
 336 -- ext
 337 --      The filename extension of the source file (usually "hs" or "lhs").
 338
 339 mkHomeModLocation :: DynFlags -> Module -> FilePath -> IO ModLocation
 340 mkHomeModLocation dflags mod src_filename = do
 341    let (basename,extension) = splitFilename src_filename
 342    mkHomeModLocation2 dflags mod basename extension
 343
 344 mkHomeModLocation2 :: DynFlags
 345                    -> Module
 346                    -> FilePath  -- Of source module, without suffix
 347                    -> String    -- Suffix
 348                    -> IO ModLocation
 349 mkHomeModLocation2 dflags mod src_basename ext = do
 350    let mod_basename = dots_to_slashes (moduleString mod)
 351
 352    obj_fn  <- mkObjPath  dflags src_basename mod_basename
 353    hi_fn   <- mkHiPath   dflags src_basename mod_basename
 354
 355    return (ModLocation{ ml_hs_file   = Just (src_basename `joinFileExt` ext),
 356                         ml_hi_file   = hi_fn,
 357                         ml_obj_file  = obj_fn })
 358
 359 hiOnlyModLocation :: DynFlags -> FilePath -> String -> Suffix -> IO ModLocation
 360 hiOnlyModLocation dflags path basename hisuf
 361  = do let full_basename = path `joinFileName` basename
 362       obj_fn  <- mkObjPath  dflags full_basename basename
 363       return ModLocation{    ml_hs_file   = Nothing,
 364                              ml_hi_file   = full_basename  `joinFileExt` hisuf,
 365                                 -- Remove the .hi-boot suffix from
 366                                 -- hi_file, if it had one.  We always
 367                                 -- want the name of the real .hi file
 368                                 -- in the ml_hi_file field.
 369                              ml_obj_file  = obj_fn
 370                   }
 371
 372 -- | Constructs the filename of a .o file for a given source file.
 373 -- Does /not/ check whether the .o file exists
 374 mkObjPath
 375   :: DynFlags
 376   -> FilePath           -- the filename of the source file, minus the extension
 377   -> String             -- the module name with dots replaced by slashes
 378   -> IO FilePath
 379 mkObjPath dflags basename mod_basename
 380   = do  let
 381                 odir = objectDir dflags
 382                 osuf = objectSuf dflags
 383
 384                 obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
 385                              | otherwise        = basename
 386
 387         return (obj_basename `joinFileExt` osuf)
 388
 389 -- | Constructs the filename of a .hi file for a given source file.
 390 -- Does /not/ check whether the .hi file exists
 391 mkHiPath
 392   :: DynFlags
 393   -> FilePath           -- the filename of the source file, minus the extension
 394   -> String             -- the module name with dots replaced by slashes
 395   -> IO FilePath
 396 mkHiPath dflags basename mod_basename
 397   = do  let
 398                 hidir = hiDir dflags
 399                 hisuf = hiSuf dflags
 400
 401                 hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename
 402                             | otherwise         = basename
 403
 404         return (hi_basename `joinFileExt` hisuf)
 405
 406
 407 -- -----------------------------------------------------------------------------
 408 -- Filenames of the stub files
 409
 410 -- We don't have to store these in ModLocations, because they can be derived
 411 -- from other available information, and they're only rarely needed.
 412
 413 mkStubPaths
 414   :: DynFlags
 415   -> Module
 416   -> ModLocation
 417   -> (FilePath,FilePath)
 418
 419 mkStubPaths dflags mod location
 420   = let
 421                 stubdir = stubDir dflags
 422
 423                 mod_basename = dots_to_slashes (moduleString mod)
 424                 src_basename = basenameOf (expectJust "mkStubPaths"
 425                                                 (ml_hs_file location))
 426
 427                 stub_basename0
 428                         | Just dir <- stubdir = dir `joinFileName` mod_basename
 429                         | otherwise           = src_basename
 430
 431                 stub_basename = stub_basename0 ++ "_stub"
 432      in
 433         (stub_basename `joinFileExt` "c",
 434          stub_basename `joinFileExt` "h")
 435         -- the _stub.o filename is derived from the ml_obj_file.
 436
 437 -- -----------------------------------------------------------------------------
 438 -- findLinkable isn't related to the other stuff in here,
 439 -- but there's no other obvious place for it
 440
 441 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
 442 findObjectLinkableMaybe mod locn
 443    = do let obj_fn = ml_obj_file locn
 444         maybe_obj_time <- modificationTimeIfExists obj_fn
 445         case maybe_obj_time of
 446           Nothing -> return Nothing
 447           Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
 448
 449 -- Make an object linkable when we know the object file exists, and we know
 450 -- its modification time.
 451 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
 452 findObjectLinkable mod obj_fn obj_time = do
 453   let stub_fn = case splitFilename3 obj_fn of
 454                         (dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o"
 455   stub_exist <- doesFileExist stub_fn
 456   if stub_exist
 457         then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
 458         else return (LM obj_time mod [DotO obj_fn])
 459
 460 -- -----------------------------------------------------------------------------
 461 -- Utils
 462
 463 dots_to_slashes = map (\c -> if c == '.' then '/' else c)
 464
 465
 466 -- -----------------------------------------------------------------------------
 467 -- Error messages
 468
 469 cantFindError :: DynFlags -> Module -> FindResult -> SDoc
 470 cantFindError dflags mod_name (FoundMultiple pkgs)
 471   = hang (ptext SLIT("Cannot import") <+> quotes (ppr mod_name) <> colon) 2 (
 472        sep [ptext SLIT("it was found in multiple packages:"),
 473                 hsep (map (text.packageIdString) pkgs)]
 474     )
 475 cantFindError dflags mod_name find_result
 476   = hang (ptext SLIT("Could not find module") <+> quotes (ppr mod_name) <> colon)
 477        2 more_info
 478   where
 479     more_info
 480       = case find_result of
 481             PackageHidden pkg
 482                 -> ptext SLIT("it is a member of package") <+> ppr pkg <> comma
 483                    <+> ptext SLIT("which is hidden")
 484
 485             ModuleHidden pkg
 486                 -> ptext SLIT("it is hidden") <+> parens (ptext SLIT("in package")
 487                    <+> ppr pkg)
 488
 489             NotFound files
 490                 | null files
 491                 -> ptext SLIT("it is not a module in the current program, or in any known package.")
 492                 | verbosity dflags < 3
 493                 -> ptext SLIT("use -v to see a list of the files searched for")
 494                 | otherwise
 495                 -> hang (ptext SLIT("locations searched:"))
 496                       2 (vcat (map text files))
 497
 498             _ -> panic "cantFindErr"
 499 \end{code}