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