Finder.hs 31.7 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3
{-
(c) The University of Glasgow, 2000-2006

4
\section[Finder]{Module Finder}
Austin Seipp's avatar
Austin Seipp committed
5
-}
6

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
    findImportedModule,
13
    findPluginModule,
Simon Marlow's avatar
Simon Marlow committed
14 15
    findExactModule,
    findHomeModule,
16
    findExposedPackageModule,
Simon Marlow's avatar
Simon Marlow committed
17 18
    mkHomeModLocation,
    mkHomeModLocation2,
19
    mkHiOnlyModLocation,
20 21
    mkHiPath,
    mkObjPath,
Simon Marlow's avatar
Simon Marlow committed
22 23
    addHomeModuleToFinder,
    uncacheModule,
24
    mkStubPaths,
25

26 27
    findObjectLinkableMaybe,
    findObjectLinkable,
28

29 30
    cannotFindModule,
    cannotFindInterface,
31

32 33
  ) where

34 35
#include "HsVersions.h"

36 37
import GhcPrelude

38
import Module
39
import HscTypes
40
import Packages
41
import FastString
42
import Util
Simon Marlow's avatar
Simon Marlow committed
43
import PrelNames        ( gHC_PRIM )
44
import DynFlags
45
import Outputable
46
import Maybes           ( expectJust )
47

48
import Data.IORef       ( IORef, readIORef, atomicModifyIORef' )
49
import System.Directory
Ian Lynagh's avatar
Ian Lynagh committed
50
import System.FilePath
51
import Control.Monad
52
import Data.Time
53 54
import Data.List        ( foldl' )

55

56 57
type FileExt = String   -- Filename extension
type BaseName = String  -- Basename of file
58

59 60
-- -----------------------------------------------------------------------------
-- The Finder
61

62 63 64
-- 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.
65

66
-- It does *not* know which particular package a module lives in.  Use
67
-- Packages.lookupModuleInAllPackages for that.
68

69 70 71 72 73
-- -----------------------------------------------------------------------------
-- 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
74
flushFinderCaches :: HscEnv -> IO ()
75
flushFinderCaches hsc_env =
76
  atomicModifyIORef' fc_ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
Simon Marlow's avatar
Simon Marlow committed
77
 where
78 79
        this_pkg = thisPackage (hsc_dflags hsc_env)
        fc_ref = hsc_FC hsc_env
80
        is_ext mod _ | not (installedModuleUnitId mod `installedUnitIdEq` this_pkg) = True
81
                     | otherwise = False
Simon Marlow's avatar
Simon Marlow committed
82

83
addToFinderCache :: IORef FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
84
addToFinderCache ref key val =
85
  atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ())
Simon Marlow's avatar
Simon Marlow committed
86

87
removeFromFinderCache :: IORef FinderCache -> InstalledModule -> IO ()
88
removeFromFinderCache ref key =
89
  atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ())
Simon Marlow's avatar
Simon Marlow committed
90

91
lookupFinderCache :: IORef FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
92
lookupFinderCache ref key = do
Simon Marlow's avatar
Simon Marlow committed
93
   c <- readIORef ref
94
   return $! lookupInstalledModuleEnv c key
95 96

-- -----------------------------------------------------------------------------
97
-- The three external entry points
98

Simon Marlow's avatar
Simon Marlow committed
99 100 101 102 103 104
-- | 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.

105 106 107
findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule hsc_env mod_name mb_pkg =
  case mb_pkg of
108 109 110
        Nothing                        -> unqual_import
        Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
                 | otherwise           -> pkg_import
Simon Marlow's avatar
Simon Marlow committed
111
  where
112
    home_import   = findHomeModule hsc_env mod_name
Simon Marlow's avatar
Simon Marlow committed
113

114
    pkg_import    = findExposedPackageModule hsc_env mod_name mb_pkg
Simon Marlow's avatar
Simon Marlow committed
115

116 117 118
    unqual_import = home_import
                    `orIfNotFound`
                    findExposedPackageModule hsc_env mod_name Nothing
Simon Marlow's avatar
Simon Marlow committed
119

