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