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