Finder.lhs 26.3 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow, 2000-2006
3 4 5 6
%
\section[Finder]{Module Finder}

\begin{code}
7 8
{-# LANGUAGE CPP #-}

9
module Finder (
Simon Marlow's avatar
Simon Marlow committed
10
    flushFinderCaches,
11
    FindResult(..),
Simon Marlow's avatar
Simon Marlow committed
12 13 14
    findImportedModule,
    findExactModule,
    findHomeModule,
15
    findExposedPackageModule,
Simon Marlow's avatar
Simon Marlow committed
16 17
    mkHomeModLocation,
    mkHomeModLocation2,
18
    mkHiOnlyModLocation,
Simon Marlow's avatar
Simon Marlow committed
19 20
    addHomeModuleToFinder,
    uncacheModule,
21
    mkStubPaths,
22

23 24
    findObjectLinkableMaybe,
    findObjectLinkable,
25

26 27
    cannotFindModule,
    cannotFindInterface,
28

29 30
  ) where

31 32
#include "HsVersions.h"

33
import Module
34
import HscTypes
35
import Packages
36
import FastString
37
import Util
Simon Marlow's avatar
Simon Marlow committed
38
import PrelNames        ( gHC_PRIM )
39
import DynFlags
40
import Outputable
41
import UniqFM
42
import Maybes           ( expectJust )
43
import Exception        ( evaluate )
44

45
import Data.IORef       ( IORef, writeIORef, readIORef, atomicModifyIORef )
46
import System.Directory
Ian Lynagh's avatar
Ian Lynagh committed
47
import System.FilePath
48
import Control.Monad
49
import Data.Time
50
import Data.List        ( foldl' )
51

52

53 54
type FileExt = String   -- Filename extension
type BaseName = String  -- Basename of file
55

56 57
-- -----------------------------------------------------------------------------
-- The Finder
58

59 60 61
-- The Finder provides a thin filesystem abstraction to the rest of
-- the compiler.  For a given module, it can tell you where the
-- source, interface, and object files for that module live.
62

63
-- It does *not* know which particular package a module lives in.  Use
64
-- Packages.lookupModuleInAllPackages for that.
65

66 67 68 69 70
-- -----------------------------------------------------------------------------
-- The finder's cache

-- remove all the home modules from the cache; package modules are
-- assumed to not move around during a session.
Simon Marlow's avatar
Simon Marlow committed
71 72
flushFinderCaches :: HscEnv -> IO ()
flushFinderCaches hsc_env = do
73
  -- Ideally the update to both caches be a single atomic operation.
Simon Marlow's avatar
Simon Marlow committed
74 75 76
  writeIORef fc_ref emptyUFM
  flushModLocationCache this_pkg mlc_ref
 where
77 78 79
        this_pkg = thisPackage (hsc_dflags hsc_env)
        fc_ref = hsc_FC hsc_env
        mlc_ref = hsc_MLC hsc_env
Simon Marlow's avatar
Simon Marlow committed
80

81
flushModLocationCache :: PackageKey -> IORef ModLocationCache -> IO ()
Simon Marlow's avatar
Simon Marlow committed
82
flushModLocationCache this_pkg ref = do
83
  atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
84
  _ <- evaluate =<< readIORef ref
Simon Marlow's avatar
Simon Marlow committed
85
  return ()
86
  where is_ext mod _ | modulePackageKey mod /= this_pkg = True
87
                     | otherwise = False
Simon Marlow's avatar
Simon Marlow committed
88

Simon Marlow's avatar
Simon Marlow committed
89
addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
90 91
addToFinderCache ref key val =
  atomicModifyIORef ref $ \c -> (addToUFM c key val, ())
Simon Marlow's avatar
Simon Marlow committed
92 93

addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
94
addToModLocationCache ref key val =
95
  atomicModifyIORef ref $ \c -> (extendModuleEnv c key val, ())
Simon Marlow's avatar
Simon Marlow committed
96

Simon Marlow's avatar
Simon Marlow committed
97
removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
98 99
removeFromFinderCache ref key =
  atomicModifyIORef ref $ \c -> (delFromUFM c key, ())
Simon Marlow's avatar
Simon Marlow committed
100 101

removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
102
removeFromModLocationCache ref key =
103
  atomicModifyIORef ref $ \c -> (delModuleEnv c key, ())
Simon Marlow's avatar
Simon Marlow committed
104

Simon Marlow's avatar
Simon Marlow committed
105
lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
106
lookupFinderCache ref key = do
Simon Marlow's avatar
Simon Marlow committed
107 108 109
   c <- readIORef ref
   return $! lookupUFM c key

Simon Marlow's avatar
Simon Marlow committed
110 111
lookupModLocationCache :: IORef ModLocationCache -> Module
                       -> IO (Maybe ModLocation)
Simon Marlow's avatar
Simon Marlow committed
112 113
lookupModLocationCache ref key = do
   c <- readIORef ref
114
   return $! lookupModuleEnv c key
115 116

-- -----------------------------------------------------------------------------
117
-- The two external entry points
118

Simon Marlow's avatar
Simon Marlow committed
119 120 121 122 123 124
-- | Locate a module that was imported by the user.  We have the
-- module's name, and possibly a package name.  Without a package
-- name, this function will use the search path and the known exposed
-- packages to find the module, if a package is specified then only
-- that package is searched for the module.

125 126 127
findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule hsc_env mod_name mb_pkg =
  case mb_pkg of
128 129 130
        Nothing                        -> unqual_import
        Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
                 | otherwise           -> pkg_import
Simon Marlow's avatar
Simon Marlow committed
131
  where
132
    home_import   = findHomeModule hsc_env mod_name
Simon Marlow's avatar
Simon Marlow committed
133

134
    pkg_import    = findExposedPackageModule hsc_env mod_name mb_pkg
Simon Marlow's avatar
Simon Marlow committed
135

136 137 138
    unqual_import = home_import
                    `orIfNotFound`
                    findExposedPackageModule hsc_env mod_name Nothing
Simon Marlow's avatar
Simon Marlow committed
139 140 141 142

-- | Locate a specific 'Module'.  The purpose of this function is to
-- create a 'ModLocation' for a given 'Module', that is to find out
-- where the files associated with this module live.  It is used when
143
-- reading the interface for a module mentioned by another interface,
Simon Marlow's avatar
Simon Marlow committed
144 145 146 147
-- for example (a "system import").

findExactModule :: HscEnv -> Module -> IO FindResult
findExactModule hsc_env mod =
148
    let dflags = hsc_dflags hsc_env
149
    in if modulePackageKey mod == thisPackage dflags
150 151
       then findHomeModule hsc_env (moduleName mod)
       else findPackageModule hsc_env mod
152

Simon Marlow's avatar
Simon Marlow committed
153 154 155
-- -----------------------------------------------------------------------------
-- Helpers

Simon Marlow's avatar
Simon Marlow committed
156
orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
157
orIfNotFound this or_this = do
Simon Marlow's avatar
Simon Marlow committed
158 159
  res <- this
  case res of
160 161 162 163 164 165 166 167 168 169 170 171
    NotFound { fr_paths = paths1, fr_mods_hidden = mh1
             , fr_pkgs_hidden = ph1, fr_suggestions = s1 }
     -> do res2 <- or_this
           case res2 of
             NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
                      , fr_pkgs_hidden = ph2, fr_suggestions = s2 }
              -> return (NotFound { fr_paths = paths1 ++ paths2
                                  , fr_pkg = mb_pkg2 -- snd arg is the package search
                                  , fr_mods_hidden = mh1 ++ mh2
                                  , fr_pkgs_hidden = ph1 ++ ph2
                                  , fr_suggestions = s1  ++ s2 })
             _other -> return res2
Simon Marlow's avatar
Simon Marlow committed
172 173
    _other -> return res

174 175 176 177 178 179
-- | Helper function for 'findHomeModule': this function wraps an IO action
-- which would look up @mod_name@ in the file system (the home package),
-- and first consults the 'hsc_FC' cache to see if the lookup has already
-- been done.  Otherwise, do the lookup (with the IO action) and save
-- the result in the finder cache and the module location cache (if it
-- was successful.)
Simon Marlow's avatar
Simon Marlow committed
180 181 182
homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
homeSearchCache hsc_env mod_name do_this = do
  m <- lookupFinderCache (hsc_FC hsc_env) mod_name
183
  case m of
Simon Marlow's avatar
Simon Marlow committed
184 185
    Just result -> return result
    Nothing     -> do
186 187 188 189 190 191
        result <- do_this
        addToFinderCache (hsc_FC hsc_env) mod_name result
        case result of
           Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
           _other        -> return ()
        return result
Simon Marlow's avatar
Simon Marlow committed
192

193 194 195
findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
                         -> IO FindResult
findExposedPackageModule hsc_env mod_name mb_pkg
196 197 198 199
  = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of
     LookupFound m pkg_conf ->
       findPackageModule_ hsc_env m pkg_conf
     LookupMultiple rs ->
200
       return (FoundMultiple rs)
201
     LookupHidden pkg_hiddens mod_hiddens ->
202 203 204 205
       return (NotFound{ fr_paths = [], fr_pkg = Nothing
                       , fr_pkgs_hidden = map (modulePackageKey.fst) pkg_hiddens
                       , fr_mods_hidden = map (modulePackageKey.fst) mod_hiddens
                       , fr_suggestions = [] })
206
     LookupNotFound suggest ->
207 208 209 210
       return (NotFound{ fr_paths = [], fr_pkg = Nothing
                       , fr_pkgs_hidden = []
                       , fr_mods_hidden = []
                       , fr_suggestions = suggest })
Simon Marlow's avatar
Simon Marlow committed
211 212 213 214 215 216 217 218

modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
modLocationCache hsc_env mod do_this = do
  mb_loc <- lookupModLocationCache mlc mod
  case mb_loc of
     Just loc -> return (Found loc mod)
     Nothing  -> do
        result <- do_this
219 220 221 222
        case result of
            Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
            _other -> return ()
        return result
Simon Marlow's avatar
Simon Marlow committed
223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
  where
    mlc = hsc_MLC hsc_env

addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder hsc_env mod_name loc = do
  let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
  addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
  addToModLocationCache (hsc_MLC hsc_env) mod loc
  return mod

uncacheModule :: HscEnv -> ModuleName -> IO ()
uncacheModule hsc_env mod = do
  let this_pkg = thisPackage (hsc_dflags hsc_env)
  removeFromFinderCache (hsc_FC hsc_env) mod
  removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
238 239

-- -----------------------------------------------------------------------------
240
--      The internal workers
241

242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
-- | Implements the search for a module name in the home package only.  Calling
-- this function directly is usually *not* what you want; currently, it's used
-- as a building block for the following operations:
--
--  1. When you do a normal package lookup, we first check if the module
--  is available in the home module, before looking it up in the package
--  database.
--
--  2. When you have a package qualified import with package name "this",
--  we shortcut to the home module.
--
--  3. When we look up an exact 'Module', if the package key associated with
--  the module is the current home module do a look up in the home module.
--
--  4. Some special-case code in GHCi (ToDo: Figure out why that needs to
--  call this.)
Simon Marlow's avatar
Simon Marlow committed
258 259 260 261 262 263 264 265
findHomeModule :: HscEnv -> ModuleName -> IO FindResult
findHomeModule hsc_env mod_name =
   homeSearchCache hsc_env mod_name $
   let 
     dflags = hsc_dflags hsc_env
     home_path = importPaths dflags
     hisuf = hiSuf dflags
     mod = mkModule (thisPackage dflags) mod_name
266

267
     source_exts =
Simon Marlow's avatar
Simon Marlow committed
268 269
      [ ("hs",   mkHomeModLocationSearched dflags mod_name "hs")
      , ("lhs",  mkHomeModLocationSearched dflags mod_name "lhs")
270 271
      , ("hsig",  mkHomeModLocationSearched dflags mod_name "hsig")
      , ("lhsig",  mkHomeModLocationSearched dflags mod_name "lhsig")
272
      ]
273 274 275 276 277 278 279 280

     hi_exts = [ (hisuf,                mkHiOnlyModLocation dflags hisuf)
               , (addBootSuffix hisuf,  mkHiOnlyModLocation dflags hisuf)
               ]

        -- In compilation manager modes, we look for source files in the home
        -- package because we can compile these automatically.  In one-shot
        -- compilation mode we look for .hi and .hi-boot files only.
281
     exts | isOneShot (ghcMode dflags) = hi_exts
282
          | otherwise                  = source_exts
Simon Marlow's avatar
Simon Marlow committed
283
   in
284 285 286 287

  -- special case for GHC.Prim; we won't find it in the filesystem.
  -- This is important only when compiling the base package (where GHC.Prim
  -- is a home module).
288
  if mod == gHC_PRIM
289
        then return (Found (error "GHC.Prim ModLocation") mod)
290
        else searchPathExts home_path mod exts
Simon Marlow's avatar
Simon Marlow committed
291 292 293 294 295


-- | Search for a module in external packages only.
findPackageModule :: HscEnv -> Module -> IO FindResult
findPackageModule hsc_env mod = do
296
  let
297
        dflags = hsc_dflags hsc_env
298
        pkg_id = modulePackageKey mod
Simon Marlow's avatar
Simon Marlow committed
299
  --
300
  case lookupPackage dflags pkg_id of
Simon Marlow's avatar
Simon Marlow committed
301 302
     Nothing -> return (NoPackage pkg_id)
     Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
303

304 305 306 307 308 309 310
-- | Look up the interface file associated with module @mod@.  This function
-- requires a few invariants to be upheld: (1) the 'Module' in question must
-- be the module identifier of the *original* implementation of a module,
-- not a reexport (this invariant is upheld by @Packages.lhs@) and (2)
-- the 'PackageConfig' must be consistent with the package key in the 'Module'.
-- The redundancy is to avoid an extra lookup in the package state
-- for the appropriate config.
Simon Marlow's avatar
Simon Marlow committed
311
findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
312
findPackageModule_ hsc_env mod pkg_conf =
313
  ASSERT( modulePackageKey mod == packageConfigId pkg_conf )
Simon Marlow's avatar
Simon Marlow committed
314 315 316
  modLocationCache hsc_env mod $

  -- special case for GHC.Prim; we won't find it in the filesystem.
317
  if mod == gHC_PRIM
Simon Marlow's avatar
Simon Marlow committed
318
        then return (Found (error "GHC.Prim ModLocation") mod)
319
        else
Simon Marlow's avatar
Simon Marlow committed
320 321 322

  let
     dflags = hsc_dflags hsc_env
323 324
     tag = buildTag dflags

325
           -- hi-suffix for packages depends on the build tag.
326
     package_hisuf | null tag  = "hi"
327
                   | otherwise = tag ++ "_hi"
328

329 330 331
     mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf

     import_dirs = importDirs pkg_conf
332 333
      -- we never look for a .hi-boot file in an external package;
      -- .hi-boot files only make sense for the home package.
Simon Marlow's avatar
Simon Marlow committed
334
  in
335 336 337 338 339 340 341 342 343
  case import_dirs of
    [one] | MkDepend <- ghcMode dflags -> do
          -- there's only one place that this .hi file can be, so
          -- don't bother looking for it.
          let basename = moduleNameSlashes (moduleName mod)
          loc <- mk_hi_loc one basename
          return (Found loc mod)
    _otherwise ->
          searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
344 345 346 347 348

-- -----------------------------------------------------------------------------
-- General path searching

searchPathExts
349 350
  :: [FilePath]         -- paths to search
  -> Module             -- module name
351
  -> [ (
352 353
        FileExt,                                -- suffix
        FilePath -> BaseName -> IO ModLocation  -- action
354
       )
355
     ]
Simon Marlow's avatar
Simon Marlow committed
356
  -> IO FindResult
357

358
searchPathExts paths mod exts
359 360
   = do result <- search to_search
{-
361 362 363 364 365 366 367 368
        hPutStrLn stderr (showSDoc $
                vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
                    , nest 2 (vcat (map text paths))
                    , case result of
                        Succeeded (loc, p) -> text "Found" <+> ppr loc
                        Failed fs          -> text "not found"])
-}
        return result
