Finder.hs 33.4 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
{-# LANGUAGE CPP #-}
8
{-# LANGUAGE FlexibleContexts #-}
9

Sylvain Henry's avatar
Sylvain Henry committed
10
module GHC.Driver.Finder (
Simon Marlow's avatar
Simon Marlow committed
11
    flushFinderCaches,
12
    FindResult(..),
Simon Marlow's avatar
Simon Marlow committed
13
    findImportedModule,
14
    findPluginModule,
Simon Marlow's avatar
Simon Marlow committed
15 16
    findExactModule,
    findHomeModule,
17
    findExposedPackageModule,
Simon Marlow's avatar
Simon Marlow committed
18 19
    mkHomeModLocation,
    mkHomeModLocation2,
20
    mkHiOnlyModLocation,
21 22
    mkHiPath,
    mkObjPath,
Simon Marlow's avatar
Simon Marlow committed
23 24
    addHomeModuleToFinder,
    uncacheModule,
25
    mkStubPaths,
26

27 28
    findObjectLinkableMaybe,
    findObjectLinkable,
29

30 31
    cannotFindModule,
    cannotFindInterface,
32

33 34
  ) where

35 36
#include "HsVersions.h"

37
import GHC.Prelude
38

39 40 41
import GHC.Unit.Types
import GHC.Unit.Module
import GHC.Unit.Home
42
import GHC.Unit.State
43

Sylvain Henry's avatar
Sylvain Henry committed
44
import GHC.Driver.Types
45 46
import GHC.Data.FastString
import GHC.Utils.Misc
Sylvain Henry's avatar
Sylvain Henry committed
47
import GHC.Builtin.Names ( gHC_PRIM )
Sylvain Henry's avatar
Sylvain Henry committed
48
import GHC.Driver.Session
49
import GHC.Platform.Ways
50
import GHC.Utils.Outputable as Outputable
51
import GHC.Utils.Panic
52
import GHC.Data.Maybe    ( expectJust )
53

54
import Data.IORef       ( IORef, readIORef, atomicModifyIORef' )
55
import System.Directory
Ian Lynagh's avatar
Ian Lynagh committed
56
import System.FilePath
57
import Control.Monad
58
import Data.Time
59

60

61 62
type FileExt = String   -- Filename extension
type BaseName = String  -- Basename of file
63

64 65
-- -----------------------------------------------------------------------------
-- The Finder
66

67 68 69
-- 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.
70

71
-- It does *not* know which particular package a module lives in.  Use
Sylvain Henry's avatar
Sylvain Henry committed
72
-- Packages.lookupModuleInAllUnits for that.
73

74 75 76 77 78
-- -----------------------------------------------------------------------------
-- 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
79
flushFinderCaches :: HscEnv -> IO ()
80
flushFinderCaches hsc_env =
81
  atomicModifyIORef' fc_ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
Simon Marlow's avatar
Simon Marlow committed
82
 where
Sylvain Henry's avatar
Sylvain Henry committed
83 84 85
        fc_ref       = hsc_FC hsc_env
        home_unit    = mkHomeUnitFromFlags (hsc_dflags hsc_env)
        is_ext mod _ = not (isHomeInstalledModule home_unit mod)
Simon Marlow's avatar
Simon Marlow committed
86

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

91
removeFromFinderCache :: IORef FinderCache -> InstalledModule -> IO ()
92
removeFromFinderCache ref key =
93
  atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ())
Simon Marlow's avatar
Simon Marlow committed
94

95
lookupFinderCache :: IORef FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
96
lookupFinderCache ref key = do
Simon Marlow's avatar
Simon Marlow committed
97
   c <- readIORef ref
98
   return $! lookupInstalledModuleEnv c key
99 100

-- -----------------------------------------------------------------------------
101
-- The three external entry points
102

Simon Marlow's avatar
Simon Marlow committed
103 104 105 106 107 108
-- | 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.

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

118
    pkg_import    = findExposedPackageModule hsc_env mod_name mb_pkg
Simon Marlow's avatar
Simon Marlow committed
119

120 121 122
    unqual_import = home_import
                    `orIfNotFound`
                    findExposedPackageModule hsc_env mod_name Nothing
Simon Marlow's avatar
Simon Marlow committed
123

124 125 126 127 128 129 130 131 132 133
-- | 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
134 135 136
-- | 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
137
-- reading the interface for a module mentioned by another interface,
Simon Marlow's avatar
Simon Marlow committed
138 139
-- for example (a "system import").

140
findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
Simon Marlow's avatar
Simon Marlow committed
141
findExactModule hsc_env mod =
Sylvain Henry's avatar
Sylvain Henry committed
142 143
    let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
    in if isHomeInstalledModule home_unit mod
144
       then findInstalledHomeModule hsc_env (moduleName mod)
145
       else findPackageModule hsc_env mod
146

Simon Marlow's avatar
Simon Marlow committed
147 148 149
-- -----------------------------------------------------------------------------
-- Helpers

150 151 152 153 154
-- | 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
155
orIfNotFound this or_this = do
Simon Marlow's avatar
Simon Marlow committed
156 157
  res <- this
  case res of
158
    NotFound { fr_paths = paths1, fr_mods_hidden = mh1
159
             , fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 }
160 161 162
     -> do res2 <- or_this
           case res2 of
             NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
163 164
                      , fr_pkgs_hidden = ph2, fr_unusables = u2
                      , fr_suggestions = s2 }
165 166 167 168
              -> 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
169
                                  , fr_unusables = u1 ++ u2
170 171
                                  , 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.)