120 121 122 123 124 125 126 127 128 129
-- | Locate a plugin module requested by the user, for a compiler
-- plugin.  This consults the same set of exposed packages as
-- 'findImportedModule', unless @-hide-all-plugin-packages@ or
-- @-plugin-package@ are specified.
findPluginModule :: HscEnv -> ModuleName -> IO FindResult
findPluginModule hsc_env mod_name =
  findHomeModule hsc_env mod_name
  `orIfNotFound`
  findExposedPluginPackageModule hsc_env mod_name

Simon Marlow's avatar
Simon Marlow committed
130 131 132
-- | 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
133
-- reading the interface for a module mentioned by another interface,
Simon Marlow's avatar
Simon Marlow committed
134 135
-- for example (a "system import").

136
findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
Simon Marlow's avatar
Simon Marlow committed
137
findExactModule hsc_env mod =
138
    let dflags = hsc_dflags hsc_env
139 140
    in if installedModuleUnitId mod `installedUnitIdEq` thisPackage dflags
       then findInstalledHomeModule hsc_env (installedModuleName mod)
141
       else findPackageModule hsc_env mod
142

Simon Marlow's avatar
Simon Marlow committed
143 144 145
-- -----------------------------------------------------------------------------
-- Helpers

146 147 148 149 150
-- | Given a monadic actions @this@ and @or_this@, first execute
-- @this@.  If the returned 'FindResult' is successful, return
-- it; otherwise, execute @or_this@.  If both failed, this function
-- also combines their failure messages in a reasonable way.
orIfNotFound :: Monad m => m FindResult -> m FindResult -> m FindResult
151
orIfNotFound this or_this = do
Simon Marlow's avatar
Simon Marlow committed
152 153
  res <- this
  case res of
154
    NotFound { fr_paths = paths1, fr_mods_hidden = mh1
155
             , fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 }
156 157 158
     -> do res2 <- or_this
           case res2 of
             NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
159 160
                      , fr_pkgs_hidden = ph2, fr_unusables = u2
                      , fr_suggestions = s2 }
161 162 163 164
              -> 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
165
                                  , fr_unusables = u1 ++ u2
166 167
                                  , fr_suggestions = s1  ++ s2 })
             _other -> return res2
Simon Marlow's avatar
Simon Marlow committed
168 169
    _other -> return res

170 171 172 173 174 175
-- | 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.)
176
homeSearchCache :: HscEnv -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
Simon Marlow's avatar
Simon Marlow committed
177
homeSearchCache hsc_env mod_name do_this = do
178
  let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
179
  modLocationCache hsc_env mod do_this
Simon Marlow's avatar
Simon Marlow committed
180

181 182 183
findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
                         -> IO FindResult
findExposedPackageModule hsc_env mod_name mb_pkg
184 185 186 187 188 189 190 191 192 193 194 195 196
  = findLookupResult hsc_env
  $ lookupModuleWithSuggestions
        (hsc_dflags hsc_env) mod_name mb_pkg

findExposedPluginPackageModule :: HscEnv -> ModuleName
                               -> IO FindResult
findExposedPluginPackageModule hsc_env mod_name
  = findLookupResult hsc_env
  $ lookupPluginModuleWithSuggestions
        (hsc_dflags hsc_env) mod_name Nothing

findLookupResult :: HscEnv -> LookupResult -> IO FindResult
findLookupResult hsc_env r = case r of
197 198 199 200 201 202 203 204 205 206 207 208 209
     LookupFound m pkg_conf -> do
       let im = fst (splitModuleInsts m)
       r' <- findPackageModule_ hsc_env im pkg_conf
       case r' of
        -- TODO: ghc -M is unlikely to do the right thing
        -- with just the location of the thing that was
        -- instantiated; you probably also need all of the
        -- implicit locations from the instances
        InstalledFound loc   _ -> return (Found loc m)
        InstalledNoPackage   _ -> return (NoPackage (moduleUnitId m))
        InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnitId m)
                                         , fr_pkgs_hidden = []
                                         , fr_mods_hidden = []
210
                                         , fr_unusables = []
211
                                         , fr_suggestions = []})
212
     LookupMultiple rs ->
213
       return (FoundMultiple rs)
