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