180
homeSearchCache :: HscEnv -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
Simon Marlow's avatar
Simon Marlow committed
181
homeSearchCache hsc_env mod_name do_this = do
Sylvain Henry's avatar
Sylvain Henry committed
182 183
  let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
      mod = mkHomeInstalledModule home_unit mod_name
184
  modLocationCache hsc_env mod do_this
Simon Marlow's avatar
Simon Marlow committed
185

186 187 188
findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
                         -> IO FindResult
findExposedPackageModule hsc_env mod_name mb_pkg
189 190
  = findLookupResult hsc_env
  $ lookupModuleWithSuggestions
Sylvain Henry's avatar
Sylvain Henry committed
191
        (unitState (hsc_dflags hsc_env)) mod_name mb_pkg
192 193 194 195 196 197

findExposedPluginPackageModule :: HscEnv -> ModuleName
                               -> IO FindResult
findExposedPluginPackageModule hsc_env mod_name
  = findLookupResult hsc_env
  $ lookupPluginModuleWithSuggestions
Sylvain Henry's avatar
Sylvain Henry committed
198
        (unitState (hsc_dflags hsc_env)) mod_name Nothing
199 200 201

findLookupResult :: HscEnv -> LookupResult -> IO FindResult
findLookupResult hsc_env r = case r of
202
     LookupFound m pkg_conf -> do
203
       let im = fst (getModuleInstantiation m)
204 205 206 207 208 209 210
       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)
211 212
        InstalledNoPackage   _ -> return (NoPackage (moduleUnit m))
        InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m)
213 214
                                         , fr_pkgs_hidden = []
                                         , fr_mods_hidden = []
215
                                         , fr_unusables = []
216
                                         , fr_suggestions = []})
217
     LookupMultiple rs ->
218
       return (FoundMultiple rs)
219
     LookupHidden pkg_hiddens mod_hiddens ->
220
       return (NotFound{ fr_paths = [], fr_pkg = Nothing
221 222
                       , fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens
                       , fr_mods_hidden = map (moduleUnit.fst) mod_hiddens
223
                       , fr_unusables = []
224
                       , fr_suggestions = [] })
225 226
     LookupUnusable unusable ->
       let unusables' = map get_unusable unusable
227
           get_unusable (m, ModUnusable r) = (moduleUnit m, r)
228 229 230 231 232 233 234
           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 = [] })
235 236 237 238
     LookupNotFound suggest -> do
       let suggest'
             | gopt Opt_HelpfulErrors (hsc_dflags hsc_env) = suggest
             | otherwise = []