214
     LookupHidden pkg_hiddens mod_hiddens ->
215
       return (NotFound{ fr_paths = [], fr_pkg = Nothing
216 217
                       , fr_pkgs_hidden = map (moduleUnitId.fst) pkg_hiddens
                       , fr_mods_hidden = map (moduleUnitId.fst) mod_hiddens
218
                       , fr_unusables = []
219
                       , fr_suggestions = [] })
220 221 222 223 224 225 226 227 228 229
     LookupUnusable unusable ->
       let unusables' = map get_unusable unusable
           get_unusable (m, ModUnusable r) = (moduleUnitId m, r)
           get_unusable (_, r)             =
             pprPanic "findLookupResult: unexpected origin" (ppr r)
       in return (NotFound{ fr_paths = [], fr_pkg = Nothing
                          , fr_pkgs_hidden = []
                          , fr_mods_hidden = []
                          , fr_unusables = unusables'
                          , fr_suggestions = [] })
230
     LookupNotFound suggest ->
231 232 233
       return (NotFound{ fr_paths = [], fr_pkg = Nothing
                       , fr_pkgs_hidden = []
                       , fr_mods_hidden = []
234
                       , fr_unusables = []
235
                       , fr_suggestions = suggest })
Simon Marlow's avatar
Simon Marlow committed
236

237
modLocationCache :: HscEnv -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult
Simon Marlow's avatar
Simon Marlow committed
238
modLocationCache hsc_env mod do_this = do
239 240 241 242
  m <- lookupFinderCache (hsc_FC hsc_env) mod
  case m of
    Just result -> return result
    Nothing     -> do
Simon Marlow's avatar
Simon Marlow committed
243
        result <- do_this
244
        addToFinderCache (hsc_FC hsc_env) mod result
245
        return result
Simon Marlow's avatar
Simon Marlow committed
246

247 248 249 250 251 252
mkHomeInstalledModule :: DynFlags -> ModuleName -> InstalledModule
mkHomeInstalledModule dflags mod_name =
  let iuid = fst (splitUnitIdInsts (thisPackage dflags))
  in InstalledModule iuid mod_name

-- This returns a module because it's more convenient for users
Simon Marlow's avatar
Simon Marlow committed
253 254
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder hsc_env mod_name loc = do
255 256 257
  let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
  addToFinderCache (hsc_FC hsc_env) mod (InstalledFound loc mod)
  return (mkModule (thisPackage (hsc_dflags hsc_env)) mod_name)
Simon Marlow's avatar
Simon Marlow committed
258 259

uncacheModule :: HscEnv -> ModuleName -> IO ()
260 261 262
uncacheModule hsc_env mod_name = do
  let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
  removeFromFinderCache (hsc_FC hsc_env) mod
263 264

-- -----------------------------------------------------------------------------
265
--      The internal workers
266

267 268 269 270 271 272 273 274 275 276 277
findHomeModule :: HscEnv -> ModuleName -> IO FindResult
findHomeModule hsc_env mod_name = do
  r <- findInstalledHomeModule hsc_env mod_name
  return $ case r of
    InstalledFound loc _ -> Found loc (mkModule uid mod_name)
    InstalledNoPackage _ -> NoPackage uid -- impossible
    InstalledNotFound fps _ -> NotFound {
        fr_paths = fps,
        fr_pkg = Just uid,
        fr_mods_hidden = [],
        fr_pkgs_hidden = [],
278
        fr_unusables = [],
279 280 281 282 283 284
        fr_suggestions = []
      }
 where
  dflags = hsc_dflags hsc_env
  uid = thisPackage dflags

285 286 287 288 289 290 291 292 293 294 295
-- | 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.
--
296
--  3. When we look up an exact 'Module', if the unit id associated with
297 298 299 300
--  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.)
301 302
findInstalledHomeModule :: HscEnv -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule hsc_env mod_name =
Simon Marlow's avatar
Simon Marlow committed
303
   homeSearchCache hsc_env mod_name $
Austin Seipp's avatar
Austin Seipp committed
304
   let
Simon Marlow's avatar
Simon Marlow committed
305 306 307
     dflags = hsc_dflags hsc_env
     home_path = importPaths dflags
     hisuf = hiSuf dflags
