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