369

sof's avatar
sof committed
370
  where
371
    basename = moduleNameSlashes (moduleName mod)
372

Simon Marlow's avatar
Simon Marlow committed
373
    to_search :: [(FilePath, IO ModLocation)]
374
    to_search = [ (file, fn path basename)
375 376 377 378 379 380
                | path <- paths,
                  (ext,fn) <- exts,
                  let base | path == "." = basename
                           | otherwise   = path </> basename
                      file = base <.> ext
                ]
381

382
    search [] = return (NotFound { fr_paths = map fst to_search
383
                                 , fr_pkg   = Just (modulePackageKey mod)
384 385 386
                                 , fr_mods_hidden = [], fr_pkgs_hidden = []
                                 , fr_suggestions = [] })

387
    search ((file, mk_result) : rest) = do
388
      b <- doesFileExist file
389 390 391
      if b
        then do { loc <- mk_result; return (Found loc mod) }
        else search rest
392

Simon Marlow's avatar
Simon Marlow committed
393
mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
394
                          -> FilePath -> BaseName -> IO ModLocation
395
mkHomeModLocationSearched dflags mod suff path basename = do
Ian Lynagh's avatar
Ian Lynagh committed
396
   mkHomeModLocation2 dflags mod (path </> basename) suff
397 398 399 400

