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