308
     mod = mkHomeInstalledModule dflags mod_name
309

310
     source_exts =
Simon Marlow's avatar
Simon Marlow committed
311 312
      [ ("hs",   mkHomeModLocationSearched dflags mod_name "hs")
      , ("lhs",  mkHomeModLocationSearched dflags mod_name "lhs")
313 314
      , ("hsig",  mkHomeModLocationSearched dflags mod_name "hsig")
      , ("lhsig",  mkHomeModLocationSearched dflags mod_name "lhsig")
315
      ]
316 317 318 319 320 321 322 323

     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.
324
     exts | isOneShot (ghcMode dflags) = hi_exts
325
          | otherwise                  = source_exts
Simon Marlow's avatar
Simon Marlow committed
326
   in
327 328 329 330

  -- 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).
331 332
  if mod `installedModuleEq` gHC_PRIM
        then return (InstalledFound (error "GHC.Prim ModLocation") mod)
333
        else searchPathExts home_path mod exts
Simon Marlow's avatar
Simon Marlow committed
334

335

Simon Marlow's avatar
Simon Marlow committed
336
-- | Search for a module in external packages only.
337
findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
Simon Marlow's avatar
Simon Marlow committed
338
findPackageModule hsc_env mod = do
339
  let
340
        dflags = hsc_dflags hsc_env
341
        pkg_id = installedModuleUnitId mod
Simon Marlow's avatar
Simon Marlow committed
342
  --
343 344
  case lookupInstalledPackage dflags pkg_id of
     Nothing -> return (InstalledNoPackage pkg_id)
Simon Marlow's avatar
Simon Marlow committed
345
     Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
346

347 348 349
-- | 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,
350
-- not a reexport (this invariant is upheld by @Packages.hs@) and (2)
351
-- the 'PackageConfig' must be consistent with the unit id in the 'Module'.
352 353
-- The redundancy is to avoid an extra lookup in the package state
-- for the appropriate config.
354
findPackageModule_ :: HscEnv -> InstalledModule -> PackageConfig -> IO InstalledFindResult
355
findPackageModule_ hsc_env mod pkg_conf =
356
  ASSERT2( installedModuleUnitId mod == installedPackageConfigId pkg_conf, ppr (installedModuleUnitId mod) <+> ppr (installedPackageConfigId pkg_conf) )
Simon Marlow's avatar
Simon Marlow committed
357 358 359
  modLocationCache hsc_env mod $

  -- special case for GHC.Prim; we won't find it in the filesystem.
360 361
  if mod `installedModuleEq` gHC_PRIM
        then return (InstalledFound (error "GHC.Prim ModLocation") mod)
362
        else
Simon Marlow's avatar
Simon Marlow committed
363 364 365

  let
     dflags = hsc_dflags hsc_env
366 367
     tag = buildTag dflags

368
           -- hi-suffix for packages depends on the build tag.
369
     package_hisuf | null tag  = "hi"
370
                   | otherwise = tag ++ "_hi"
371

372 373 374
     mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf

     import_dirs = importDirs pkg_conf
375 376
      -- 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
377
  in
378 379 380 381
  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.
382
          let basename = moduleNameSlashes (installedModuleName mod)
383
          loc <- mk_hi_loc one basename
384
          return (InstalledFound loc mod)
385 386
    _otherwise ->
          searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
387 388 389 390 391

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

searchPathExts
392
  :: [FilePath]         -- paths to search
393
  -> InstalledModule             -- module name
394
  -> [ (
395 396
        FileExt,                                -- suffix
        FilePath -> BaseName -> IO ModLocation  -- action
397
       )
398
     ]
399
  -> IO InstalledFindResult
400