-- -----------------------------------------------------------------------------
-- Constructing a home module location

401 402 403
-- This is where we construct the ModLocation for a module in the home
-- package, for which we have a source file.  It is called from three
-- places:
404
--
405 406
--  (a) Here in the finder, when we are searching for a module to import,
--      using the search path (-i option).
407
--
408 409 410
--  (b) The compilation manager, when constructing the ModLocation for
--      a "root" module (a source file named explicitly on the command line
--      or in a :load command in GHCi).
411
--
412 413
--  (c) The driver in one-shot mode, when we need to construct a
--      ModLocation for a source file named on the command-line.
414
--
415 416
-- Parameters are:
--
417
-- mod
418 419 420 421
--      The name of the module
--
-- path
--      (a): The search path component where the source file was found.
422
--      (b) and (c): "."
423 424
--
-- src_basename
425
--      (a): (moduleNameSlashes mod)
426 427 428
--      (b) and (c): The filename of the source file, minus its extension
--
-- ext
429
--      The filename extension of the source file (usually "hs" or "lhs").
430

Simon Marlow's avatar
Simon Marlow committed
431
mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
432
mkHomeModLocation dflags mod src_filename = do
Ian Lynagh's avatar
Ian Lynagh committed
433
   let (basename,extension) = splitExtension src_filename
