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