401
searchPathExts paths mod exts
402 403
   = do result <- search to_search
{-
404 405 406 407 408 409 410 411
        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
412

sof's avatar
sof committed
413
  where
414
    basename = moduleNameSlashes (installedModuleName mod)
415

Simon Marlow's avatar
Simon Marlow committed
416
    to_search :: [(FilePath, IO ModLocation)]
417
    to_search = [ (file, fn path basename)
418 419 420 421 422 423
                | path <- paths,
                  (ext,fn) <- exts,
                  let base | path == "." = basename
                           | otherwise   = path </> basename
                      file = base <.> ext
                ]
424

425
    search [] = return (InstalledNotFound (map fst to_search) (Just (installedModuleUnitId mod)))
426

427
    search ((file, mk_result) : rest) = do
428
      b <- doesFileExist file
429
      if b
430
        then do { loc <- mk_result; return (InstalledFound loc mod) }
431
        else search rest
432

Simon Marlow's avatar
Simon Marlow committed
433
mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
434
                          -> FilePath -> BaseName -> IO ModLocation
435
mkHomeModLocationSearched dflags mod suff path basename = do
Ian Lynagh's avatar
Ian Lynagh committed
436
   mkHomeModLocation2 dflags mod (path </> basename) suff
437 438 439 440

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

441 442 443
-- 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:
444
--
445 446
--  (a) Here in the finder, when we are searching for a module to import,
--      using the search path (-i option).
447
--
448 449 450
--  (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).
451
--
452 453
--  (c) The driver in one-shot mode, when we need to construct a
--      ModLocation for a source file named on the command-line.
454
--
455 456
-- Parameters are:
--
457
-- mod
458 459 460 461
--      The name of the module
--
-- path
--      (a): The search path component where the source file was found.
462
--      (b) and (c): "."
463 464
--
-- src_basename
465
--      (a): (moduleNameSlashes mod)
466 467 468
--      (b) and (c): The filename of the source file, minus its extension
--
-- ext
469
--      The filename extension of the source file (usually "hs" or "lhs").
470

Simon Marlow's avatar
Simon Marlow committed
471
mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
472
mkHomeModLocation dflags mod src_filename = do
Ian Lynagh's avatar
Ian Lynagh committed
473
   let (basename,extension) = splitExtension src_filename
474
   mkHomeModLocation2 dflags mod basename extension
475

476
mkHomeModLocation2 :: DynFlags
477 478 479 480
                   -> ModuleName
                   -> FilePath  -- Of source module, without suffix
                   -> String    -- Suffix
                   -> IO ModLocation
481
mkHomeModLocation2 dflags mod src_basename ext = do
482
   let mod_basename = moduleNameSlashes mod
483

484 485
       obj_fn = mkObjPath  dflags src_basename mod_basename
       hi_fn  = mkHiPath   dflags src_basename mod_basename
486

Ian Lynagh's avatar
Ian Lynagh committed
487
   return (ModLocation{ ml_hs_file   = Just (src_basename <.> ext),
488 489
                        ml_hi_file   = hi_fn,
                        ml_obj_file  = obj_fn })
490

Simon Marlow's avatar
Simon Marlow committed
491
mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
492
                    -> IO ModLocation
Simon Marlow's avatar
Simon Marlow committed
493
mkHiOnlyModLocation dflags hisuf path basename
Ian Lynagh's avatar
Ian Lynagh committed
494
 = do let full_basename = path </> basename
495
          obj_fn = mkObjPath  dflags full_basename basename
496
      return ModLocation{    ml_hs_file   = Nothing,
497 498 499 500 501 502
                             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
503
                  }
504

505 506 507
-- | Constructs the filename of a .o file for a given source file.
-- Does /not/ check whether the .o file exists
mkObjPath
508
  :: DynFlags
509 510
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
511 512 513
  -> FilePath
mkObjPath dflags basename mod_basename = obj_basename <.> osuf
  where
514 515 516 517 518
                odir = objectDir dflags
                osuf = objectSuf dflags

                obj_basename | Just dir <- odir = dir </> mod_basename
                             | otherwise        = basename
519 520 521 522 523


-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
mkHiPath
524
  :: DynFlags
525 526
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
527 528 529
  -> FilePath
mkHiPath dflags basename mod_basename = hi_basename <.> hisuf
 where
530 531
                hidir = hiDir dflags
                hisuf = hiSuf dflags
532

533 534
                hi_basename | Just dir <- hidir = dir </> mod_basename
                            | otherwise         = basename
535 536


537

538 539 540 541 542 543 544 545
-- -----------------------------------------------------------------------------
-- 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
546
  -> ModuleName
547
  -> ModLocation
548
  -> FilePath
549 550 551

mkStubPaths dflags mod location
  = let
Ian Lynagh's avatar
Ian Lynagh committed
552
        stubdir = stubDir dflags
553

Simon Marlow's avatar
Simon Marlow committed
554
        mod_basename = moduleNameSlashes mod
555
        src_basename = dropExtension $ expectJust "mkStubPaths"
Ian Lynagh's avatar
Ian Lynagh committed
556
                                                  (ml_hs_file location)
557

Ian Lynagh's avatar
Ian Lynagh committed
558 559 560 561 562
        stub_basename0
            | Just dir <- stubdir = dir </> mod_basename
            | otherwise           = src_basename

        stub_basename = stub_basename0 ++ "_stub"
563
     in
564
        stub_basename <.> "h"
565

566
-- -----------------------------------------------------------------------------
567
-- findLinkable isn't related to the other stuff in here,
568
-- but there's no other obvious place for it
569

570 571
findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
findObjectLinkableMaybe mod locn
572
   = do let obj_fn = ml_obj_file locn
573 574 575 576
        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)