434
   mkHomeModLocation2 dflags mod basename extension
435

436
mkHomeModLocation2 :: DynFlags
437 438 439 440
                   -> ModuleName
                   -> FilePath  -- Of source module, without suffix
                   -> String    -- Suffix
                   -> IO ModLocation
441
mkHomeModLocation2 dflags mod src_basename ext = do
442
   let mod_basename = moduleNameSlashes mod
443

444 445
       obj_fn = mkObjPath  dflags src_basename mod_basename
       hi_fn  = mkHiPath   dflags src_basename mod_basename
446

Ian Lynagh's avatar
Ian Lynagh committed
447
   return (ModLocation{ ml_hs_file   = Just (src_basename <.> ext),
448 449
                        ml_hi_file   = hi_fn,
                        ml_obj_file  = obj_fn })
450

Simon Marlow's avatar
Simon Marlow committed
451
mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
452
                    -> IO ModLocation
Simon Marlow's avatar
Simon Marlow committed
453
mkHiOnlyModLocation dflags hisuf path basename
Ian Lynagh's avatar
Ian Lynagh committed
454
 = do let full_basename = path </> basename
455
          obj_fn = mkObjPath  dflags full_basename basename
456
      return ModLocation{    ml_hs_file   = Nothing,
457 458 459 460 461 462
                             ml_hi_file   = full_basename <.> hisuf,
                                -- Remove the .hi-boot suffix from
                                -- hi_file, if it had one.  We always
                                -- want the name of the real .hi file
                                -- in the ml_hi_file field.
                             ml_obj_file  = obj_fn
463
                  }