239 240 241
       return (NotFound{ fr_paths = [], fr_pkg = Nothing
                       , fr_pkgs_hidden = []
                       , fr_mods_hidden = []
242
                       , fr_unusables = []
243
                       , fr_suggestions = suggest' })
Simon Marlow's avatar
Simon Marlow committed
244

245
modLocationCache :: HscEnv -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult
Simon Marlow's avatar
Simon Marlow committed
246
modLocationCache hsc_env mod do_this = do
247 248 249 250
  m <- lookupFinderCache (hsc_FC hsc_env) mod
  case m of
    Just result -> return result
    Nothing     -> do
Simon Marlow's avatar
Simon Marlow committed
251
        result <- do_this
252
        addToFinderCache (hsc_FC hsc_env) mod result
253
        return result
Simon Marlow's avatar
Simon Marlow committed
254

255
-- This returns a module because it's more convenient for users
Simon Marlow's avatar
Simon Marlow committed
256 257
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder hsc_env mod_name loc = do
Sylvain Henry's avatar
Sylvain Henry committed
258 259
  let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
      mod = mkHomeInstalledModule home_unit mod_name
260
  addToFinderCache (hsc_FC hsc_env) mod (InstalledFound loc mod)
Sylvain Henry's avatar
Sylvain Henry committed
261
  return (mkHomeModule home_unit mod_name)
Simon Marlow's avatar
Simon Marlow committed
262 263

uncacheModule :: HscEnv -> ModuleName -> IO ()
264
uncacheModule hsc_env mod_name = do
Sylvain Henry's avatar
Sylvain Henry committed
265 266
  let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
      mod = mkHomeInstalledModule home_unit mod_name
267
  removeFromFinderCache (hsc_FC hsc_env) mod
268 269

-- -----------------------------------------------------------------------------
270
--      The internal workers
271

272 273 274 275
findHomeModule :: HscEnv -> ModuleName -> IO FindResult
findHomeModule hsc_env mod_name = do
  r <- findInstalledHomeModule hsc_env mod_name
  return $ case r of
Sylvain Henry's avatar
Sylvain Henry committed
276
    InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name)
277 278 279 280 281 282
    InstalledNoPackage _ -> NoPackage uid -- impossible
    InstalledNotFound fps _ -> NotFound {
        fr_paths = fps,
        fr_pkg = Just uid,
        fr_mods_hidden = [],
        fr_pkgs_hidden = [],
283
        fr_unusables = [],
284 285 286
        fr_suggestions = []
      }
 where
Sylvain Henry's avatar
Sylvain Henry committed
287 288 289
  dflags    = hsc_dflags hsc_env
  home_unit = mkHomeUnitFromFlags dflags
  uid       = homeUnitAsUnit (mkHomeUnitFromFlags dflags)
290

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

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

324 325 326 327
     -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that
     -- when hiDir field is set in dflags, we know to look there (see #16500)
     hi_exts = [ (hisuf,                mkHomeModHiOnlyLocation dflags mod_name)
               , (addBootSuffix hisuf,  mkHomeModHiOnlyLocation dflags mod_name)
328 329 330 331 332
               ]

        -- 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.
333
     exts | isOneShot (ghcMode dflags) = hi_exts
334
          | otherwise                  = source_exts
Simon Marlow's avatar
Simon Marlow committed
335
   in
336 337 338 339

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

344

Simon Marlow's avatar
Simon Marlow committed
345
-- | Search for a module in external packages only.
346
findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
Simon Marlow's avatar
Simon Marlow committed
347
findPackageModule hsc_env mod = do
348
  let
349
        dflags = hsc_dflags hsc_env
350
        pkg_id = moduleUnit mod
Sylvain Henry's avatar
Sylvain Henry committed
351
        pkgstate = unitState dflags
Simon Marlow's avatar
Simon Marlow committed
352
  --
Sylvain Henry's avatar
Sylvain Henry committed
353
  case lookupUnitId pkgstate pkg_id of
354
     Nothing -> return (InstalledNoPackage pkg_id)
Simon Marlow's avatar
Simon Marlow committed
355
     Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
356

357 358 359
-- | 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,
360
-- not a reexport (this invariant is upheld by "GHC.Unit.State") and (2)
Sylvain Henry's avatar
Sylvain Henry committed
361
-- the 'UnitInfo' must be consistent with the unit id in the 'Module'.
362 363
-- The redundancy is to avoid an extra lookup in the package state
-- for the appropriate config.
Sylvain Henry's avatar
Sylvain Henry committed
364
findPackageModule_ :: HscEnv -> InstalledModule -> UnitInfo -> IO InstalledFindResult
365
findPackageModule_ hsc_env mod pkg_conf =
366
  ASSERT2( moduleUnit mod == unitId pkg_conf, ppr (moduleUnit mod) <+> ppr (unitId pkg_conf) )
Simon Marlow's avatar
Simon Marlow committed
367 368 369
  modLocationCache hsc_env mod $

  -- special case for GHC.Prim; we won't find it in the filesystem.
370 371
  if mod `installedModuleEq` gHC_PRIM
        then return (InstalledFound (error "GHC.Prim ModLocation") mod)
372
        else
Simon Marlow's avatar
Simon Marlow committed
373 374 375

  let
     dflags = hsc_dflags hsc_env
Sylvain Henry's avatar
Sylvain Henry committed
376
     tag = waysBuildTag (ways dflags)
377

378
           -- hi-suffix for packages depends on the build tag.
379
     package_hisuf | null tag  = "hi"
380
                   | otherwise = tag ++ "_hi"
381

382 383
     mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf

Sylvain Henry's avatar
Sylvain Henry committed
384
     import_dirs = unitImportDirs pkg_conf
385 386
      -- 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
387
  in
388 389 390 391
  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.
392
          let basename = moduleNameSlashes (moduleName mod)
393
          loc <- mk_hi_loc one basename
394
          return (InstalledFound loc mod)
395 396
    _otherwise ->
          searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
397 398 399 400 401

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

searchPathExts
402
  :: [FilePath]         -- paths to search
403
  -> InstalledModule             -- module name
404
  -> [ (
405 406
        FileExt,                                -- suffix
        FilePath -> BaseName -> IO ModLocation  -- action
407
       )
408
     ]
409
  -> IO InstalledFindResult
410

411
searchPathExts paths mod exts
412 413
   = do result <- search to_search
{-
414 415 416 417 418 419 420 421
        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
422

sof's avatar
sof committed
423
  where
424
    basename = moduleNameSlashes (moduleName mod)
425

Simon Marlow's avatar
Simon Marlow committed
426
    to_search :: [(FilePath, IO ModLocation)]
427
    to_search = [ (file, fn path basename)
428 429 430 431 432 433
                | path <- paths,
                  (ext,fn) <- exts,
                  let base | path == "." = basename
                           | otherwise   = path </> basename
                      file = base <.> ext
                ]
434

435
    search [] = return (InstalledNotFound (map fst to_search) (Just (moduleUnit mod)))
436

437
    search ((file, mk_result) : rest) = do
438
      b <- doesFileExist file
439
      if b
440
        then do { loc <- mk_result; return (InstalledFound loc mod) }
441
        else search rest
442

Simon Marlow's avatar
Simon Marlow committed
443
mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
444
                          -> FilePath -> BaseName -> IO ModLocation
445
mkHomeModLocationSearched dflags mod suff path basename = do
Ian Lynagh's avatar
Ian Lynagh committed
446
   mkHomeModLocation2 dflags mod (path </> basename) suff
447 448 449 450

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

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

Simon Marlow's avatar
Simon Marlow committed
481
mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
482
mkHomeModLocation dflags mod src_filename = do
Ian Lynagh's avatar
Ian Lynagh committed
483
   let (basename,extension) = splitExtension src_filename
484
   mkHomeModLocation2 dflags mod basename extension
485

486
mkHomeModLocation2 :: DynFlags
487 488 489 490
                   -> ModuleName
                   -> FilePath  -- Of source module, without suffix
                   -> String    -- Suffix
                   -> IO ModLocation
491
mkHomeModLocation2 dflags mod src_basename ext = do
492
   let mod_basename = moduleNameSlashes mod
493

494 495
       obj_fn = mkObjPath  dflags src_basename mod_basename
       hi_fn  = mkHiPath   dflags src_basename mod_basename
Alec Theriault's avatar
Alec Theriault committed
496
       hie_fn = mkHiePath  dflags src_basename mod_basename
497

Ian Lynagh's avatar
Ian Lynagh committed
498
   return (ModLocation{ ml_hs_file   = Just (src_basename <.> ext),
499
                        ml_hi_file   = hi_fn,
Alec Theriault's avatar
Alec Theriault committed
500 501
                        ml_obj_file  = obj_fn,
                        ml_hie_file  = hie_fn })
502

503 504 505 506 507 508 509 510 511
mkHomeModHiOnlyLocation :: DynFlags
                        -> ModuleName
                        -> FilePath
                        -> BaseName
                        -> IO ModLocation
mkHomeModHiOnlyLocation dflags mod path basename = do
   loc <- mkHomeModLocation2 dflags mod (path </> basename) ""
   return loc { ml_hs_file = Nothing }

Simon Marlow's avatar
Simon Marlow committed
512
mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
513
                    -> IO ModLocation
Simon Marlow's avatar
Simon Marlow committed
514
mkHiOnlyModLocation dflags hisuf path basename
Ian Lynagh's avatar
Ian Lynagh committed
515
 = do let full_basename = path </> basename
516
          obj_fn = mkObjPath  dflags full_basename basename
Alec Theriault's avatar
Alec Theriault committed
517
          hie_fn = mkHiePath  dflags full_basename basename
518
      return ModLocation{    ml_hs_file   = Nothing,
519 520 521 522 523
                             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.
Alec Theriault's avatar
Alec Theriault committed
524 525
                             ml_obj_file  = obj_fn,
                             ml_hie_file  = hie_fn
526
                  }
527

528 529 530
-- | Constructs the filename of a .o file for a given source file.
-- Does /not/ check whether the .o file exists
mkObjPath
531
  :: DynFlags
532 533
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
534 535 536
  -> FilePath
mkObjPath dflags basename mod_basename = obj_basename <.> osuf
  where
537 538 539 540 541
                odir = objectDir dflags
                osuf = objectSuf dflags

                obj_basename | Just dir <- odir = dir </> mod_basename
                             | otherwise        = basename
542 543 544 545 546


-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
mkHiPath
547
  :: DynFlags
548 549
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
550 551 552
  -> FilePath
mkHiPath dflags basename mod_basename = hi_basename <.> hisuf
 where
553 554
                hidir = hiDir dflags
                hisuf = hiSuf dflags
555

556 557
                hi_basename | Just dir <- hidir = dir </> mod_basename
                            | otherwise         = basename
558

Alec Theriault's avatar
Alec Theriault committed
559 560 561 562 563 564 565 566 567 568 569 570 571 572 573
-- | Constructs the filename of a .hie file for a given source file.
-- Does /not/ check whether the .hie file exists
mkHiePath
  :: DynFlags
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
  -> FilePath
mkHiePath dflags basename mod_basename = hie_basename <.> hiesuf
 where
                hiedir = hieDir dflags
                hiesuf = hieSuf dflags

                hie_basename | Just dir <- hiedir = dir </> mod_basename
                             | otherwise          = basename

574

575

576 577 578 579 580 581 582 583
-- -----------------------------------------------------------------------------
-- 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
584
  -> ModuleName
585
  -> ModLocation
586
  -> FilePath
587 588 589

mkStubPaths dflags mod location
  = let
Ian Lynagh's avatar
Ian Lynagh committed
590
        stubdir = stubDir dflags
591

Simon Marlow's avatar
Simon Marlow committed
592
        mod_basename = moduleNameSlashes mod
593
        src_basename = dropExtension $ expectJust "mkStubPaths"
Ian Lynagh's avatar
Ian Lynagh committed
594
                                                  (ml_hs_file location)
595

Ian Lynagh's avatar
Ian Lynagh committed
596 597 598 599 600
        stub_basename0
            | Just dir <- stubdir = dir </> mod_basename
            | otherwise           = src_basename

        stub_basename = stub_basename0 ++ "_stub"
601
     in
602
        stub_basename <.> "h"
603

604
-- -----------------------------------------------------------------------------
605
-- findLinkable isn't related to the other stuff in here,
606
-- but there's no other obvious place for it
607

608 609
findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
findObjectLinkableMaybe mod locn
610
   = do let obj_fn = ml_obj_file locn
611 612 613 614
        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)
615 616 617

-- Make an object linkable when we know the object file exists, and we know
-- its modification time.
618
findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
619 620 621
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)
622 623

-- -----------------------------------------------------------------------------
624 625
-- Error messages

626
cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
627
cannotFindModule dflags mod res = pprWithUnitState unit_state $
628 629
  cantFindErr (sLit cannotFindMsg)
              (sLit "Ambiguous module name")
630
              dflags mod res
631
  where
632
    unit_state = unitState dflags
633 634 635 636 637 638 639 640
    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"
641

642 643 644
cannotFindInterface  :: DynFlags -> ModuleName -> InstalledFindResult -> SDoc
cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
                                           (sLit "Ambiguous interface for")
645

Sylvain Henry's avatar
Sylvain Henry committed
646
cantFindErr :: PtrString -> PtrString -> DynFlags -> ModuleName -> FindResult
647
            -> SDoc
648 649
cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
  | Just pkgs <- unambiguousPackages
650
  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
651
       sep [text "it was found in multiple packages:",
652
                hsep (map ppr pkgs) ]
653
    )
