never executed always true always false
1 {-
2 (c) The University of Glasgow, 2000-2006
3
4 -}
5
6
7 {-# LANGUAGE FlexibleContexts #-}
8
9 -- | Module finder
10 module GHC.Unit.Finder (
11 FindResult(..),
12 InstalledFindResult(..),
13 FinderOpts(..),
14 FinderCache,
15 initFinderCache,
16 flushFinderCaches,
17 findImportedModule,
18 findPluginModule,
19 findExactModule,
20 findHomeModule,
21 findExposedPackageModule,
22 mkHomeModLocation,
23 mkHomeModLocation2,
24 mkHiOnlyModLocation,
25 mkHiPath,
26 mkObjPath,
27 addHomeModuleToFinder,
28 uncacheModule,
29 mkStubPaths,
30
31 findObjectLinkableMaybe,
32 findObjectLinkable,
33
34 -- Hash cache
35 lookupFileCache
36 ) where
37
38 import GHC.Prelude
39
40 import GHC.Platform.Ways
41
42 import GHC.Builtin.Names ( gHC_PRIM )
43
44 import GHC.Unit.Types
45 import GHC.Unit.Module
46 import GHC.Unit.Home
47 import GHC.Unit.State
48 import GHC.Unit.Finder.Types
49
50 import GHC.Data.Maybe ( expectJust )
51 import qualified GHC.Data.ShortText as ST
52
53 import GHC.Utils.Misc
54 import GHC.Utils.Outputable as Outputable
55 import GHC.Utils.Panic
56
57 import GHC.Linker.Types
58 import GHC.Types.PkgQual
59
60 import GHC.Fingerprint
61 import Data.IORef
62 import System.Directory
63 import System.FilePath
64 import Control.Monad
65 import Data.Time
66 import qualified Data.Map as M
67
68
69 type FileExt = String -- Filename extension
70 type BaseName = String -- Basename of file
71
72 -- -----------------------------------------------------------------------------
73 -- The Finder
74
75 -- The Finder provides a thin filesystem abstraction to the rest of
76 -- the compiler. For a given module, it can tell you where the
77 -- source, interface, and object files for that module live.
78
79 -- It does *not* know which particular package a module lives in. Use
80 -- Packages.lookupModuleInAllUnits for that.
81
82 -- -----------------------------------------------------------------------------
83 -- The finder's cache
84
85
86 initFinderCache :: IO FinderCache
87 initFinderCache = FinderCache <$> newIORef emptyInstalledModuleEnv
88 <*> newIORef M.empty
89
90 -- remove all the home modules from the cache; package modules are
91 -- assumed to not move around during a session; also flush the file hash
92 -- cache
93 flushFinderCaches :: FinderCache -> HomeUnit -> IO ()
94 flushFinderCaches (FinderCache ref file_ref) home_unit = do
95 atomicModifyIORef' ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
96 atomicModifyIORef' file_ref $ \_ -> (M.empty, ())
97 where
98 is_ext mod _ = not (isHomeInstalledModule home_unit mod)
99
100 addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
101 addToFinderCache (FinderCache ref _) key val =
102 atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ())
103
104 removeFromFinderCache :: FinderCache -> InstalledModule -> IO ()
105 removeFromFinderCache (FinderCache ref _) key =
106 atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ())
107
108 lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
109 lookupFinderCache (FinderCache ref _) key = do
110 c <- readIORef ref
111 return $! lookupInstalledModuleEnv c key
112
113 lookupFileCache :: FinderCache -> FilePath -> IO Fingerprint
114 lookupFileCache (FinderCache _ ref) key = do
115 c <- readIORef ref
116 case M.lookup key c of
117 Nothing -> do
118 hash <- getFileHash key
119 atomicModifyIORef' ref $ \c -> (M.insert key hash c, ())
120 return hash
121 Just fp -> return fp
122
123 -- -----------------------------------------------------------------------------
124 -- The three external entry points
125
126
127 -- | Locate a module that was imported by the user. We have the
128 -- module's name, and possibly a package name. Without a package
129 -- name, this function will use the search path and the known exposed
130 -- packages to find the module, if a package is specified then only
131 -- that package is searched for the module.
132
133 findImportedModule
134 :: FinderCache
135 -> FinderOpts
136 -> UnitState
137 -> HomeUnit
138 -> ModuleName
139 -> PkgQual
140 -> IO FindResult
141 findImportedModule fc fopts units home_unit mod_name mb_pkg =
142 case mb_pkg of
143 NoPkgQual -> unqual_import
144 ThisPkg _ -> home_import
145 OtherPkg _ -> pkg_import
146 where
147 home_import = findHomeModule fc fopts home_unit mod_name
148 pkg_import = findExposedPackageModule fc fopts units mod_name mb_pkg
149 unqual_import = home_import
150 `orIfNotFound`
151 findExposedPackageModule fc fopts units mod_name NoPkgQual
152
153 -- | Locate a plugin module requested by the user, for a compiler
154 -- plugin. This consults the same set of exposed packages as
155 -- 'findImportedModule', unless @-hide-all-plugin-packages@ or
156 -- @-plugin-package@ are specified.
157 findPluginModule :: FinderCache -> FinderOpts -> UnitState -> HomeUnit -> ModuleName -> IO FindResult
158 findPluginModule fc fopts units home_unit mod_name =
159 findHomeModule fc fopts home_unit mod_name
160 `orIfNotFound`
161 findExposedPluginPackageModule fc fopts units mod_name
162
163 -- | Locate a specific 'Module'. The purpose of this function is to
164 -- create a 'ModLocation' for a given 'Module', that is to find out
165 -- where the files associated with this module live. It is used when
166 -- reading the interface for a module mentioned by another interface,
167 -- for example (a "system import").
168
169 findExactModule :: FinderCache -> FinderOpts -> UnitState -> HomeUnit -> InstalledModule -> IO InstalledFindResult
170 findExactModule fc fopts unit_state home_unit mod = do
171 if isHomeInstalledModule home_unit mod
172 then findInstalledHomeModule fc fopts home_unit (moduleName mod)
173 else findPackageModule fc unit_state fopts mod
174
175 -- -----------------------------------------------------------------------------
176 -- Helpers
177
178 -- | Given a monadic actions @this@ and @or_this@, first execute
179 -- @this@. If the returned 'FindResult' is successful, return
180 -- it; otherwise, execute @or_this@. If both failed, this function
181 -- also combines their failure messages in a reasonable way.
182 orIfNotFound :: Monad m => m FindResult -> m FindResult -> m FindResult
183 orIfNotFound this or_this = do
184 res <- this
185 case res of
186 NotFound { fr_paths = paths1, fr_mods_hidden = mh1
187 , fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 }
188 -> do res2 <- or_this
189 case res2 of
190 NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
191 , fr_pkgs_hidden = ph2, fr_unusables = u2
192 , fr_suggestions = s2 }
193 -> return (NotFound { fr_paths = paths1 ++ paths2
194 , fr_pkg = mb_pkg2 -- snd arg is the package search
195 , fr_mods_hidden = mh1 ++ mh2
196 , fr_pkgs_hidden = ph1 ++ ph2
197 , fr_unusables = u1 ++ u2
198 , fr_suggestions = s1 ++ s2 })
199 _other -> return res2
200 _other -> return res
201
202 -- | Helper function for 'findHomeModule': this function wraps an IO action
203 -- which would look up @mod_name@ in the file system (the home package),
204 -- and first consults the 'hsc_FC' cache to see if the lookup has already
205 -- been done. Otherwise, do the lookup (with the IO action) and save
206 -- the result in the finder cache and the module location cache (if it
207 -- was successful.)
208 homeSearchCache :: FinderCache -> HomeUnit -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
209 homeSearchCache fc home_unit mod_name do_this = do
210 let mod = mkHomeInstalledModule home_unit mod_name
211 modLocationCache fc mod do_this
212
213 findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> PkgQual -> IO FindResult
214 findExposedPackageModule fc fopts units mod_name mb_pkg =
215 findLookupResult fc fopts
216 $ lookupModuleWithSuggestions units mod_name mb_pkg
217
218 findExposedPluginPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> IO FindResult
219 findExposedPluginPackageModule fc fopts units mod_name =
220 findLookupResult fc fopts
221 $ lookupPluginModuleWithSuggestions units mod_name NoPkgQual
222
223 findLookupResult :: FinderCache -> FinderOpts -> LookupResult -> IO FindResult
224 findLookupResult fc fopts r = case r of
225 LookupFound m pkg_conf -> do
226 let im = fst (getModuleInstantiation m)
227 r' <- findPackageModule_ fc fopts im (fst pkg_conf)
228 case r' of
229 -- TODO: ghc -M is unlikely to do the right thing
230 -- with just the location of the thing that was
231 -- instantiated; you probably also need all of the
232 -- implicit locations from the instances
233 InstalledFound loc _ -> return (Found loc m)
234 InstalledNoPackage _ -> return (NoPackage (moduleUnit m))
235 InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m)
236 , fr_pkgs_hidden = []
237 , fr_mods_hidden = []
238 , fr_unusables = []
239 , fr_suggestions = []})
240 LookupMultiple rs ->
241 return (FoundMultiple rs)
242 LookupHidden pkg_hiddens mod_hiddens ->
243 return (NotFound{ fr_paths = [], fr_pkg = Nothing
244 , fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens
245 , fr_mods_hidden = map (moduleUnit.fst) mod_hiddens
246 , fr_unusables = []
247 , fr_suggestions = [] })
248 LookupUnusable unusable ->
249 let unusables' = map get_unusable unusable
250 get_unusable (m, ModUnusable r) = (moduleUnit m, r)
251 get_unusable (_, r) =
252 pprPanic "findLookupResult: unexpected origin" (ppr r)
253 in return (NotFound{ fr_paths = [], fr_pkg = Nothing
254 , fr_pkgs_hidden = []
255 , fr_mods_hidden = []
256 , fr_unusables = unusables'
257 , fr_suggestions = [] })
258 LookupNotFound suggest -> do
259 let suggest'
260 | finder_enableSuggestions fopts = suggest
261 | otherwise = []
262 return (NotFound{ fr_paths = [], fr_pkg = Nothing
263 , fr_pkgs_hidden = []
264 , fr_mods_hidden = []
265 , fr_unusables = []
266 , fr_suggestions = suggest' })
267
268 modLocationCache :: FinderCache -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult
269 modLocationCache fc mod do_this = do
270 m <- lookupFinderCache fc mod
271 case m of
272 Just result -> return result
273 Nothing -> do
274 result <- do_this
275 addToFinderCache fc mod result
276 return result
277
278 -- This returns a module because it's more convenient for users
279 addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module
280 addHomeModuleToFinder fc home_unit mod_name loc = do
281 let mod = mkHomeInstalledModule home_unit mod_name
282 addToFinderCache fc mod (InstalledFound loc mod)
283 return (mkHomeModule home_unit mod_name)
284
285 uncacheModule :: FinderCache -> HomeUnit -> ModuleName -> IO ()
286 uncacheModule fc home_unit mod_name = do
287 let mod = mkHomeInstalledModule home_unit mod_name
288 removeFromFinderCache fc mod
289
290 -- -----------------------------------------------------------------------------
291 -- The internal workers
292
293 findHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult
294 findHomeModule fc fopts home_unit mod_name = do
295 let uid = homeUnitAsUnit home_unit
296 r <- findInstalledHomeModule fc fopts home_unit mod_name
297 return $ case r of
298 InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name)
299 InstalledNoPackage _ -> NoPackage uid -- impossible
300 InstalledNotFound fps _ -> NotFound {
301 fr_paths = fps,
302 fr_pkg = Just uid,
303 fr_mods_hidden = [],
304 fr_pkgs_hidden = [],
305 fr_unusables = [],
306 fr_suggestions = []
307 }
308
309 -- | Implements the search for a module name in the home package only. Calling
310 -- this function directly is usually *not* what you want; currently, it's used
311 -- as a building block for the following operations:
312 --
313 -- 1. When you do a normal package lookup, we first check if the module
314 -- is available in the home module, before looking it up in the package
315 -- database.
316 --
317 -- 2. When you have a package qualified import with package name "this",
318 -- we shortcut to the home module.
319 --
320 -- 3. When we look up an exact 'Module', if the unit id associated with
321 -- the module is the current home module do a look up in the home module.
322 --
323 -- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to
324 -- call this.)
325 findInstalledHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO InstalledFindResult
326 findInstalledHomeModule fc fopts home_unit mod_name = do
327 homeSearchCache fc home_unit mod_name $
328 let
329 home_path = finder_importPaths fopts
330 hisuf = finder_hiSuf fopts
331 mod = mkHomeInstalledModule home_unit mod_name
332
333 source_exts =
334 [ ("hs", mkHomeModLocationSearched fopts mod_name "hs")
335 , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs")
336 , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig")
337 , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig")
338 ]
339
340 -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that
341 -- when hiDir field is set in dflags, we know to look there (see #16500)
342 hi_exts = [ (hisuf, mkHomeModHiOnlyLocation fopts mod_name)
343 , (addBootSuffix hisuf, mkHomeModHiOnlyLocation fopts mod_name)
344 ]
345
346 -- In compilation manager modes, we look for source files in the home
347 -- package because we can compile these automatically. In one-shot
348 -- compilation mode we look for .hi and .hi-boot files only.
349 exts | finder_lookupHomeInterfaces fopts = hi_exts
350 | otherwise = source_exts
351 in
352
353 -- special case for GHC.Prim; we won't find it in the filesystem.
354 -- This is important only when compiling the base package (where GHC.Prim
355 -- is a home module).
356 if mod `installedModuleEq` gHC_PRIM
357 then return (InstalledFound (error "GHC.Prim ModLocation") mod)
358 else searchPathExts home_path mod exts
359
360
361 -- | Search for a module in external packages only.
362 findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult
363 findPackageModule fc unit_state fopts mod = do
364 let pkg_id = moduleUnit mod
365 case lookupUnitId unit_state pkg_id of
366 Nothing -> return (InstalledNoPackage pkg_id)
367 Just u -> findPackageModule_ fc fopts mod u
368
369 -- | Look up the interface file associated with module @mod@. This function
370 -- requires a few invariants to be upheld: (1) the 'Module' in question must
371 -- be the module identifier of the *original* implementation of a module,
372 -- not a reexport (this invariant is upheld by "GHC.Unit.State") and (2)
373 -- the 'UnitInfo' must be consistent with the unit id in the 'Module'.
374 -- The redundancy is to avoid an extra lookup in the package state
375 -- for the appropriate config.
376 findPackageModule_ :: FinderCache -> FinderOpts -> InstalledModule -> UnitInfo -> IO InstalledFindResult
377 findPackageModule_ fc fopts mod pkg_conf = do
378 massertPpr (moduleUnit mod == unitId pkg_conf)
379 (ppr (moduleUnit mod) <+> ppr (unitId pkg_conf))
380 modLocationCache fc mod $
381
382 -- special case for GHC.Prim; we won't find it in the filesystem.
383 if mod `installedModuleEq` gHC_PRIM
384 then return (InstalledFound (error "GHC.Prim ModLocation") mod)
385 else
386
387 let
388 tag = waysBuildTag (finder_ways fopts)
389
390 -- hi-suffix for packages depends on the build tag.
391 package_hisuf | null tag = "hi"
392 | otherwise = tag ++ "_hi"
393
394 package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi"
395
396 mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf
397
398 import_dirs = map ST.unpack $ unitImportDirs pkg_conf
399 -- we never look for a .hi-boot file in an external package;
400 -- .hi-boot files only make sense for the home package.
401 in
402 case import_dirs of
403 [one] | finder_bypassHiFileCheck fopts ->
404 -- there's only one place that this .hi file can be, so
405 -- don't bother looking for it.
406 let basename = moduleNameSlashes (moduleName mod)
407 loc = mk_hi_loc one basename
408 in return $ InstalledFound loc mod
409 _otherwise ->
410 searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
411
412 -- -----------------------------------------------------------------------------
413 -- General path searching
414
415 searchPathExts :: [FilePath] -- paths to search
416 -> InstalledModule -- module name
417 -> [ (
418 FileExt, -- suffix
419 FilePath -> BaseName -> ModLocation -- action
420 )
421 ]
422 -> IO InstalledFindResult
423
424 searchPathExts paths mod exts = search to_search
425 where
426 basename = moduleNameSlashes (moduleName mod)
427
428 to_search :: [(FilePath, ModLocation)]
429 to_search = [ (file, fn path basename)
430 | path <- paths,
431 (ext,fn) <- exts,
432 let base | path == "." = basename
433 | otherwise = path </> basename
434 file = base <.> ext
435 ]
436
437 search [] = return (InstalledNotFound (map fst to_search) (Just (moduleUnit mod)))
438
439 search ((file, loc) : rest) = do
440 b <- doesFileExist file
441 if b
442 then return $ InstalledFound loc mod
443 else search rest
444
445 mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt
446 -> FilePath -> BaseName -> ModLocation
447 mkHomeModLocationSearched fopts mod suff path basename =
448 mkHomeModLocation2 fopts mod (path </> basename) suff
449
450
451 -- -----------------------------------------------------------------------------
452 -- Constructing a home module location
453
454 -- This is where we construct the ModLocation for a module in the home
455 -- package, for which we have a source file. It is called from three
456 -- places:
457 --
458 -- (a) Here in the finder, when we are searching for a module to import,
459 -- using the search path (-i option).
460 --
461 -- (b) The compilation manager, when constructing the ModLocation for
462 -- a "root" module (a source file named explicitly on the command line
463 -- or in a :load command in GHCi).
464 --
465 -- (c) The driver in one-shot mode, when we need to construct a
466 -- ModLocation for a source file named on the command-line.
467 --
468 -- Parameters are:
469 --
470 -- mod
471 -- The name of the module
472 --
473 -- path
474 -- (a): The search path component where the source file was found.
475 -- (b) and (c): "."
476 --
477 -- src_basename
478 -- (a): (moduleNameSlashes mod)
479 -- (b) and (c): The filename of the source file, minus its extension
480 --
481 -- ext
482 -- The filename extension of the source file (usually "hs" or "lhs").
483
484 mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation
485 mkHomeModLocation dflags mod src_filename =
486 let (basename,extension) = splitExtension src_filename
487 in mkHomeModLocation2 dflags mod basename extension
488
489 mkHomeModLocation2 :: FinderOpts
490 -> ModuleName
491 -> FilePath -- Of source module, without suffix
492 -> String -- Suffix
493 -> ModLocation
494 mkHomeModLocation2 fopts mod src_basename ext =
495 let mod_basename = moduleNameSlashes mod
496
497 obj_fn = mkObjPath fopts src_basename mod_basename
498 dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename
499 hi_fn = mkHiPath fopts src_basename mod_basename
500 dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename
501 hie_fn = mkHiePath fopts src_basename mod_basename
502
503 in (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
504 ml_hi_file = hi_fn,
505 ml_dyn_hi_file = dyn_hi_fn,
506 ml_obj_file = obj_fn,
507 ml_dyn_obj_file = dyn_obj_fn,
508 ml_hie_file = hie_fn })
509
510 mkHomeModHiOnlyLocation :: FinderOpts
511 -> ModuleName
512 -> FilePath
513 -> BaseName
514 -> ModLocation
515 mkHomeModHiOnlyLocation fopts mod path basename =
516 let loc = mkHomeModLocation2 fopts mod (path </> basename) ""
517 in loc { ml_hs_file = Nothing }
518
519 -- This function is used to make a ModLocation for a package module. Hence why
520 -- we explicitly pass in the interface file suffixes.
521 mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String
522 -> ModLocation
523 mkHiOnlyModLocation fopts hisuf dynhisuf path basename
524 = let full_basename = path </> basename
525 obj_fn = mkObjPath fopts full_basename basename
526 dyn_obj_fn = mkDynObjPath fopts full_basename basename
527 hie_fn = mkHiePath fopts full_basename basename
528 in ModLocation{ ml_hs_file = Nothing,
529 ml_hi_file = full_basename <.> hisuf,
530 -- Remove the .hi-boot suffix from
531 -- hi_file, if it had one. We always
532 -- want the name of the real .hi file
533 -- in the ml_hi_file field.
534 ml_dyn_obj_file = dyn_obj_fn,
535 -- MP: TODO
536 ml_dyn_hi_file = full_basename <.> dynhisuf,
537 ml_obj_file = obj_fn,
538 ml_hie_file = hie_fn
539 }
540
541 -- | Constructs the filename of a .o file for a given source file.
542 -- Does /not/ check whether the .o file exists
543 mkObjPath
544 :: FinderOpts
545 -> FilePath -- the filename of the source file, minus the extension
546 -> String -- the module name with dots replaced by slashes
547 -> FilePath
548 mkObjPath fopts basename mod_basename = obj_basename <.> osuf
549 where
550 odir = finder_objectDir fopts
551 osuf = finder_objectSuf fopts
552
553 obj_basename | Just dir <- odir = dir </> mod_basename
554 | otherwise = basename
555
556 -- | Constructs the filename of a .dyn_o file for a given source file.
557 -- Does /not/ check whether the .dyn_o file exists
558 mkDynObjPath
559 :: FinderOpts
560 -> FilePath -- the filename of the source file, minus the extension
561 -> String -- the module name with dots replaced by slashes
562 -> FilePath
563 mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf
564 where
565 odir = finder_objectDir fopts
566 dynosuf = finder_dynObjectSuf fopts
567
568 obj_basename | Just dir <- odir = dir </> mod_basename
569 | otherwise = basename
570
571
572 -- | Constructs the filename of a .hi file for a given source file.
573 -- Does /not/ check whether the .hi file exists
574 mkHiPath
575 :: FinderOpts
576 -> FilePath -- the filename of the source file, minus the extension
577 -> String -- the module name with dots replaced by slashes
578 -> FilePath
579 mkHiPath fopts basename mod_basename = hi_basename <.> hisuf
580 where
581 hidir = finder_hiDir fopts
582 hisuf = finder_hiSuf fopts
583
584 hi_basename | Just dir <- hidir = dir </> mod_basename
585 | otherwise = basename
586
587 -- | Constructs the filename of a .dyn_hi file for a given source file.
588 -- Does /not/ check whether the .dyn_hi file exists
589 mkDynHiPath
590 :: FinderOpts
591 -> FilePath -- the filename of the source file, minus the extension
592 -> String -- the module name with dots replaced by slashes
593 -> FilePath
594 mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf
595 where
596 hidir = finder_hiDir fopts
597 dynhisuf = finder_dynHiSuf fopts
598
599 hi_basename | Just dir <- hidir = dir </> mod_basename
600 | otherwise = basename
601
602 -- | Constructs the filename of a .hie file for a given source file.
603 -- Does /not/ check whether the .hie file exists
604 mkHiePath
605 :: FinderOpts
606 -> FilePath -- the filename of the source file, minus the extension
607 -> String -- the module name with dots replaced by slashes
608 -> FilePath
609 mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf
610 where
611 hiedir = finder_hieDir fopts
612 hiesuf = finder_hieSuf fopts
613
614 hie_basename | Just dir <- hiedir = dir </> mod_basename
615 | otherwise = basename
616
617
618
619 -- -----------------------------------------------------------------------------
620 -- Filenames of the stub files
621
622 -- We don't have to store these in ModLocations, because they can be derived
623 -- from other available information, and they're only rarely needed.
624
625 mkStubPaths
626 :: FinderOpts
627 -> ModuleName
628 -> ModLocation
629 -> FilePath
630
631 mkStubPaths fopts mod location
632 = let
633 stubdir = finder_stubDir fopts
634
635 mod_basename = moduleNameSlashes mod
636 src_basename = dropExtension $ expectJust "mkStubPaths"
637 (ml_hs_file location)
638
639 stub_basename0
640 | Just dir <- stubdir = dir </> mod_basename
641 | otherwise = src_basename
642
643 stub_basename = stub_basename0 ++ "_stub"
644 in
645 stub_basename <.> "h"
646
647 -- -----------------------------------------------------------------------------
648 -- findLinkable isn't related to the other stuff in here,
649 -- but there's no other obvious place for it
650
651 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
652 findObjectLinkableMaybe mod locn
653 = do let obj_fn = ml_obj_file locn
654 maybe_obj_time <- modificationTimeIfExists obj_fn
655 case maybe_obj_time of
656 Nothing -> return Nothing
657 Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
658
659 -- Make an object linkable when we know the object file exists, and we know
660 -- its modification time.
661 findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
662 findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn])
663 -- We used to look for _stub.o files here, but that was a bug (#706)
664 -- Now GHC merges the stub.o into the main .o (#3687)
665