464

465 466 467
-- | Constructs the filename of a .o file for a given source file.
-- Does /not/ check whether the .o file exists
mkObjPath
468
  :: DynFlags
469 470
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
471 472 473
  -> FilePath
mkObjPath dflags basename mod_basename = obj_basename <.> osuf
  where
474 475 476 477 478
                odir = objectDir dflags
                osuf = objectSuf dflags

                obj_basename | Just dir <- odir = dir </> mod_basename
                             | otherwise        = basename
479 480 481 482 483


-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
mkHiPath
484
  :: DynFlags
485 486
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
487 488 489
  -> FilePath
mkHiPath dflags basename mod_basename = hi_basename <.> hisuf
 where
490 491
                hidir = hiDir dflags
                hisuf = hiSuf dflags
492

493 494
                hi_basename | Just dir <- hidir = dir </> mod_basename
                            | otherwise         = basename
495 496


497

498 499 500 501 502 503 504 505
-- -----------------------------------------------------------------------------
-- Filenames of the stub files

-- We don't have to store these in ModLocations, because they can be derived
-- from other available information, and they're only rarely needed.

mkStubPaths
  :: DynFlags
Simon Marlow's avatar
Simon Marlow committed
506
  -> ModuleName
507
  -> ModLocation
508
  -> FilePath
