compiler/main/Finder.lhs

   1 %
   2 % (c) The University of Glasgow, 2000-2006
   3 %
   4 \section[Finder]{Module Finder}
   5
   6 \begin{code}
   7 module Finder (
   8     flushFinderCaches,
   9     FindResult(..),
  10     findImportedModule,
  11     findExactModule,
  12     findHomeModule,
  13     mkHomeModLocation,
  14     mkHomeModLocation2,
  15     mkHiOnlyModLocation,
  16     addHomeModuleToFinder,
  17     uncacheModule,
  18     mkStubPaths,
  19
  20     findObjectLinkableMaybe,
  21     findObjectLinkable,
  22
  23     cannotFindModule,
  24     cannotFindInterface,
  25
  26   ) where
  27
  28 #include "HsVersions.h"
  29
  30 import Module
  31 import HscTypes
  32 import Packages
  33 import FastString
  34 import Util
  35 import PrelNames        ( gHC_PRIM )
  36 import DynFlags         ( DynFlags(..), isOneShot, GhcMode(..) )
  37 import Outputable
  38 import FiniteMap
  39 import UniqFM
  40 import Maybes           ( expectJust )
  41
  42 import Data.IORef       ( IORef, writeIORef, readIORef, modifyIORef )
  43 import Data.List
  44 import System.Directory
  45 import System.IO
  46 import Control.Monad
  47 import System.Time      ( ClockTime )
  48
  49
  50 type FileExt = String   -- Filename extension
  51 type BaseName = String  -- Basename of file
  52
  53 -- -----------------------------------------------------------------------------
  54 -- The Finder
  55
  56 -- The Finder provides a thin filesystem abstraction to the rest of
  57 -- the compiler.  For a given module, it can tell you where the
  58 -- source, interface, and object files for that module live.
  59
  60 -- It does *not* know which particular package a module lives in.  Use
  61 -- Packages.lookupModuleInAllPackages for that.
  62
  63 -- -----------------------------------------------------------------------------
  64 -- The finder's cache
  65
  66 -- remove all the home modules from the cache; package modules are
  67 -- assumed to not move around during a session.
  68 flushFinderCaches :: HscEnv -> IO ()
  69 flushFinderCaches hsc_env = do
  70   writeIORef fc_ref emptyUFM
  71   flushModLocationCache this_pkg mlc_ref
  72  where
  73         this_pkg = thisPackage (hsc_dflags hsc_env)
  74         fc_ref = hsc_FC hsc_env
  75         mlc_ref = hsc_MLC hsc_env
  76
  77 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
  78 flushModLocationCache this_pkg ref = do
  79   fm <- readIORef ref
  80   writeIORef ref $! filterFM is_ext fm
  81   return ()
  82   where is_ext mod _ | modulePackageId mod /= this_pkg = True
  83                      | otherwise = False
  84
  85 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
  86 addToFinderCache       ref key val = modifyIORef ref $ \c -> addToUFM c key val
  87
  88 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
  89 addToModLocationCache  ref key val = modifyIORef ref $ \c -> addToFM c key val
  90
  91 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
  92 removeFromFinderCache      ref key = modifyIORef ref $ \c -> delFromUFM c key
  93
  94 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
  95 removeFromModLocationCache ref key = modifyIORef ref $ \c -> delFromFM c key
  96
  97 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
  98 lookupFinderCache ref key = do
  99    c <- readIORef ref
 100    return $! lookupUFM c key
 101
 102 lookupModLocationCache :: IORef ModLocationCache -> Module
 103                        -> IO (Maybe ModLocation)
 104 lookupModLocationCache ref key = do
 105    c <- readIORef ref
 106    return $! lookupFM c key
 107
 108 -- -----------------------------------------------------------------------------
 109 -- The two external entry points
 110
 111 -- | Locate a module that was imported by the user.  We have the
 112 -- module's name, and possibly a package name.  Without a package
 113 -- name, this function will use the search path and the known exposed
 114 -- packages to find the module, if a package is specified then only
 115 -- that package is searched for the module.
 116
 117 findImportedModule :: HscEnv -> ModuleName -> Maybe PackageId -> IO FindResult
 118 findImportedModule hsc_env mod_name mb_pkgid =
 119   case mb_pkgid of
 120         Nothing                    -> unqual_import
 121         Just pkg | pkg == this_pkg -> home_import
 122                  | otherwise       -> pkg_import pkg
 123   where
 124     dflags = hsc_dflags hsc_env
 125     this_pkg = thisPackage dflags
 126
 127     home_import     = findHomeModule hsc_env mod_name
 128
 129     pkg_import pkg  = findPackageModule hsc_env (mkModule pkg mod_name)
 130                         -- ToDo: this isn't quite right, the module we want
 131                         -- might actually be in another package, but re-exposed
 132                         -- ToDo: should return NotFoundInPackage if
 133                         -- the module isn't exposed by the package.
 134
 135     unqual_import   = home_import
 136                         `orIfNotFound`
 137                       findExposedPackageModule hsc_env mod_name
 138
 139 -- | Locate a specific 'Module'.  The purpose of this function is to
 140 -- create a 'ModLocation' for a given 'Module', that is to find out
 141 -- where the files associated with this module live.  It is used when
 142 -- reading the interface for a module mentioned by another interface,
 143 -- for example (a "system import").
 144
 145 findExactModule :: HscEnv -> Module -> IO FindResult
 146 findExactModule hsc_env mod =
 147    let dflags = hsc_dflags hsc_env in
 148    if modulePackageId mod == thisPackage dflags
 149         then findHomeModule hsc_env (moduleName mod)
 150         else findPackageModule hsc_env mod
 151
 152 -- -----------------------------------------------------------------------------
 153 -- Helpers
 154
 155 orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
 156 this `orIfNotFound` or_this = do
 157   res <- this
 158   case res of
 159     NotFound here _ -> do
 160         res2 <- or_this
 161         case res2 of
 162            NotFound or_here pkg -> return (NotFound (here ++ or_here) pkg)
 163            _other -> return res2
 164     _other -> return res
 165
 166
 167 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
 168 homeSearchCache hsc_env mod_name do_this = do
 169   m <- lookupFinderCache (hsc_FC hsc_env) mod_name
 170   case m of
 171     Just result -> return result
 172     Nothing     -> do
 173         result <- do_this
 174         addToFinderCache (hsc_FC hsc_env) mod_name result
 175         case result of
 176            Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
 177            _other        -> return ()
 178         return result
 179
 180 findExposedPackageModule :: HscEnv -> ModuleName -> IO FindResult
 181 findExposedPackageModule hsc_env mod_name
 182         -- not found in any package:
 183   | null found = return (NotFound [] Nothing)
 184         -- found in just one exposed package:
 185   | [(pkg_conf, _)] <- found_exposed
 186         = let pkgid = mkPackageId (package pkg_conf) in
 187           findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
 188         -- not found in any exposed package, report how it was hidden:
 189   | null found_exposed, ((pkg_conf, exposed_mod):_) <- found
 190         = let pkgid = mkPackageId (package pkg_conf) in
 191           if not (exposed_mod)
 192                 then return (ModuleHidden pkgid)
 193                 else return (PackageHidden pkgid)
 194   | otherwise
 195         = return (FoundMultiple (map (mkPackageId.package.fst) found_exposed))
 196   where
 197         dflags = hsc_dflags hsc_env
 198         found = lookupModuleInAllPackages dflags mod_name
 199         found_exposed = filter is_exposed found
 200         is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
 201
 202
 203 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
 204 modLocationCache hsc_env mod do_this = do
 205   mb_loc <- lookupModLocationCache mlc mod
 206   case mb_loc of
 207      Just loc -> return (Found loc mod)
 208      Nothing  -> do
 209         result <- do_this
 210         case result of
 211             Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
 212             _other -> return ()
 213         return result
 214   where
 215     mlc = hsc_MLC hsc_env
 216
 217 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
 218 addHomeModuleToFinder hsc_env mod_name loc = do
 219   let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
 220   addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
 221   addToModLocationCache (hsc_MLC hsc_env) mod loc
 222   return mod
 223
 224 uncacheModule :: HscEnv -> ModuleName -> IO ()
 225 uncacheModule hsc_env mod = do
 226   let this_pkg = thisPackage (hsc_dflags hsc_env)
 227   removeFromFinderCache (hsc_FC hsc_env) mod
 228   removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
 229
 230 -- -----------------------------------------------------------------------------
 231 --      The internal workers
 232
 233 -- | Search for a module in the home package only.
 234 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
 235 findHomeModule hsc_env mod_name =
 236    homeSearchCache hsc_env mod_name $
 237    let
 238      dflags = hsc_dflags hsc_env
 239      home_path = importPaths dflags
 240      hisuf = hiSuf dflags
 241      mod = mkModule (thisPackage dflags) mod_name
 242
 243      source_exts =
 244       [ ("hs",   mkHomeModLocationSearched dflags mod_name "hs")
 245       , ("lhs",  mkHomeModLocationSearched dflags mod_name "lhs")
 246       ]
 247
 248      hi_exts = [ (hisuf,                mkHiOnlyModLocation dflags hisuf)
 249                , (addBootSuffix hisuf,  mkHiOnlyModLocation dflags hisuf)
 250                ]
 251
 252         -- In compilation manager modes, we look for source files in the home
 253         -- package because we can compile these automatically.  In one-shot
 254         -- compilation mode we look for .hi and .hi-boot files only.
 255      exts | isOneShot (ghcMode dflags) = hi_exts
 256           | otherwise                  = source_exts
 257    in
 258
 259   -- special case for GHC.Prim; we won't find it in the filesystem.
 260   -- This is important only when compiling the base package (where GHC.Prim
 261   -- is a home module).
 262   if mod == gHC_PRIM
 263         then return (Found (error "GHC.Prim ModLocation") mod)
 264         else
 265
 266    searchPathExts home_path mod exts
 267
 268
 269 -- | Search for a module in external packages only.
 270 findPackageModule :: HscEnv -> Module -> IO FindResult
 271 findPackageModule hsc_env mod = do
 272   let
 273         dflags = hsc_dflags hsc_env
 274         pkg_id = modulePackageId mod
 275         pkg_map = pkgIdMap (pkgState dflags)
 276   --
 277   case lookupPackage pkg_map pkg_id of
 278      Nothing -> return (NoPackage pkg_id)
 279      Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
 280
 281 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
 282 findPackageModule_ hsc_env mod pkg_conf =
 283   modLocationCache hsc_env mod $
 284
 285   -- special case for GHC.Prim; we won't find it in the filesystem.
 286   if mod == gHC_PRIM
 287         then return (Found (error "GHC.Prim ModLocation") mod)
 288         else
 289
 290   let
 291      dflags = hsc_dflags hsc_env
 292      tag = buildTag dflags
 293
 294            -- hi-suffix for packages depends on the build tag.
 295      package_hisuf | null tag  = "hi"
 296                    | otherwise = tag ++ "_hi"
 297      hi_exts =
 298         [ (package_hisuf, mkHiOnlyModLocation dflags package_hisuf) ]
 299
 300      source_exts =
 301        [ ("hs",   mkHiOnlyModLocation dflags package_hisuf)
 302        , ("lhs",  mkHiOnlyModLocation dflags package_hisuf)
 303        ]
 304
 305      -- mkdependHS needs to look for source files in packages too, so
 306      -- that we can make dependencies between package before they have
 307      -- been built.
 308      exts
 309       | MkDepend <- ghcMode dflags = hi_exts ++ source_exts
 310       | otherwise                  = hi_exts
 311       -- we never look for a .hi-boot file in an external package;
 312       -- .hi-boot files only make sense for the home package.
 313   in
 314   searchPathExts (importDirs pkg_conf) mod exts
 315
 316 -- -----------------------------------------------------------------------------
 317 -- General path searching
 318
 319 searchPathExts
 320   :: [FilePath]         -- paths to search
 321   -> Module             -- module name
 322   -> [ (
 323         FileExt,                                -- suffix
 324         FilePath -> BaseName -> IO ModLocation  -- action
 325        )
 326      ]
 327   -> IO FindResult
 328
 329 searchPathExts paths mod exts
 330    = do result <- search to_search
 331 {-
 332         hPutStrLn stderr (showSDoc $
 333                 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
 334                     , nest 2 (vcat (map text paths))
 335                     , case result of
 336                         Succeeded (loc, p) -> text "Found" <+> ppr loc
 337                         Failed fs          -> text "not found"])
 338 -}
 339         return result
 340
 341   where
 342     basename = moduleNameSlashes (moduleName mod)
 343
 344     to_search :: [(FilePath, IO ModLocation)]
 345     to_search = [ (file, fn path basename)
 346                 | path <- paths,
 347                   (ext,fn) <- exts,
 348                   let base | path == "." = basename
 349                            | otherwise   = path `joinFileName` basename
 350                       file = base `joinFileExt` ext
 351                 ]
 352
 353     search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))
 354     search ((file, mk_result) : rest) = do
 355       b <- doesFileExist file
 356       if b
 357         then do { loc <- mk_result; return (Found loc mod) }
 358         else search rest
 359
 360 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
 361                           -> FilePath -> BaseName -> IO ModLocation
 362 mkHomeModLocationSearched dflags mod suff path basename = do
 363    mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff
 364
 365 -- -----------------------------------------------------------------------------
 366 -- Constructing a home module location
 367
 368 -- This is where we construct the ModLocation for a module in the home
 369 -- package, for which we have a source file.  It is called from three
 370 -- places:
 371 --
 372 --  (a) Here in the finder, when we are searching for a module to import,
 373 --      using the search path (-i option).
 374 --
 375 --  (b) The compilation manager, when constructing the ModLocation for
 376 --      a "root" module (a source file named explicitly on the command line
 377 --      or in a :load command in GHCi).
 378 --
 379 --  (c) The driver in one-shot mode, when we need to construct a
 380 --      ModLocation for a source file named on the command-line.
 381 --
 382 -- Parameters are:
 383 --
 384 -- mod
 385 --      The name of the module
 386 --
 387 -- path
 388 --      (a): The search path component where the source file was found.
 389 --      (b) and (c): "."
 390 --
 391 -- src_basename
 392 --      (a): (moduleNameSlashes mod)
 393 --      (b) and (c): The filename of the source file, minus its extension
 394 --
 395 -- ext
 396 --      The filename extension of the source file (usually "hs" or "lhs").
 397
 398 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
 399 mkHomeModLocation dflags mod src_filename = do
 400    let (basename,extension) = splitFilename src_filename
 401    mkHomeModLocation2 dflags mod basename extension
 402
 403 mkHomeModLocation2 :: DynFlags
 404                    -> ModuleName
 405                    -> FilePath  -- Of source module, without suffix
 406                    -> String    -- Suffix
 407                    -> IO ModLocation
 408 mkHomeModLocation2 dflags mod src_basename ext = do
 409    let mod_basename = moduleNameSlashes mod
 410
 411    obj_fn  <- mkObjPath  dflags src_basename mod_basename
 412    hi_fn   <- mkHiPath   dflags src_basename mod_basename
 413
 414    return (ModLocation{ ml_hs_file   = Just (src_basename `joinFileExt` ext),
 415                         ml_hi_file   = hi_fn,
 416                         ml_obj_file  = obj_fn })
 417
 418 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
 419                     -> IO ModLocation
 420 mkHiOnlyModLocation dflags hisuf path basename
 421  = do let full_basename = path `joinFileName` basename
 422       obj_fn  <- mkObjPath  dflags full_basename basename
 423       return ModLocation{    ml_hs_file   = Nothing,
 424                              ml_hi_file   = full_basename  `joinFileExt` hisuf,
 425                                 -- Remove the .hi-boot suffix from
 426                                 -- hi_file, if it had one.  We always
 427                                 -- want the name of the real .hi file
 428                                 -- in the ml_hi_file field.
 429                              ml_obj_file  = obj_fn
 430                   }
 431
 432 -- | Constructs the filename of a .o file for a given source file.
 433 -- Does /not/ check whether the .o file exists
 434 mkObjPath
 435   :: DynFlags
 436   -> FilePath           -- the filename of the source file, minus the extension
 437   -> String             -- the module name with dots replaced by slashes
 438   -> IO FilePath
 439 mkObjPath dflags basename mod_basename
 440   = do  let
 441                 odir = objectDir dflags
 442                 osuf = objectSuf dflags
 443
 444                 obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
 445                              | otherwise        = basename
 446
 447         return (obj_basename `joinFileExt` osuf)
 448
 449 -- | Constructs the filename of a .hi file for a given source file.
 450 -- Does /not/ check whether the .hi file exists
 451 mkHiPath
 452   :: DynFlags
 453   -> FilePath           -- the filename of the source file, minus the extension
 454   -> String             -- the module name with dots replaced by slashes
 455   -> IO FilePath
 456 mkHiPath dflags basename mod_basename
 457   = do  let
 458                 hidir = hiDir dflags
 459                 hisuf = hiSuf dflags
 460
 461                 hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename
 462                             | otherwise         = basename
 463
 464         return (hi_basename `joinFileExt` hisuf)
 465
 466
 467 -- -----------------------------------------------------------------------------
 468 -- Filenames of the stub files
 469
 470 -- We don't have to store these in ModLocations, because they can be derived
 471 -- from other available information, and they're only rarely needed.
 472
 473 mkStubPaths
 474   :: DynFlags
 475   -> ModuleName
 476   -> ModLocation
 477   -> (FilePath,FilePath,FilePath)
 478
 479 mkStubPaths dflags mod location
 480   = let
 481                 stubdir = stubDir dflags
 482
 483                 mod_basename = moduleNameSlashes mod
 484                 src_basename = basenameOf (expectJust "mkStubPaths"
 485                                                 (ml_hs_file location))
 486
 487                 stub_basename0
 488                         | Just dir <- stubdir = dir `joinFileName` mod_basename
 489                         | otherwise           = src_basename
 490
 491                 stub_basename = stub_basename0 ++ "_stub"
 492
 493                 -- this is the filename we're going to use when
 494                 -- #including the stub_h file from the .hc file.
 495                 -- Without -stubdir, we just #include the basename
 496                 -- (eg. for a module A.B, we #include "B_stub.h"),
 497                 -- relying on the fact that we add an implicit -I flag
 498                 -- for the directory in which the source file resides
 499                 -- (see DriverPipeline.hs).  With -stubdir, we
 500                 -- #include "A/B.h", assuming that the user has added
 501                 -- -I<dir> along with -stubdir <dir>.
 502                 include_basename
 503                         | Just _ <- stubdir = mod_basename
 504                         | otherwise         = filenameOf src_basename
 505      in
 506         (stub_basename `joinFileExt` "c",
 507          stub_basename `joinFileExt` "h",
 508          (include_basename ++ "_stub") `joinFileExt` "h")
 509         -- the _stub.o filename is derived from the ml_obj_file.
 510
 511 -- -----------------------------------------------------------------------------
 512 -- findLinkable isn't related to the other stuff in here,
 513 -- but there's no other obvious place for it
 514
 515 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
 516 findObjectLinkableMaybe mod locn
 517    = do let obj_fn = ml_obj_file locn
 518         maybe_obj_time <- modificationTimeIfExists obj_fn
 519         case maybe_obj_time of
 520           Nothing -> return Nothing
 521           Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
 522
 523 -- Make an object linkable when we know the object file exists, and we know
 524 -- its modification time.
 525 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
 526 findObjectLinkable mod obj_fn obj_time = do
 527   let stub_fn = case splitFilename3 obj_fn of
 528                         (dir, base, _ext) -> dir ++ "/" ++ base ++ "_stub.o"
 529   stub_exist <- doesFileExist stub_fn
 530   if stub_exist
 531         then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
 532         else return (LM obj_time mod [DotO obj_fn])
 533
 534 -- -----------------------------------------------------------------------------
 535 -- Error messages
 536
 537 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
 538 cannotFindModule = cantFindErr SLIT("Could not find module")
 539
 540 cannotFindInterface  :: DynFlags -> ModuleName -> FindResult -> SDoc
 541 cannotFindInterface = cantFindErr SLIT("Failed to load interface for")
 542
 543 cantFindErr :: LitString -> DynFlags -> ModuleName -> FindResult -> SDoc
 544 cantFindErr cannot_find _dflags mod_name (FoundMultiple pkgs)
 545   = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon) 2 (
 546        sep [ptext SLIT("it was found in multiple packages:"),
 547                 hsep (map (text.packageIdString) pkgs)]
 548     )
 549 cantFindErr cannot_find dflags mod_name find_result
 550   = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon)
 551        2 more_info
 552   where
 553     more_info
 554       = case find_result of
 555             PackageHidden pkg
 556                 -> ptext SLIT("it is a member of package") <+> ppr pkg <> comma
 557                    <+> ptext SLIT("which is hidden")
 558
 559             ModuleHidden pkg
 560                 -> ptext SLIT("it is hidden") <+> parens (ptext SLIT("in package")
 561                    <+> ppr pkg)
 562
 563             NoPackage pkg
 564                 -> ptext SLIT("no package matching") <+> ppr pkg <+>
 565                    ptext SLIT("was found")
 566
 567             NotFound files mb_pkg
 568                 | null files
 569                 -> ptext SLIT("it is not a module in the current program, or in any known package.")
 570                 | Just pkg <- mb_pkg, pkg /= thisPackage dflags, build_tag /= ""
 571                 -> let
 572                      build = if build_tag == "p" then "profiling"
 573                                                  else "\"" ++ build_tag ++ "\""
 574                    in
 575                    ptext SLIT("Perhaps you haven't installed the ") <> text build <>
 576                    ptext SLIT(" libraries for package ") <> ppr pkg <> char '?' $$
 577                    not_found files
 578
 579                 | otherwise
 580                 -> not_found files
 581
 582             NotFoundInPackage pkg
 583                 -> ptext SLIT("it is not in package") <+> ppr pkg
 584
 585             _ -> panic "cantFindErr"
 586
 587     build_tag = buildTag dflags
 588
 589     not_found files
 590         | verbosity dflags < 3
 591         = ptext SLIT("Use -v to see a list of the files searched for.")
 592         | otherwise
 593         = hang (ptext SLIT("locations searched:")) 2 (vcat (map text files))
 594 \end{code}