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