509 510 511

mkStubPaths dflags mod location
  = let
Ian Lynagh's avatar
Ian Lynagh committed
512
        stubdir = stubDir dflags
513

Simon Marlow's avatar
Simon Marlow committed
514
        mod_basename = moduleNameSlashes mod
515
        src_basename = dropExtension $ expectJust "mkStubPaths"
Ian Lynagh's avatar
Ian Lynagh committed
516
                                                  (ml_hs_file location)
517

Ian Lynagh's avatar
Ian Lynagh committed
518 519 520 521 522
        stub_basename0
            | Just dir <- stubdir = dir </> mod_basename
            | otherwise           = src_basename

        stub_basename = stub_basename0 ++ "_stub"
523
     in
524
        stub_basename <.> "h"
525

526
-- -----------------------------------------------------------------------------
527
-- findLinkable isn't related to the other stuff in here,
528
-- but there's no other obvious place for it
529

530 531
findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
findObjectLinkableMaybe mod locn
532
   = do let obj_fn = ml_obj_file locn
533 534 535 536
        maybe_obj_time <- modificationTimeIfExists obj_fn
        case maybe_obj_time of
          Nothing -> return Nothing
          Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
537 538 539

-- Make an object linkable when we know the object file exists, and we know
-- its modification time.
540
findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
541 542 543
findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn])
  -- We used to look for _stub.o files here, but that was a bug (#706)
  -- Now GHC merges the stub.o into the main .o (#3687)
544 545

-- -----------------------------------------------------------------------------
546 547
-- Error messages

548
cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
549
cannotFindModule = cantFindErr (sLit "Could not find module")
550
                               (sLit "Ambiguous module name")
551 552

cannotFindInterface  :: DynFlags -> ModuleName -> FindResult -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
553
cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
554
                                  (sLit "Ambiguous interface for")
555

556 557
cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
            -> SDoc
558 559
cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
  | Just pkgs <- unambiguousPackages
560
  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
Ian Lynagh's avatar
Ian Lynagh committed
561
       sep [ptext (sLit "it was found in multiple packages:"),
562
                hsep (map ppr pkgs) ]
563
    )
564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585
  | otherwise
  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
       vcat (map pprMod mods)
    )
  where
    unambiguousPackages = foldl' unambiguousPackage (Just []) mods
    unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
        = Just (modulePackageKey m : xs)
    unambiguousPackage _ _ = Nothing

    pprMod (m, o) = ptext (sLit "it is bound as") <+> ppr m <+>
                                ptext (sLit "by") <+> pprOrigin m o
    pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
    pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
      if e == Just True
          then [ptext (sLit "package") <+> ppr (modulePackageKey m)]
          else [] ++
      map ((ptext (sLit "a reexport in package") <+>)
                .ppr.packageConfigId) res ++
      if f then [ptext (sLit "a package flag")] else []
      )

586
cantFindErr cannot_find _ dflags mod_name find_result
587 588
  = ptext cannot_find <+> quotes (ppr mod_name)
    $$ more_info
589 590 591
  where
    more_info
      = case find_result of
592 593 594
            NoPackage pkg
                -> ptext (sLit "no package matching") <+> quotes (ppr pkg) <+>
                   ptext (sLit "was found")
Simon Marlow's avatar
Simon Marlow committed
595

596 597 598
            NotFound { fr_paths = files, fr_pkg = mb_pkg
                     , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
                     , fr_suggestions = suggest }
599 600
                | Just pkg <- mb_pkg, pkg /= thisPackage dflags
                -> not_found_in_package pkg files
601

602 603 604
                | not (null suggest)
                -> pp_suggestions suggest $$ tried_these files

