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