654 655 656 657 658 659 660
  | 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 _) _ _ _)
661
        = Just (moduleUnit m : xs)
662 663
    unambiguousPackage _ _ = Nothing

664 665
    pprMod (m, o) = text "it is bound as" <+> ppr m <+>
                                text "by" <+> pprOrigin m o
666
    pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
667
    pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
668 669
    pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
      if e == Just True
670
          then [text "package" <+> ppr (moduleUnit m)]
671
          else [] ++
672
      map ((text "a reexport in package" <+>)
673
                .ppr.mkUnit) res ++
674
      if f then [text "a package flag"] else []
675 676
      )

677
cantFindErr cannot_find _ dflags mod_name find_result
678 679
  = ptext cannot_find <+> quotes (ppr mod_name)
    $$ more_info
680
  where
Sylvain Henry's avatar
Sylvain Henry committed
681
    pkgs = unitState dflags
Sylvain Henry's avatar
Sylvain Henry committed
682
    home_unit = mkHomeUnitFromFlags dflags
683 684
    more_info
      = case find_result of
685
            NoPackage pkg
686
                -> text "no unit id matching" <+> quotes (ppr pkg) <+>
687
                   text "was found"
Simon Marlow's avatar
Simon Marlow committed
688

689 690
            NotFound { fr_paths = files, fr_pkg = mb_pkg
                     , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
691
                     , fr_unusables = unusables, fr_suggestions = suggest }