605
                | null files && null mod_hiddens && null pkg_hiddens
606
                -> ptext (sLit "It is not a module in the current program, or in any known package.")
607

608 609
                | otherwise
                -> vcat (map pkg_hidden pkg_hiddens) $$
610
                   vcat (map mod_hidden mod_hiddens) $$
611
                   tried_these files
612

613
            _ -> panic "cantFindErr"
614 615 616

    build_tag = buildTag dflags

617 618 619 620 621 622 623
    not_found_in_package pkg files
       | build_tag /= ""
       = let
            build = if build_tag == "p" then "profiling"
                                        else "\"" ++ build_tag ++ "\""
         in
         ptext (sLit "Perhaps you haven't installed the ") <> text build <>
624 625
         ptext (sLit " libraries for package ") <> quotes (ppr pkg) <> char '?' $$
         tried_these files
626 627

       | otherwise
628
       = ptext (sLit "There are files missing in the ") <> quotes (ppr pkg) <>
629 630
         ptext (sLit " package,") $$
         ptext (sLit "try running 'ghc-pkg check'.") $$
631 632 633
         tried_these files

    tried_these files
634
        | null files = Outputable.empty
635
        | verbosity dflags < 3 =
636
              ptext (sLit "Use -v to see a list of the files searched for.")
637
        | otherwise =
638
               hang (ptext (sLit "Locations searched:")) 2 $ vcat (map text files)
639

640
    pkg_hidden :: PackageKey -> SDoc
641
    pkg_hidden pkgid =
642 643
        ptext (sLit "It is a member of the hidden package")
        <+> quotes (ppr pkgid)
644 645 646 647
        --FIXME: we don't really want to show the package key here we should
        -- show the source package id or installed package id if it's ambiguous
        <> dot $$ cabal_pkg_hidden_hint pkgid
    cabal_pkg_hidden_hint pkgid
ian@well-typed.com's avatar
ian@well-typed.com committed
648
     | gopt Opt_BuildingCabalPackage dflags
649
        = let pkg = expectJust "pkg_hidden" (lookupPackage dflags pkgid)
650 651
           in ptext (sLit "Perhaps you need to add") <+>
              quotes (ppr (packageName pkg)) <+>
652
              ptext (sLit "to the build-depends in your .cabal file.")
653
     | otherwise = Outputable.empty
654 655 656

    mod_hidden pkg =
        ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg)
657

658
    pp_suggestions :: [ModuleSuggestion] -> SDoc
659
    pp_suggestions sugs
660
      | null sugs = Outputable.empty
661
      | otherwise = hang (ptext (sLit "Perhaps you meant"))
662 663 664 665 666 667
                       2 (vcat (map pp_sugg sugs))

    -- NB: Prefer the *original* location, and then reexports, and then
    -- package flags when making suggestions.  ToDo: if the original package
    -- also has a reexport, prefer that one
    pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o
668
      where provenance ModHidden = Outputable.empty
669 670 671 672 673 674 675 676 677 678 679 680 681
            provenance (ModOrigin{ fromOrigPackage = e,
                                   fromExposedReexport = res,
                                   fromPackageFlag = f })
              | Just True <- e
                 = parens (ptext (sLit "from") <+> ppr (modulePackageKey mod))
              | f && moduleName mod == m
                 = parens (ptext (sLit "from") <+> ppr (modulePackageKey mod))
              | (pkg:_) <- res
                 = parens (ptext (sLit "from") <+> ppr (packageConfigId pkg)
                    <> comma <+> ptext (sLit "reexporting") <+> ppr mod)
              | f
                 = parens (ptext (sLit "defined via package flags to be")
                    <+> ppr mod)
682
              | otherwise = Outputable.empty
683
    pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
684
      where provenance ModHidden =  Outputable.empty
685 686 687 688 689 690 691 692
            provenance (ModOrigin{ fromOrigPackage = e,
                                   fromHiddenReexport = rhs })
              | Just False <- e
                 = parens (ptext (sLit "needs flag -package-key")
                    <+> ppr (modulePackageKey mod))
              | (pkg:_) <- rhs
                 = parens (ptext (sLit "needs flag -package-key")
                    <+> ppr (packageConfigId pkg))
693
              | otherwise = Outputable.empty
694
\end{code}