More useful error message when a package .hi file cannot be found:
[ghc-hetmet.git] / compiler / main / Finder.lhs
1 %
2 % (c) The University of Glasgow, 2000-2006
3 %
4 \section[Finder]{Module Finder}
5
6 \begin{code}
7 module Finder (
8     flushFinderCaches,
9     FindResult(..),
10     findImportedModule,
11     findExactModule,
12     findHomeModule,
13     mkHomeModLocation,
14     mkHomeModLocation2,
15     mkHiOnlyModLocation,
16     addHomeModuleToFinder,
17     uncacheModule,
18     mkStubPaths,
19
20     findObjectLinkableMaybe,
21     findObjectLinkable,
22
23     cannotFindModule,
24     cannotFindInterface,
25
26   ) where
27
28 import Module
29 import HscTypes
30 import Packages
31 import FastString
32 import Util
33 import PrelNames        ( gHC_PRIM )
34 import DynFlags         ( DynFlags(..), isOneShot, GhcMode(..) )
35 import Outputable
36 import FiniteMap
37 import LazyUniqFM
38 import Maybes           ( expectJust )
39
40 import Distribution.Package hiding (PackageId)
41 import Data.IORef       ( IORef, writeIORef, readIORef, modifyIORef )
42 import Data.List
43 import System.Directory
44 import System.FilePath
45 import System.IO
46 import Control.Monad
47 import System.Time      ( ClockTime )
48
49
50 type FileExt = String   -- Filename extension
51 type BaseName = String  -- Basename of file
52
53 -- -----------------------------------------------------------------------------
54 -- The Finder
55
56 -- The Finder provides a thin filesystem abstraction to the rest of
57 -- the compiler.  For a given module, it can tell you where the
58 -- source, interface, and object files for that module live.
59
60 -- It does *not* know which particular package a module lives in.  Use
61 -- Packages.lookupModuleInAllPackages for that.
62
63 -- -----------------------------------------------------------------------------
64 -- The finder's cache
65
66 -- remove all the home modules from the cache; package modules are
67 -- assumed to not move around during a session.
68 flushFinderCaches :: HscEnv -> IO ()
69 flushFinderCaches hsc_env = do
70   writeIORef fc_ref emptyUFM
71   flushModLocationCache this_pkg mlc_ref
72  where
73         this_pkg = thisPackage (hsc_dflags hsc_env)
74         fc_ref = hsc_FC hsc_env
75         mlc_ref = hsc_MLC hsc_env
76
77 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
78 flushModLocationCache this_pkg ref = do
79   fm <- readIORef ref
80   writeIORef ref $! filterFM is_ext fm
81   return ()
82   where is_ext mod _ | modulePackageId mod /= this_pkg = True
83                      | otherwise = False
84
85 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
86 addToFinderCache       ref key val = modifyIORef ref $ \c -> addToUFM c key val
87
88 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
89 addToModLocationCache  ref key val = modifyIORef ref $ \c -> addToFM c key val
90
91 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
92 removeFromFinderCache      ref key = modifyIORef ref $ \c -> delFromUFM c key
93
94 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
95 removeFromModLocationCache ref key = modifyIORef ref $ \c -> delFromFM c key
96
97 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
98 lookupFinderCache ref key = do 
99    c <- readIORef ref
100    return $! lookupUFM c key
101
102 lookupModLocationCache :: IORef ModLocationCache -> Module
103                        -> IO (Maybe ModLocation)
104 lookupModLocationCache ref key = do
105    c <- readIORef ref
106    return $! lookupFM c key
107
108 -- -----------------------------------------------------------------------------
109 -- The two external entry points
110
111 -- | Locate a module that was imported by the user.  We have the
112 -- module's name, and possibly a package name.  Without a package
113 -- name, this function will use the search path and the known exposed
114 -- packages to find the module, if a package is specified then only
115 -- that package is searched for the module.
116
117 findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
118 findImportedModule hsc_env mod_name mb_pkg =
119   case mb_pkg of
120         Nothing                        -> unqual_import
121         Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
122                  | otherwise           -> pkg_import
123   where
124     home_import   = findHomeModule hsc_env mod_name
125
126     pkg_import    = findExposedPackageModule hsc_env mod_name mb_pkg
127
128     unqual_import = home_import 
129                         `orIfNotFound`
130                       findExposedPackageModule hsc_env mod_name Nothing
131
132 -- | Locate a specific 'Module'.  The purpose of this function is to
133 -- create a 'ModLocation' for a given 'Module', that is to find out
134 -- where the files associated with this module live.  It is used when
135 -- reading the interface for a module mentioned by another interface, 
136 -- for example (a "system import").
137
138 findExactModule :: HscEnv -> Module -> IO FindResult
139 findExactModule hsc_env mod =
140    let dflags = hsc_dflags hsc_env in
141    if modulePackageId mod == thisPackage dflags
142         then findHomeModule hsc_env (moduleName mod)
143         else findPackageModule hsc_env mod
144
145 -- -----------------------------------------------------------------------------
146 -- Helpers
147
148 orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
149 this `orIfNotFound` or_this = do
150   res <- this
151   case res of
152     NotFound here _ -> do
153         res2 <- or_this
154         case res2 of
155            NotFound or_here pkg -> return (NotFound (here ++ or_here) pkg)
156            _other -> return res2
157     _other -> return res
158
159
160 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
161 homeSearchCache hsc_env mod_name do_this = do
162   m <- lookupFinderCache (hsc_FC hsc_env) mod_name
163   case m of 
164     Just result -> return result
165     Nothing     -> do
166         result <- do_this
167         addToFinderCache (hsc_FC hsc_env) mod_name result
168         case result of
169            Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
170            _other        -> return ()
171         return result
172
173 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
174                          -> IO FindResult
175 findExposedPackageModule hsc_env mod_name mb_pkg
176         -- not found in any package:
177   | null found = return (NotFound [] Nothing)
178         -- found in just one exposed package:
179   | [(pkg_conf, _)] <- found_exposed
180         = let pkgid = mkPackageId (package pkg_conf) in      
181           findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
182         -- not found in any exposed package, report how it was hidden:
183   | null found_exposed, ((pkg_conf, exposed_mod):_) <- found
184         = let pkgid = mkPackageId (package pkg_conf) in
185           if not (exposed_mod)
186                 then return (ModuleHidden pkgid)
187                 else return (PackageHidden pkgid)
188   | otherwise
189         = return (FoundMultiple (map (mkPackageId.package.fst) found_exposed))
190   where
191         dflags = hsc_dflags hsc_env
192         found = lookupModuleInAllPackages dflags mod_name
193
194         found_exposed = [ (pkg_conf,exposed_mod) 
195                         | x@(pkg_conf,exposed_mod) <- found,
196                           is_exposed x,
197                           pkg_conf `matches` mb_pkg ]
198
199         is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
200
201         _pkg_conf `matches` Nothing  = True
202         pkg_conf  `matches` Just pkg =
203            case packageName pkg_conf of 
204               PackageName n -> pkg == mkFastString n
205
206
207 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
208 modLocationCache hsc_env mod do_this = do
209   mb_loc <- lookupModLocationCache mlc mod
210   case mb_loc of
211      Just loc -> return (Found loc mod)
212      Nothing  -> do
213         result <- do_this
214         case result of
215             Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
216             _other -> return ()
217         return result
218   where
219     mlc = hsc_MLC hsc_env
220
221 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
222 addHomeModuleToFinder hsc_env mod_name loc = do
223   let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
224   addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
225   addToModLocationCache (hsc_MLC hsc_env) mod loc
226   return mod
227
228 uncacheModule :: HscEnv -> ModuleName -> IO ()
229 uncacheModule hsc_env mod = do
230   let this_pkg = thisPackage (hsc_dflags hsc_env)
231   removeFromFinderCache (hsc_FC hsc_env) mod
232   removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
233
234 -- -----------------------------------------------------------------------------
235 --      The internal workers
236
237 -- | Search for a module in the home package only.
238 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
239 findHomeModule hsc_env mod_name =
240    homeSearchCache hsc_env mod_name $
241    let 
242      dflags = hsc_dflags hsc_env
243      home_path = importPaths dflags
244      hisuf = hiSuf dflags
245      mod = mkModule (thisPackage dflags) mod_name
246
247      source_exts = 
248       [ ("hs",   mkHomeModLocationSearched dflags mod_name "hs")
249       , ("lhs",  mkHomeModLocationSearched dflags mod_name "lhs")
250       ]
251      
252      hi_exts = [ (hisuf,                mkHiOnlyModLocation dflags hisuf)
253                , (addBootSuffix hisuf,  mkHiOnlyModLocation dflags hisuf)
254                ]
255      
256         -- In compilation manager modes, we look for source files in the home
257         -- package because we can compile these automatically.  In one-shot
258         -- compilation mode we look for .hi and .hi-boot files only.
259      exts | isOneShot (ghcMode dflags) = hi_exts
260           | otherwise                  = source_exts
261    in
262
263   -- special case for GHC.Prim; we won't find it in the filesystem.
264   -- This is important only when compiling the base package (where GHC.Prim
265   -- is a home module).
266   if mod == gHC_PRIM 
267         then return (Found (error "GHC.Prim ModLocation") mod)
268         else 
269
270    searchPathExts home_path mod exts
271
272
273 -- | Search for a module in external packages only.
274 findPackageModule :: HscEnv -> Module -> IO FindResult
275 findPackageModule hsc_env mod = do
276   let
277         dflags = hsc_dflags hsc_env
278         pkg_id = modulePackageId mod
279         pkg_map = pkgIdMap (pkgState dflags)
280   --
281   case lookupPackage pkg_map pkg_id of
282      Nothing -> return (NoPackage pkg_id)
283      Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
284       
285 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
286 findPackageModule_ hsc_env mod pkg_conf = 
287   modLocationCache hsc_env mod $
288
289   -- special case for GHC.Prim; we won't find it in the filesystem.
290   if mod == gHC_PRIM 
291         then return (Found (error "GHC.Prim ModLocation") mod)
292         else 
293
294   let
295      dflags = hsc_dflags hsc_env
296      tag = buildTag dflags
297
298            -- hi-suffix for packages depends on the build tag.
299      package_hisuf | null tag  = "hi"
300                    | otherwise = tag ++ "_hi"
301      hi_exts =
302         [ (package_hisuf, mkHiOnlyModLocation dflags package_hisuf) ]
303
304      source_exts = 
305        [ ("hs",   mkHiOnlyModLocation dflags package_hisuf)
306        , ("lhs",  mkHiOnlyModLocation dflags package_hisuf)
307        ]
308
309      -- mkdependHS needs to look for source files in packages too, so
310      -- that we can make dependencies between package before they have
311      -- been built.
312      exts 
313       | MkDepend <- ghcMode dflags = hi_exts ++ source_exts
314       | otherwise                  = hi_exts
315       -- we never look for a .hi-boot file in an external package;
316       -- .hi-boot files only make sense for the home package.
317   in
318   searchPathExts (importDirs pkg_conf) mod exts
319
320 -- -----------------------------------------------------------------------------
321 -- General path searching
322
323 searchPathExts
324   :: [FilePath]         -- paths to search
325   -> Module             -- module name
326   -> [ (
327         FileExt,                                -- suffix
328         FilePath -> BaseName -> IO ModLocation  -- action
329        )
330      ] 
331   -> IO FindResult
332
333 searchPathExts paths mod exts 
334    = do result <- search to_search
335 {-
336         hPutStrLn stderr (showSDoc $
337                 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
338                     , nest 2 (vcat (map text paths))
339                     , case result of
340                         Succeeded (loc, p) -> text "Found" <+> ppr loc
341                         Failed fs          -> text "not found"])
342 -}      
343         return result
344
345   where
346     basename = moduleNameSlashes (moduleName mod)
347
348     to_search :: [(FilePath, IO ModLocation)]
349     to_search = [ (file, fn path basename)
350                 | path <- paths, 
351                   (ext,fn) <- exts,
352                   let base | path == "." = basename
353                            | otherwise   = path </> basename
354                       file = base <.> ext
355                 ]
356
357     search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))
358     search ((file, mk_result) : rest) = do
359       b <- doesFileExist file
360       if b 
361         then do { loc <- mk_result; return (Found loc mod) }
362         else search rest
363
364 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
365                           -> FilePath -> BaseName -> IO ModLocation
366 mkHomeModLocationSearched dflags mod suff path basename = do
367    mkHomeModLocation2 dflags mod (path </> basename) suff
368
369 -- -----------------------------------------------------------------------------
370 -- Constructing a home module location
371
372 -- This is where we construct the ModLocation for a module in the home
373 -- package, for which we have a source file.  It is called from three
374 -- places:
375 --
376 --  (a) Here in the finder, when we are searching for a module to import,
377 --      using the search path (-i option).
378 --
379 --  (b) The compilation manager, when constructing the ModLocation for
380 --      a "root" module (a source file named explicitly on the command line
381 --      or in a :load command in GHCi).
382 --
383 --  (c) The driver in one-shot mode, when we need to construct a
384 --      ModLocation for a source file named on the command-line.
385 --
386 -- Parameters are:
387 --
388 -- mod
389 --      The name of the module
390 --
391 -- path
392 --      (a): The search path component where the source file was found.
393 --      (b) and (c): "."
394 --
395 -- src_basename
396 --      (a): (moduleNameSlashes mod)
397 --      (b) and (c): The filename of the source file, minus its extension
398 --
399 -- ext
400 --      The filename extension of the source file (usually "hs" or "lhs").
401
402 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
403 mkHomeModLocation dflags mod src_filename = do
404    let (basename,extension) = splitExtension src_filename
405    mkHomeModLocation2 dflags mod basename extension
406
407 mkHomeModLocation2 :: DynFlags
408                    -> ModuleName
409                    -> FilePath  -- Of source module, without suffix
410                    -> String    -- Suffix
411                    -> IO ModLocation
412 mkHomeModLocation2 dflags mod src_basename ext = do
413    let mod_basename = moduleNameSlashes mod
414
415    obj_fn  <- mkObjPath  dflags src_basename mod_basename
416    hi_fn   <- mkHiPath   dflags src_basename mod_basename
417
418    return (ModLocation{ ml_hs_file   = Just (src_basename <.> ext),
419                         ml_hi_file   = hi_fn,
420                         ml_obj_file  = obj_fn })
421
422 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
423                     -> IO ModLocation
424 mkHiOnlyModLocation dflags hisuf path basename
425  = do let full_basename = path </> basename
426       obj_fn  <- mkObjPath  dflags full_basename basename
427       return ModLocation{    ml_hs_file   = Nothing,
428                              ml_hi_file   = full_basename <.> hisuf,
429                                 -- Remove the .hi-boot suffix from
430                                 -- hi_file, if it had one.  We always
431                                 -- want the name of the real .hi file
432                                 -- in the ml_hi_file field.
433                              ml_obj_file  = obj_fn
434                   }
435
436 -- | Constructs the filename of a .o file for a given source file.
437 -- Does /not/ check whether the .o file exists
438 mkObjPath
439   :: DynFlags
440   -> FilePath           -- the filename of the source file, minus the extension
441   -> String             -- the module name with dots replaced by slashes
442   -> IO FilePath
443 mkObjPath dflags basename mod_basename
444   = do  let
445                 odir = objectDir dflags
446                 osuf = objectSuf dflags
447         
448                 obj_basename | Just dir <- odir = dir </> mod_basename
449                              | otherwise        = basename
450
451         return (obj_basename <.> osuf)
452
453 -- | Constructs the filename of a .hi file for a given source file.
454 -- Does /not/ check whether the .hi file exists
455 mkHiPath
456   :: DynFlags
457   -> FilePath           -- the filename of the source file, minus the extension
458   -> String             -- the module name with dots replaced by slashes
459   -> IO FilePath
460 mkHiPath dflags basename mod_basename
461   = do  let
462                 hidir = hiDir dflags
463                 hisuf = hiSuf dflags
464
465                 hi_basename | Just dir <- hidir = dir </> mod_basename
466                             | otherwise         = basename
467
468         return (hi_basename <.> hisuf)
469
470
471 -- -----------------------------------------------------------------------------
472 -- Filenames of the stub files
473
474 -- We don't have to store these in ModLocations, because they can be derived
475 -- from other available information, and they're only rarely needed.
476
477 mkStubPaths
478   :: DynFlags
479   -> ModuleName
480   -> ModLocation
481   -> (FilePath,FilePath,FilePath)
482
483 mkStubPaths dflags mod location
484   = let
485         stubdir = stubDir dflags
486
487         mod_basename = moduleNameSlashes mod
488         src_basename = dropExtension $ expectJust "mkStubPaths" 
489                                                   (ml_hs_file location)
490
491         stub_basename0
492             | Just dir <- stubdir = dir </> mod_basename
493             | otherwise           = src_basename
494
495         stub_basename = stub_basename0 ++ "_stub"
496
497         -- this is the filename we're going to use when
498         -- \#including the stub_h file from the .hc file.
499         -- Without -stubdir, we just #include the basename
500         -- (eg. for a module A.B, we #include "B_stub.h"),
501         -- relying on the fact that we add an implicit -I flag
502         -- for the directory in which the source file resides
503         -- (see DriverPipeline.hs).  With -stubdir, we
504         -- \#include "A/B.h", assuming that the user has added
505         -- -I<dir> along with -stubdir <dir>.
506         include_basename
507                 | Just _ <- stubdir = mod_basename 
508                 | otherwise         = takeFileName src_basename
509      in
510         (stub_basename <.> "c",
511          stub_basename <.> "h",
512          (include_basename ++ "_stub") <.> "h")
513         -- the _stub.o filename is derived from the ml_obj_file.
514
515 -- -----------------------------------------------------------------------------
516 -- findLinkable isn't related to the other stuff in here, 
517 -- but there's no other obvious place for it
518
519 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
520 findObjectLinkableMaybe mod locn
521    = do let obj_fn = ml_obj_file locn
522         maybe_obj_time <- modificationTimeIfExists obj_fn
523         case maybe_obj_time of
524           Nothing -> return Nothing
525           Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
526
527 -- Make an object linkable when we know the object file exists, and we know
528 -- its modification time.
529 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
530 findObjectLinkable mod obj_fn obj_time = do
531   let stub_fn = (dropExtension obj_fn ++ "_stub") <.> "o"
532   stub_exist <- doesFileExist stub_fn
533   if stub_exist
534         then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
535         else return (LM obj_time mod [DotO obj_fn])
536
537 -- -----------------------------------------------------------------------------
538 -- Error messages
539
540 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
541 cannotFindModule = cantFindErr (sLit "Could not find module")
542
543 cannotFindInterface  :: DynFlags -> ModuleName -> FindResult -> SDoc
544 cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
545
546 cantFindErr :: LitString -> DynFlags -> ModuleName -> FindResult -> SDoc
547 cantFindErr cannot_find _dflags mod_name (FoundMultiple pkgs)
548   = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon) 2 (
549        sep [ptext (sLit "it was found in multiple packages:"),
550                 hsep (map (text.packageIdString) pkgs)]
551     )
552 cantFindErr cannot_find dflags mod_name find_result
553   = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon)
554        2 more_info
555   where
556     more_info
557       = case find_result of
558             PackageHidden pkg 
559                 -> ptext (sLit "it is a member of package") <+> ppr pkg <> comma
560                    <+> ptext (sLit "which is hidden")
561
562             ModuleHidden pkg
563                 -> ptext (sLit "it is hidden") <+> parens (ptext (sLit "in package")
564                    <+> ppr pkg)
565
566             NoPackage pkg
567                 -> ptext (sLit "no package matching") <+> ppr pkg <+>
568                    ptext (sLit "was found")
569
570             NotFound files mb_pkg
571                 | null files
572                 -> ptext (sLit "it is not a module in the current program, or in any known package.")
573                 | Just pkg <- mb_pkg, pkg /= thisPackage dflags
574                 -> not_found_in_package pkg files
575
576                 | otherwise
577                 -> not_found files
578
579             NotFoundInPackage pkg
580                 -> ptext (sLit "it is not in package") <+> ppr pkg
581
582             _ -> panic "cantFindErr"
583
584     build_tag = buildTag dflags
585
586     not_found_in_package pkg files
587        | build_tag /= ""
588        = let
589             build = if build_tag == "p" then "profiling"
590                                         else "\"" ++ build_tag ++ "\""
591          in
592          ptext (sLit "Perhaps you haven't installed the ") <> text build <>
593          ptext (sLit " libraries for package ") <> ppr pkg <> char '?' $$
594          not_found files
595
596        | otherwise
597        = ptext (sLit "There are files missing in the ") <> ppr pkg <>
598          ptext (sLit " package,") $$
599          ptext (sLit "try running 'ghc-pkg check'.") $$
600          not_found files
601
602     not_found files
603         | verbosity dflags < 3
604         = ptext (sLit "Use -v to see a list of the files searched for.")
605         | otherwise 
606         = hang (ptext (sLit "locations searched:")) 2 (vcat (map text files))
607 \end{code}