577 578 579

-- Make an object linkable when we know the object file exists, and we know
-- its modification time.
580
findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
581 582 583
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)
584 585

-- -----------------------------------------------------------------------------
586 587
-- Error messages

588
cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
589 590 591 592 593 594 595 596 597 598 599 600 601
cannotFindModule flags mod res =
  cantFindErr (sLit cannotFindMsg)
              (sLit "Ambiguous module name")
              flags mod res
  where
    cannotFindMsg =
      case res of
        NotFound { fr_mods_hidden = hidden_mods
                 , fr_pkgs_hidden = hidden_pkgs
                 , fr_unusables = unusables }
          | not (null hidden_mods && null hidden_pkgs && null unusables)
          -> "Could not load module"
        _ -> "Could not find module"
602

603 604 605
cannotFindInterface  :: DynFlags -> ModuleName -> InstalledFindResult -> SDoc
cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
                                           (sLit "Ambiguous interface for")
606

Sylvain Henry's avatar
Sylvain Henry committed
607
cantFindErr :: PtrString -> PtrString -> DynFlags -> ModuleName -> FindResult
608
            -> SDoc
609 610
cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
  | Just pkgs <- unambiguousPackages
611
  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
612
       sep [text "it was found in multiple packages:",
613
                hsep (map ppr pkgs) ]
614
    )
615 616 617 618 619 620 621
  | 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 _) _ _ _)
622
        = Just (moduleUnitId m : xs)
623 624
    unambiguousPackage _ _ = Nothing

625 626
    pprMod (m, o) = text "it is bound as" <+> ppr m <+>
                                text "by" <+> pprOrigin m o
627
    pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
628
    pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
629 630
    pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
      if e == Just True
631
          then [text "package" <+> ppr (moduleUnitId m)]
632
          else [] ++
633
      map ((text "a reexport in package" <+>)
634
                .ppr.packageConfigId) res ++
635
      if f then [text "a package flag"] else []
636 637
      )

638
cantFindErr cannot_find _ dflags mod_name find_result
639 640
  = ptext cannot_find <+> quotes (ppr mod_name)
    $$ more_info
641 642 643
  where
    more_info
      = case find_result of
644
            NoPackage pkg
645
                -> text "no unit id matching" <+> quotes (ppr pkg) <+>
646
                   text "was found"
Simon Marlow's avatar
Simon Marlow committed
647

648 649
            NotFound { fr_paths = files, fr_pkg = mb_pkg
                     , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
650
                     , fr_unusables = unusables, fr_suggestions = suggest }
651 652
                | Just pkg <- mb_pkg, pkg /= thisPackage dflags
                -> not_found_in_package pkg files
653

654
                | not (null suggest)
655
                -> pp_suggestions suggest $$ tried_these files dflags
656

657 658
                | null files && null mod_hiddens &&
                  null pkg_hiddens && null unusables
659
                -> text "It is not a module in the current program, or in any known package."
660

661 662
                | otherwise
                -> vcat (map pkg_hidden pkg_hiddens) $$
