compiler/main/Finder.lhs

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