Sylvain Henry's avatar
Sylvain Henry committed
692
                | Just pkg <- mb_pkg, not (isHomeUnit home_unit pkg)
693
                -> not_found_in_package pkg files
694

695
                | not (null suggest)
696
                -> pp_suggestions suggest $$ tried_these files dflags
697

698 699
                | null files && null mod_hiddens &&
                  null pkg_hiddens && null unusables
700
                -> text "It is not a module in the current program, or in any known package."
701

702 703
                | otherwise
                -> vcat (map pkg_hidden pkg_hiddens) $$
704
                   vcat (map mod_hidden mod_hiddens) $$
705
                   vcat (map unusable unusables) $$
706
                   tried_these files dflags
707

708
            _ -> panic "cantFindErr"
709

Sylvain Henry's avatar
Sylvain Henry committed
710
    build_tag = waysBuildTag (ways dflags)
711

712 713 714 715 716 717
    not_found_in_package pkg files
       | build_tag /= ""
       = let
            build = if build_tag == "p" then "profiling"
                                        else "\"" ++ build_tag ++ "\""
         in
718 719
         text "Perhaps you haven't installed the " <> text build <>
         text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
720
         tried_these files dflags
721 722

       | otherwise
723 724 725
       = text "There are files missing in the " <> quotes (ppr pkg) <>
         text " package," $$
         text "try running 'ghc-pkg check'." $$
726
         tried_these files dflags
727

728
    pkg_hidden :: Unit -> SDoc
Sylvain Henry's avatar
Sylvain Henry committed
729
    pkg_hidden uid =
730
        text "It is a member of the hidden package"
Sylvain Henry's avatar
Sylvain Henry committed
731
        <+> quotes (ppr uid)
732
        --FIXME: we don't really want to show the unit id here we should
733
        -- show the source package id or installed package id if it's ambiguous
Sylvain Henry's avatar
Sylvain Henry committed
734 735
        <> dot $$ pkg_hidden_hint uid
    pkg_hidden_hint uid
ian@well-typed.com's avatar
ian@well-typed.com committed