663
                   vcat (map mod_hidden mod_hiddens) $$
664
                   vcat (map unusable unusables) $$
665
                   tried_these files dflags
666

667
            _ -> panic "cantFindErr"
668 669 670

    build_tag = buildTag dflags

671 672 673 674 675 676
    not_found_in_package pkg files
       | build_tag /= ""
       = let
            build = if build_tag == "p" then "profiling"
                                        else "\"" ++ build_tag ++ "\""
         in
677 678
         text "Perhaps you haven't installed the " <> text build <>
         text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
679
         tried_these files dflags
680 681

       | otherwise
682 683 684
       = text "There are files missing in the " <> quotes (ppr pkg) <>
         text " package," $$
         text "try running 'ghc-pkg check'." $$
685
         tried_these files dflags
686

687
    pkg_hidden :: UnitId -> SDoc
688
    pkg_hidden pkgid =
689
        text "It is a member of the hidden package"
690
        <+> quotes (ppr pkgid)
691
        --FIXME: we don't really want to show the unit id here we should
692
        -- show the source package id or installed package id if it's ambiguous
693 694
        <> dot $$ pkg_hidden_hint pkgid
    pkg_hidden_hint pkgid
ian@well-typed.com's avatar
ian@well-typed.com committed
695
     | gopt Opt_BuildingCabalPackage dflags
696
        = let pkg = expectJust "pkg_hidden" (lookupPackage dflags pkgid)
697
           in text "Perhaps you need to add" <+>
698
              quotes (ppr (packageName pkg)) <+>
699
              text "to the build-depends in your .cabal file."
700 701 702 703 704 705
     | Just pkg <- lookupPackage dflags pkgid
         = text "You can run" <+>
           quotes (text ":set -package " <> ppr (packageName pkg)) <+>
           text "to expose it." $$
           text "(Note: this unloads all the modules in the current scope.)"
     | otherwise = Outputable.empty
706 707

    mod_hidden pkg =
708
        text "it is a hidden module in the package" <+> quotes (ppr pkg)
709

710 711 712 713 714
    unusable (pkg, reason)
      = text "It is a member of the package"
      <+> quotes (ppr pkg)
      $$ pprReason (text "which is") reason

715
    pp_suggestions :: [ModuleSuggestion] -> SDoc
716
    pp_suggestions sugs
717
      | null sugs = Outputable.empty
718
      | otherwise = hang (text "Perhaps you meant")
719 720 721 722 723 724
                       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
725
      where provenance ModHidden = Outputable.empty
726
            provenance (ModUnusable _) = Outputable.empty
727 728 729 730
            provenance (ModOrigin{ fromOrigPackage = e,
                                   fromExposedReexport = res,
                                   fromPackageFlag = f })
              | Just True <- e
731
                 = parens (text "from" <+> ppr (moduleUnitId mod))
732
              | f && moduleName mod == m
733
                 = parens (text "from" <+> ppr (moduleUnitId mod))
734
              | (pkg:_) <- res
735 736
                 = parens (text "from" <+> ppr (packageConfigId pkg)
                    <> comma <+> text "reexporting" <+> ppr mod)
737
              | f
738
                 = parens (text "defined via package flags to be"
739
                    <+> ppr mod)
740
              | otherwise = Outputable.empty
741
    pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
742
      where provenance ModHidden =  Outputable.empty
743
            provenance (ModUnusable _) = Outputable.empty
744 745 746
            provenance (ModOrigin{ fromOrigPackage = e,
                                   fromHiddenReexport = rhs })
              | Just False <- e
747
                 = parens (text "needs flag -package-key"
748
                    <+> ppr (moduleUnitId mod))
749
              | (pkg:_) <- rhs
750
                 = parens (text "needs flag -package-id"
751
                    <+> ppr (packageConfigId pkg))
752
              | otherwise = Outputable.empty
753

Sylvain Henry's avatar
Sylvain Henry committed
754 755
cantFindInstalledErr :: PtrString -> PtrString -> DynFlags -> ModuleName
                     -> InstalledFindResult -> SDoc
756 757 758 759 760 761 762 763 764 765 766 767