1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
|
{-
(c) The University of Glasgow, 2000-2006
\section[Finder]{Module Finder}
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
module GHC.Driver.Finder (
flushFinderCaches,
FindResult(..),
findImportedModule,
findPluginModule,
findExactModule,
findHomeModule,
findExposedPackageModule,
mkHomeModLocation,
mkHomeModLocation2,
mkHiOnlyModLocation,
mkHiPath,
mkObjPath,
addHomeModuleToFinder,
uncacheModule,
mkStubPaths,
findObjectLinkableMaybe,
findObjectLinkable,
cannotFindModule,
cannotFindInterface,
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Unit
import GHC.Driver.Types
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Builtin.Names ( gHC_PRIM )
import GHC.Driver.Session
import GHC.Platform.Ways
import GHC.Utils.Outputable as Outputable
import GHC.Data.Maybe ( expectJust )
import Data.IORef ( IORef, readIORef, atomicModifyIORef' )
import System.Directory
import System.FilePath
import Control.Monad
import Data.Time
type FileExt = String -- Filename extension
type BaseName = String -- Basename of file
-- -----------------------------------------------------------------------------
-- The Finder
-- 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.
-- It does *not* know which particular package a module lives in. Use
-- Packages.lookupModuleInAllUnits for that.
-- -----------------------------------------------------------------------------
-- The finder's cache
-- remove all the home modules from the cache; package modules are
-- assumed to not move around during a session.
flushFinderCaches :: HscEnv -> IO ()
flushFinderCaches hsc_env =
atomicModifyIORef' fc_ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
where
this_pkg = homeUnit (hsc_dflags hsc_env)
fc_ref = hsc_FC hsc_env
is_ext mod _ | not (moduleUnit mod `unitIdEq` this_pkg) = True
| otherwise = False
addToFinderCache :: IORef FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache ref key val =
atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ())
removeFromFinderCache :: IORef FinderCache -> InstalledModule -> IO ()
removeFromFinderCache ref key =
atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ())
lookupFinderCache :: IORef FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
lookupFinderCache ref key = do
c <- readIORef ref
return $! lookupInstalledModuleEnv c key
-- -----------------------------------------------------------------------------
-- The three external entry points
-- | 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.
findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule hsc_env mod_name mb_pkg =
case mb_pkg of
Nothing -> unqual_import
Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
| otherwise -> pkg_import
where
home_import = findHomeModule hsc_env mod_name
pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg
unqual_import = home_import
`orIfNotFound`
findExposedPackageModule hsc_env mod_name Nothing
-- | 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
-- | 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
-- reading the interface for a module mentioned by another interface,
-- for example (a "system import").
findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findExactModule hsc_env mod =
let dflags = hsc_dflags hsc_env
in if moduleUnit mod `unitIdEq` homeUnit dflags
then findInstalledHomeModule hsc_env (moduleName mod)
else findPackageModule hsc_env mod
-- -----------------------------------------------------------------------------
-- Helpers
-- | 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
orIfNotFound this or_this = do
res <- this
case res of
NotFound { fr_paths = paths1, fr_mods_hidden = mh1
, fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 }
-> do res2 <- or_this
case res2 of
NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
, fr_pkgs_hidden = ph2, fr_unusables = u2
, fr_suggestions = s2 }
-> return (NotFound { fr_paths = paths1 ++ paths2
, fr_pkg = mb_pkg2 -- snd arg is the package search
, fr_mods_hidden = mh1 ++ mh2
, fr_pkgs_hidden = ph1 ++ ph2
, fr_unusables = u1 ++ u2
, fr_suggestions = s1 ++ s2 })
_other -> return res2
_other -> return res
-- | 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.)
homeSearchCache :: HscEnv -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
homeSearchCache hsc_env mod_name do_this = do
let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
modLocationCache hsc_env mod do_this
findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
-> IO FindResult
findExposedPackageModule hsc_env mod_name mb_pkg
= findLookupResult hsc_env
$ lookupModuleWithSuggestions
(unitState (hsc_dflags hsc_env)) mod_name mb_pkg
findExposedPluginPackageModule :: HscEnv -> ModuleName
-> IO FindResult
findExposedPluginPackageModule hsc_env mod_name
= findLookupResult hsc_env
$ lookupPluginModuleWithSuggestions
(unitState (hsc_dflags hsc_env)) mod_name Nothing
findLookupResult :: HscEnv -> LookupResult -> IO FindResult
findLookupResult hsc_env r = case r of
LookupFound m pkg_conf -> do
let im = fst (getModuleInstantiation 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 (moduleUnit m))
InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m)
, fr_pkgs_hidden = []
, fr_mods_hidden = []
, fr_unusables = []
, fr_suggestions = []})
LookupMultiple rs ->
return (FoundMultiple rs)
LookupHidden pkg_hiddens mod_hiddens ->
return (NotFound{ fr_paths = [], fr_pkg = Nothing
, fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens
, fr_mods_hidden = map (moduleUnit.fst) mod_hiddens
, fr_unusables = []
, fr_suggestions = [] })
LookupUnusable unusable ->
let unusables' = map get_unusable unusable
get_unusable (m, ModUnusable r) = (moduleUnit 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 = [] })
LookupNotFound suggest -> do
let suggest'
| gopt Opt_HelpfulErrors (hsc_dflags hsc_env) = suggest
| otherwise = []
return (NotFound{ fr_paths = [], fr_pkg = Nothing
, fr_pkgs_hidden = []
, fr_mods_hidden = []
, fr_unusables = []
, fr_suggestions = suggest' })
modLocationCache :: HscEnv -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult
modLocationCache hsc_env mod do_this = do
m <- lookupFinderCache (hsc_FC hsc_env) mod
case m of
Just result -> return result
Nothing -> do
result <- do_this
addToFinderCache (hsc_FC hsc_env) mod result
return result
mkHomeInstalledModule :: DynFlags -> ModuleName -> InstalledModule
mkHomeInstalledModule dflags mod_name =
let iuid = homeUnitId dflags
in Module iuid mod_name
-- This returns a module because it's more convenient for users
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder hsc_env mod_name loc = do
let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
addToFinderCache (hsc_FC hsc_env) mod (InstalledFound loc mod)
return (mkHomeModule (hsc_dflags hsc_env) mod_name)
uncacheModule :: HscEnv -> ModuleName -> IO ()
uncacheModule hsc_env mod_name = do
let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
removeFromFinderCache (hsc_FC hsc_env) mod
-- -----------------------------------------------------------------------------
-- The internal workers
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 = [],
fr_unusables = [],
fr_suggestions = []
}
where
dflags = hsc_dflags hsc_env
uid = homeUnit dflags
-- | Implements the search for a module name in the home package only. Calling
-- this function directly is usually *not* what you want; currently, it's used
-- as a building block for the following operations:
--
-- 1. When you do a normal package lookup, we first check if the module
-- is available in the home module, before looking it up in the package
-- database.
--
-- 2. When you have a package qualified import with package name "this",
-- we shortcut to the home module.
--
-- 3. When we look up an exact 'Module', if the unit id associated with
-- the module is the current home module do a look up in the home module.
--
-- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to
-- call this.)
findInstalledHomeModule :: HscEnv -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule hsc_env mod_name =
homeSearchCache hsc_env mod_name $
let
dflags = hsc_dflags hsc_env
home_path = importPaths dflags
hisuf = hiSuf dflags
mod = mkHomeInstalledModule dflags mod_name
source_exts =
[ ("hs", mkHomeModLocationSearched dflags mod_name "hs")
, ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")
, ("hsig", mkHomeModLocationSearched dflags mod_name "hsig")
, ("lhsig", mkHomeModLocationSearched dflags mod_name "lhsig")
]
-- 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)
]
-- 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.
exts | isOneShot (ghcMode dflags) = hi_exts
| otherwise = source_exts
in
-- 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).
if mod `installedModuleEq` gHC_PRIM
then return (InstalledFound (error "GHC.Prim ModLocation") mod)
else searchPathExts home_path mod exts
-- | Search for a module in external packages only.
findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findPackageModule hsc_env mod = do
let
dflags = hsc_dflags hsc_env
pkg_id = moduleUnit mod
pkgstate = unitState dflags
--
case lookupUnitId pkgstate pkg_id of
Nothing -> return (InstalledNoPackage pkg_id)
Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
-- | Look up the interface file associated with module @mod@. This function
-- requires a few invariants to be upheld: (1) the 'Module' in question must
-- be the module identifier of the *original* implementation of a module,
-- not a reexport (this invariant is upheld by "GHC.Unit.State") and (2)
-- the 'UnitInfo' must be consistent with the unit id in the 'Module'.
-- The redundancy is to avoid an extra lookup in the package state
-- for the appropriate config.
findPackageModule_ :: HscEnv -> InstalledModule -> UnitInfo -> IO InstalledFindResult
findPackageModule_ hsc_env mod pkg_conf =
ASSERT2( moduleUnit mod == unitId pkg_conf, ppr (moduleUnit mod) <+> ppr (unitId pkg_conf) )
modLocationCache hsc_env mod $
-- special case for GHC.Prim; we won't find it in the filesystem.
if mod `installedModuleEq` gHC_PRIM
then return (InstalledFound (error "GHC.Prim ModLocation") mod)
else
let
dflags = hsc_dflags hsc_env
tag = waysBuildTag (ways dflags)
-- hi-suffix for packages depends on the build tag.
package_hisuf | null tag = "hi"
| otherwise = tag ++ "_hi"
mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf
import_dirs = unitImportDirs pkg_conf
-- we never look for a .hi-boot file in an external package;
-- .hi-boot files only make sense for the home package.
in
case import_dirs of
[one] | MkDepend <- ghcMode dflags -> do
-- there's only one place that this .hi file can be, so
-- don't bother looking for it.
let basename = moduleNameSlashes (moduleName mod)
loc <- mk_hi_loc one basename
return (InstalledFound loc mod)
_otherwise ->
searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
-- -----------------------------------------------------------------------------
-- General path searching
searchPathExts
:: [FilePath] -- paths to search
-> InstalledModule -- module name
-> [ (
FileExt, -- suffix
FilePath -> BaseName -> IO ModLocation -- action
)
]
-> IO InstalledFindResult
searchPathExts paths mod exts
= do result <- search to_search
{-
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
where
basename = moduleNameSlashes (moduleName mod)
to_search :: [(FilePath, IO ModLocation)]
to_search = [ (file, fn path basename)
| path <- paths,
(ext,fn) <- exts,
let base | path == "." = basename
| otherwise = path </> basename
file = base <.> ext
]
search [] = return (InstalledNotFound (map fst to_search) (Just (moduleUnit mod)))
search ((file, mk_result) : rest) = do
b <- doesFileExist file
if b
then do { loc <- mk_result; return (InstalledFound loc mod) }
else search rest
mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
-> FilePath -> BaseName -> IO ModLocation
mkHomeModLocationSearched dflags mod suff path basename = do
mkHomeModLocation2 dflags mod (path </> basename) suff
-- -----------------------------------------------------------------------------
-- Constructing a home module location
-- 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:
--
-- (a) Here in the finder, when we are searching for a module to import,
-- using the search path (-i option).
--
-- (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).
--
-- (c) The driver in one-shot mode, when we need to construct a
-- ModLocation for a source file named on the command-line.
--
-- Parameters are:
--
-- mod
-- The name of the module
--
-- path
-- (a): The search path component where the source file was found.
-- (b) and (c): "."
--
-- src_basename
-- (a): (moduleNameSlashes mod)
-- (b) and (c): The filename of the source file, minus its extension
--
-- ext
-- The filename extension of the source file (usually "hs" or "lhs").
mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
mkHomeModLocation dflags mod src_filename = do
let (basename,extension) = splitExtension src_filename
mkHomeModLocation2 dflags mod basename extension
mkHomeModLocation2 :: DynFlags
-> ModuleName
-> FilePath -- Of source module, without suffix
-> String -- Suffix
-> IO ModLocation
mkHomeModLocation2 dflags mod src_basename ext = do
let mod_basename = moduleNameSlashes mod
obj_fn = mkObjPath dflags src_basename mod_basename
hi_fn = mkHiPath dflags src_basename mod_basename
hie_fn = mkHiePath dflags src_basename mod_basename
return (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
ml_hi_file = hi_fn,
ml_obj_file = obj_fn,
ml_hie_file = hie_fn })
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 }
mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
-> IO ModLocation
mkHiOnlyModLocation dflags hisuf path basename
= do let full_basename = path </> basename
obj_fn = mkObjPath dflags full_basename basename
hie_fn = mkHiePath dflags full_basename basename
return ModLocation{ ml_hs_file = Nothing,
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,
ml_hie_file = hie_fn
}
-- | Constructs the filename of a .o file for a given source file.
-- Does /not/ check whether the .o file exists
mkObjPath
:: DynFlags
-> FilePath -- the filename of the source file, minus the extension
-> String -- the module name with dots replaced by slashes
-> FilePath
mkObjPath dflags basename mod_basename = obj_basename <.> osuf
where
odir = objectDir dflags
osuf = objectSuf dflags
obj_basename | Just dir <- odir = dir </> mod_basename
| otherwise = basename
-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
mkHiPath
:: DynFlags
-> FilePath -- the filename of the source file, minus the extension
-> String -- the module name with dots replaced by slashes
-> FilePath
mkHiPath dflags basename mod_basename = hi_basename <.> hisuf
where
hidir = hiDir dflags
hisuf = hiSuf dflags
hi_basename | Just dir <- hidir = dir </> mod_basename
| otherwise = basename
-- | 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
-- -----------------------------------------------------------------------------
-- 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
-> ModuleName
-> ModLocation
-> FilePath
mkStubPaths dflags mod location
= let
stubdir = stubDir dflags
mod_basename = moduleNameSlashes mod
src_basename = dropExtension $ expectJust "mkStubPaths"
(ml_hs_file location)
stub_basename0
| Just dir <- stubdir = dir </> mod_basename
| otherwise = src_basename
stub_basename = stub_basename0 ++ "_stub"
in
stub_basename <.> "h"
-- -----------------------------------------------------------------------------
-- findLinkable isn't related to the other stuff in here,
-- but there's no other obvious place for it
findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
findObjectLinkableMaybe mod locn
= do let obj_fn = ml_obj_file locn
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)
-- Make an object linkable when we know the object file exists, and we know
-- its modification time.
findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
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)
-- -----------------------------------------------------------------------------
-- Error messages
cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
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"
cannotFindInterface :: DynFlags -> ModuleName -> InstalledFindResult -> SDoc
cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
(sLit "Ambiguous interface for")
cantFindErr :: PtrString -> PtrString -> DynFlags -> ModuleName -> FindResult
-> SDoc
cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
| Just pkgs <- unambiguousPackages
= hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
sep [text "it was found in multiple packages:",
hsep (map ppr pkgs) ]
)
| otherwise
= hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
vcat (map pprMod mods)
)
where
unambiguousPackages = foldl' unambiguousPackage (Just []) mods
unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
= Just (moduleUnit m : xs)
unambiguousPackage _ _ = Nothing
pprMod (m, o) = text "it is bound as" <+> ppr m <+>
text "by" <+> pprOrigin m o
pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
if e == Just True
then [text "package" <+> ppr (moduleUnit m)]
else [] ++
map ((text "a reexport in package" <+>)
.ppr.mkUnit) res ++
if f then [text "a package flag"] else []
)
cantFindErr cannot_find _ dflags mod_name find_result
= ptext cannot_find <+> quotes (ppr mod_name)
$$ more_info
where
pkgs = unitState dflags
more_info
= case find_result of
NoPackage pkg
-> text "no unit id matching" <+> quotes (ppr pkg) <+>
text "was found"
NotFound { fr_paths = files, fr_pkg = mb_pkg
, fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
, fr_unusables = unusables, fr_suggestions = suggest }
| Just pkg <- mb_pkg, pkg /= homeUnit dflags
-> not_found_in_package pkg files
| not (null suggest)
-> pp_suggestions suggest $$ tried_these files dflags
| null files && null mod_hiddens &&
null pkg_hiddens && null unusables
-> text "It is not a module in the current program, or in any known package."
| otherwise
-> vcat (map pkg_hidden pkg_hiddens) $$
vcat (map mod_hidden mod_hiddens) $$
vcat (map unusable unusables) $$
tried_these files dflags
_ -> panic "cantFindErr"
build_tag = waysBuildTag (ways dflags)
not_found_in_package pkg files
| build_tag /= ""
= let
build = if build_tag == "p" then "profiling"
else "\"" ++ build_tag ++ "\""
in
text "Perhaps you haven't installed the " <> text build <>
text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
tried_these files dflags
| otherwise
= text "There are files missing in the " <> quotes (ppr pkg) <>
text " package," $$
text "try running 'ghc-pkg check'." $$
tried_these files dflags
pkg_hidden :: Unit -> SDoc
pkg_hidden uid =
text "It is a member of the hidden package"
<+> quotes (ppr uid)
--FIXME: we don't really want to show the unit id here we should
-- show the source package id or installed package id if it's ambiguous
<> dot $$ pkg_hidden_hint uid
pkg_hidden_hint uid
| gopt Opt_BuildingCabalPackage dflags
= let pkg = expectJust "pkg_hidden" (lookupUnit pkgs uid)
in text "Perhaps you need to add" <+>
quotes (ppr (unitPackageName pkg)) <+>
text "to the build-depends in your .cabal file."
| Just pkg <- lookupUnit pkgs uid
= text "You can run" <+>
quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
text "to expose it." $$
text "(Note: this unloads all the modules in the current scope.)"
| otherwise = Outputable.empty
mod_hidden pkg =
text "it is a hidden module in the package" <+> quotes (ppr pkg)
unusable (pkg, reason)
= text "It is a member of the package"
<+> quotes (ppr pkg)
$$ pprReason (text "which is") reason
pp_suggestions :: [ModuleSuggestion] -> SDoc
pp_suggestions sugs
| null sugs = Outputable.empty
| otherwise = hang (text "Perhaps you meant")
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
where provenance ModHidden = Outputable.empty
provenance (ModUnusable _) = Outputable.empty
provenance (ModOrigin{ fromOrigUnit = e,
fromExposedReexport = res,
fromPackageFlag = f })
| Just True <- e
= parens (text "from" <+> ppr (moduleUnit mod))
| f && moduleName mod == m
= parens (text "from" <+> ppr (moduleUnit mod))
| (pkg:_) <- res
= parens (text "from" <+> ppr (mkUnit pkg)
<> comma <+> text "reexporting" <+> ppr mod)
| f
= parens (text "defined via package flags to be"
<+> ppr mod)
| otherwise = Outputable.empty
pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
where provenance ModHidden = Outputable.empty
provenance (ModUnusable _) = Outputable.empty
provenance (ModOrigin{ fromOrigUnit = e,
fromHiddenReexport = rhs })
| Just False <- e
= parens (text "needs flag -package-id"
<+> ppr (moduleUnit mod))
| (pkg:_) <- rhs
= parens (text "needs flag -package-id"
<+> ppr (mkUnit pkg))
| otherwise = Outputable.empty
cantFindInstalledErr :: PtrString -> PtrString -> DynFlags -> ModuleName
-> InstalledFindResult -> SDoc
cantFindInstalledErr cannot_find _ dflags mod_name find_result
= ptext cannot_find <+> quotes (ppr mod_name)
$$ more_info
where
more_info
= case find_result of
InstalledNoPackage pkg
-> text "no unit id matching" <+> quotes (ppr pkg) <+>
text "was found" $$ looks_like_srcpkgid pkg
InstalledNotFound files mb_pkg
| Just pkg <- mb_pkg, not (pkg `unitIdEq` homeUnit dflags)
-> not_found_in_package pkg files
| null files
-> text "It is not a module in the current program, or in any known package."
| otherwise
-> tried_these files dflags
_ -> panic "cantFindInstalledErr"
build_tag = waysBuildTag (ways dflags)
pkgstate = unitState dflags
looks_like_srcpkgid :: UnitId -> SDoc
looks_like_srcpkgid pk
-- Unsafely coerce a unit id (i.e. an installed package component
-- identifier) into a PackageId and see if it means anything.
| (pkg:pkgs) <- searchPackageId pkgstate (PackageId (unitIdFS pk))
= parens (text "This unit ID looks like the source package ID;" $$
text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$
(if null pkgs then Outputable.empty
else text "and" <+> int (length pkgs) <+> text "other candidates"))
-- Todo: also check if it looks like a package name!
| otherwise = Outputable.empty
not_found_in_package pkg files
| build_tag /= ""
= let
build = if build_tag == "p" then "profiling"
else "\"" ++ build_tag ++ "\""
in
text "Perhaps you haven't installed the " <> text build <>
text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
tried_these files dflags
| otherwise
= text "There are files missing in the " <> quotes (ppr pkg) <>
text " package," $$
text "try running 'ghc-pkg check'." $$
tried_these files dflags
tried_these :: [FilePath] -> DynFlags -> SDoc
tried_these files dflags
| null files = Outputable.empty
| verbosity dflags < 3 =
text "Use -v (or `:set -v` in ghci) " <>
text "to see a list of the files searched for."
| otherwise =
hang (text "Locations searched:") 2 $ vcat (map text files)
|