2 % (c) The University of Glasgow, 2000-2006
4 \section[Finder]{Module Finder}
13 findExposedPackageModule,
17 addHomeModuleToFinder,
21 findObjectLinkableMaybe,
34 import PrelNames ( gHC_PRIM )
38 import Maybes ( expectJust )
39 import Exception ( evaluate )
41 import Distribution.Text
42 import Distribution.Package hiding (PackageId)
43 import Data.IORef ( IORef, writeIORef, readIORef, atomicModifyIORef )
44 import System.Directory
45 import System.FilePath
47 import System.Time ( ClockTime )
50 type FileExt = String -- Filename extension
51 type BaseName = String -- Basename of file
53 -- -----------------------------------------------------------------------------
56 -- The Finder provides a thin filesystem abstraction to the rest of
57 -- the compiler. For a given module, it can tell you where the
58 -- source, interface, and object files for that module live.
60 -- It does *not* know which particular package a module lives in. Use
61 -- Packages.lookupModuleInAllPackages for that.
63 -- -----------------------------------------------------------------------------
66 -- remove all the home modules from the cache; package modules are
67 -- assumed to not move around during a session.
68 flushFinderCaches :: HscEnv -> IO ()
69 flushFinderCaches hsc_env = do
70 -- Ideally the update to both caches be a single atomic operation.
71 writeIORef fc_ref emptyUFM
72 flushModLocationCache this_pkg mlc_ref
74 this_pkg = thisPackage (hsc_dflags hsc_env)
75 fc_ref = hsc_FC hsc_env
76 mlc_ref = hsc_MLC hsc_env
78 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
79 flushModLocationCache this_pkg ref = do
80 atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
81 _ <- evaluate =<< readIORef ref
83 where is_ext mod _ | modulePackageId mod /= this_pkg = True
86 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
87 addToFinderCache ref key val =
88 atomicModifyIORef ref $ \c -> (addToUFM c key val, ())
90 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
91 addToModLocationCache ref key val =
92 atomicModifyIORef ref $ \c -> (extendModuleEnv c key val, ())
94 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
95 removeFromFinderCache ref key =
96 atomicModifyIORef ref $ \c -> (delFromUFM c key, ())
98 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
99 removeFromModLocationCache ref key =
100 atomicModifyIORef ref $ \c -> (delModuleEnv c key, ())
102 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
103 lookupFinderCache ref key = do
105 return $! lookupUFM c key
107 lookupModLocationCache :: IORef ModLocationCache -> Module
108 -> IO (Maybe ModLocation)
109 lookupModLocationCache ref key = do
111 return $! lookupModuleEnv c key
113 -- -----------------------------------------------------------------------------
114 -- The two external entry points
116 -- | Locate a module that was imported by the user. We have the
117 -- module's name, and possibly a package name. Without a package
118 -- name, this function will use the search path and the known exposed
119 -- packages to find the module, if a package is specified then only
120 -- that package is searched for the module.
122 findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
123 findImportedModule hsc_env mod_name mb_pkg =
125 Nothing -> unqual_import
126 Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
127 | otherwise -> pkg_import
129 home_import = findHomeModule hsc_env mod_name
131 pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg
133 unqual_import = home_import
135 findExposedPackageModule hsc_env mod_name Nothing
137 -- | Locate a specific 'Module'. The purpose of this function is to
138 -- create a 'ModLocation' for a given 'Module', that is to find out
139 -- where the files associated with this module live. It is used when
140 -- reading the interface for a module mentioned by another interface,
141 -- for example (a "system import").
143 findExactModule :: HscEnv -> Module -> IO FindResult
144 findExactModule hsc_env mod =
145 let dflags = hsc_dflags hsc_env in
146 if modulePackageId mod == thisPackage dflags
147 then findHomeModule hsc_env (moduleName mod)
148 else findPackageModule hsc_env mod
150 -- -----------------------------------------------------------------------------
153 orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
154 orIfNotFound this or_this = do
157 NotFound { fr_paths = paths1, fr_mods_hidden = mh1
158 , fr_pkgs_hidden = ph1, fr_suggestions = s1 }
159 -> do res2 <- or_this
161 NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
162 , fr_pkgs_hidden = ph2, fr_suggestions = s2 }
163 -> return (NotFound { fr_paths = paths1 ++ paths2
164 , fr_pkg = mb_pkg2 -- snd arg is the package search
165 , fr_mods_hidden = mh1 ++ mh2
166 , fr_pkgs_hidden = ph1 ++ ph2
167 , fr_suggestions = s1 ++ s2 })
168 _other -> return res2
172 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
173 homeSearchCache hsc_env mod_name do_this = do
174 m <- lookupFinderCache (hsc_FC hsc_env) mod_name
176 Just result -> return result
179 addToFinderCache (hsc_FC hsc_env) mod_name result
181 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
185 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
187 findExposedPackageModule hsc_env mod_name mb_pkg
188 -- not found in any package:
189 = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name of
190 Left suggest -> return (NotFound { fr_paths = [], fr_pkg = Nothing
191 , fr_pkgs_hidden = [], fr_mods_hidden = []
192 , fr_suggestions = suggest })
194 | null found_exposed -- Found, but with no exposed copies
195 -> return (NotFound { fr_paths = [], fr_pkg = Nothing
196 , fr_pkgs_hidden = mod_hiddens, fr_mods_hidden = pkg_hiddens
197 , fr_suggestions = [] })
199 | [(pkg_conf,_)] <- found_exposed -- Found uniquely
200 -> let pkgid = packageConfigId pkg_conf in
201 findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
203 | otherwise -- Found in more than one place
204 -> return (FoundMultiple (map (packageConfigId.fst) found_exposed))
206 for_this_pkg = case mb_pkg of
208 Just p -> filter ((`matches` p) . fst) found
209 found_exposed = filter is_exposed for_this_pkg
210 is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
212 mod_hiddens = [ packageConfigId pkg_conf
213 | (pkg_conf,False) <- found ]
215 pkg_hiddens = [ packageConfigId pkg_conf
216 | (pkg_conf,_) <- found, not (exposed pkg_conf) ]
218 pkg_conf `matches` pkg
219 = case packageName pkg_conf of
220 PackageName n -> pkg == mkFastString n
222 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
223 modLocationCache hsc_env mod do_this = do
224 mb_loc <- lookupModLocationCache mlc mod
226 Just loc -> return (Found loc mod)
230 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
234 mlc = hsc_MLC hsc_env
236 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
237 addHomeModuleToFinder hsc_env mod_name loc = do
238 let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
239 addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
240 addToModLocationCache (hsc_MLC hsc_env) mod loc
243 uncacheModule :: HscEnv -> ModuleName -> IO ()
244 uncacheModule hsc_env mod = do
245 let this_pkg = thisPackage (hsc_dflags hsc_env)
246 removeFromFinderCache (hsc_FC hsc_env) mod
247 removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
249 -- -----------------------------------------------------------------------------
250 -- The internal workers
252 -- | Search for a module in the home package only.
253 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
254 findHomeModule hsc_env mod_name =
255 homeSearchCache hsc_env mod_name $
257 dflags = hsc_dflags hsc_env
258 home_path = importPaths dflags
260 mod = mkModule (thisPackage dflags) mod_name
263 [ ("hs", mkHomeModLocationSearched dflags mod_name "hs")
264 , ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")
267 hi_exts = [ (hisuf, mkHiOnlyModLocation dflags hisuf)
268 , (addBootSuffix hisuf, mkHiOnlyModLocation dflags hisuf)
271 -- In compilation manager modes, we look for source files in the home
272 -- package because we can compile these automatically. In one-shot
273 -- compilation mode we look for .hi and .hi-boot files only.
274 exts | isOneShot (ghcMode dflags) = hi_exts
275 | otherwise = source_exts
278 -- special case for GHC.Prim; we won't find it in the filesystem.
279 -- This is important only when compiling the base package (where GHC.Prim
280 -- is a home module).
282 then return (Found (error "GHC.Prim ModLocation") mod)
285 searchPathExts home_path mod exts
288 -- | Search for a module in external packages only.
289 findPackageModule :: HscEnv -> Module -> IO FindResult
290 findPackageModule hsc_env mod = do
292 dflags = hsc_dflags hsc_env
293 pkg_id = modulePackageId mod
294 pkg_map = pkgIdMap (pkgState dflags)
296 case lookupPackage pkg_map pkg_id of
297 Nothing -> return (NoPackage pkg_id)
298 Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
300 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
301 findPackageModule_ hsc_env mod pkg_conf =
302 modLocationCache hsc_env mod $
304 -- special case for GHC.Prim; we won't find it in the filesystem.
306 then return (Found (error "GHC.Prim ModLocation") mod)
310 dflags = hsc_dflags hsc_env
311 tag = buildTag dflags
313 -- hi-suffix for packages depends on the build tag.
314 package_hisuf | null tag = "hi"
315 | otherwise = tag ++ "_hi"
317 mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf
319 import_dirs = importDirs pkg_conf
320 -- we never look for a .hi-boot file in an external package;
321 -- .hi-boot files only make sense for the home package.
324 [one] | MkDepend <- ghcMode dflags -> do
325 -- there's only one place that this .hi file can be, so
326 -- don't bother looking for it.
327 let basename = moduleNameSlashes (moduleName mod)
328 loc <- mk_hi_loc one basename
329 return (Found loc mod)
331 searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
333 -- -----------------------------------------------------------------------------
334 -- General path searching
337 :: [FilePath] -- paths to search
338 -> Module -- module name
341 FilePath -> BaseName -> IO ModLocation -- action
346 searchPathExts paths mod exts
347 = do result <- search to_search
349 hPutStrLn stderr (showSDoc $
350 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
351 , nest 2 (vcat (map text paths))
353 Succeeded (loc, p) -> text "Found" <+> ppr loc
354 Failed fs -> text "not found"])
359 basename = moduleNameSlashes (moduleName mod)
361 to_search :: [(FilePath, IO ModLocation)]
362 to_search = [ (file, fn path basename)
365 let base | path == "." = basename
366 | otherwise = path </> basename
370 search [] = return (NotFound { fr_paths = map fst to_search
371 , fr_pkg = Just (modulePackageId mod)
372 , fr_mods_hidden = [], fr_pkgs_hidden = []
373 , fr_suggestions = [] })
375 search ((file, mk_result) : rest) = do
376 b <- doesFileExist file
378 then do { loc <- mk_result; return (Found loc mod) }
381 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
382 -> FilePath -> BaseName -> IO ModLocation
383 mkHomeModLocationSearched dflags mod suff path basename = do
384 mkHomeModLocation2 dflags mod (path </> basename) suff
386 -- -----------------------------------------------------------------------------
387 -- Constructing a home module location
389 -- This is where we construct the ModLocation for a module in the home
390 -- package, for which we have a source file. It is called from three
393 -- (a) Here in the finder, when we are searching for a module to import,
394 -- using the search path (-i option).
396 -- (b) The compilation manager, when constructing the ModLocation for
397 -- a "root" module (a source file named explicitly on the command line
398 -- or in a :load command in GHCi).
400 -- (c) The driver in one-shot mode, when we need to construct a
401 -- ModLocation for a source file named on the command-line.
406 -- The name of the module
409 -- (a): The search path component where the source file was found.
413 -- (a): (moduleNameSlashes mod)
414 -- (b) and (c): The filename of the source file, minus its extension
417 -- The filename extension of the source file (usually "hs" or "lhs").
419 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
420 mkHomeModLocation dflags mod src_filename = do
421 let (basename,extension) = splitExtension src_filename
422 mkHomeModLocation2 dflags mod basename extension
424 mkHomeModLocation2 :: DynFlags
426 -> FilePath -- Of source module, without suffix
429 mkHomeModLocation2 dflags mod src_basename ext = do
430 let mod_basename = moduleNameSlashes mod
432 obj_fn <- mkObjPath dflags src_basename mod_basename
433 hi_fn <- mkHiPath dflags src_basename mod_basename
435 return (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
437 ml_obj_file = obj_fn })
439 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
441 mkHiOnlyModLocation dflags hisuf path basename
442 = do let full_basename = path </> basename
443 obj_fn <- mkObjPath dflags full_basename basename
444 return ModLocation{ ml_hs_file = Nothing,
445 ml_hi_file = full_basename <.> hisuf,
446 -- Remove the .hi-boot suffix from
447 -- hi_file, if it had one. We always
448 -- want the name of the real .hi file
449 -- in the ml_hi_file field.
453 -- | Constructs the filename of a .o file for a given source file.
454 -- Does /not/ check whether the .o file exists
457 -> FilePath -- the filename of the source file, minus the extension
458 -> String -- the module name with dots replaced by slashes
460 mkObjPath dflags basename mod_basename
462 odir = objectDir dflags
463 osuf = objectSuf dflags
465 obj_basename | Just dir <- odir = dir </> mod_basename
466 | otherwise = basename
468 return (obj_basename <.> osuf)
470 -- | Constructs the filename of a .hi file for a given source file.
471 -- Does /not/ check whether the .hi file exists
474 -> FilePath -- the filename of the source file, minus the extension
475 -> String -- the module name with dots replaced by slashes
477 mkHiPath dflags basename mod_basename
482 hi_basename | Just dir <- hidir = dir </> mod_basename
483 | otherwise = basename
485 return (hi_basename <.> hisuf)
488 -- -----------------------------------------------------------------------------
489 -- Filenames of the stub files
491 -- We don't have to store these in ModLocations, because they can be derived
492 -- from other available information, and they're only rarely needed.
498 -> (FilePath,FilePath,FilePath)
500 mkStubPaths dflags mod location
502 stubdir = stubDir dflags
504 mod_basename = moduleNameSlashes mod
505 src_basename = dropExtension $ expectJust "mkStubPaths"
506 (ml_hs_file location)
509 | Just dir <- stubdir = dir </> mod_basename
510 | otherwise = src_basename
512 stub_basename = stub_basename0 ++ "_stub"
514 obj = ml_obj_file location
515 osuf = objectSuf dflags
516 stub_obj_base = dropTail (length osuf + 1) obj ++ "_stub"
517 -- NB. not takeFileName, see #3093
519 (stub_basename <.> "c",
520 stub_basename <.> "h",
521 stub_obj_base <.> objectSuf dflags)
523 -- -----------------------------------------------------------------------------
524 -- findLinkable isn't related to the other stuff in here,
525 -- but there's no other obvious place for it
527 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
528 findObjectLinkableMaybe mod locn
529 = do let obj_fn = ml_obj_file locn
530 maybe_obj_time <- modificationTimeIfExists obj_fn
531 case maybe_obj_time of
532 Nothing -> return Nothing
533 Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
535 -- Make an object linkable when we know the object file exists, and we know
536 -- its modification time.
537 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
538 findObjectLinkable mod obj_fn obj_time = do
539 let stub_fn = (dropExtension obj_fn ++ "_stub") <.> "o"
540 stub_exist <- doesFileExist stub_fn
542 then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
543 else return (LM obj_time mod [DotO obj_fn])
545 -- -----------------------------------------------------------------------------
548 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
549 cannotFindModule = cantFindErr (sLit "Could not find module")
550 (sLit "Ambiguous module name")
552 cannotFindInterface :: DynFlags -> ModuleName -> FindResult -> SDoc
553 cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
554 (sLit "Ambiguous interface for")
556 cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
558 cantFindErr _ multiple_found _ mod_name (FoundMultiple pkgs)
559 = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
560 sep [ptext (sLit "it was found in multiple packages:"),
561 hsep (map (text.packageIdString) pkgs)]
563 cantFindErr cannot_find _ dflags mod_name find_result
564 = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon)
568 = case find_result of
570 -> ptext (sLit "no package matching") <+> quotes (ppr pkg) <+>
571 ptext (sLit "was found")
573 NotFound { fr_paths = files, fr_pkg = mb_pkg
574 , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
575 , fr_suggestions = suggest }
576 | Just pkg <- mb_pkg, pkg /= thisPackage dflags
577 -> not_found_in_package pkg files
579 | null files && null mod_hiddens && null pkg_hiddens
580 -> vcat [ ptext (sLit "it is not a module in the current program, or in any known package.")
581 , pp_suggestions suggest ]
584 -> vcat (map pkg_hidden pkg_hiddens) $$
585 vcat (map mod_hidden mod_hiddens) $$
588 _ -> panic "cantFindErr"
590 build_tag = buildTag dflags
592 not_found_in_package pkg files
595 build = if build_tag == "p" then "profiling"
596 else "\"" ++ build_tag ++ "\""
598 ptext (sLit "Perhaps you haven't installed the ") <> text build <>
599 ptext (sLit " libraries for package ") <> quotes (ppr pkg) <> char '?' $$
603 = ptext (sLit "There are files missing in the ") <> quotes (ppr pkg) <>
604 ptext (sLit " package,") $$
605 ptext (sLit "try running 'ghc-pkg check'.") $$
610 | verbosity dflags < 3 =
611 ptext (sLit "Use -v to see a list of the files searched for.")
613 hang (ptext (sLit "locations searched:")) 2 $ vcat (map text files)
616 ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkg)
617 <> dot $$ cabal_pkg_hidden_hint pkg
618 cabal_pkg_hidden_hint pkg
619 | dopt Opt_BuildingCabalPackage dflags
620 = case simpleParse (packageIdString pkg) of
622 ptext (sLit "Perhaps you need to add") <+>
623 quotes (text (display (pkgName pid))) <+>
624 ptext (sLit "to the build-depends in your .cabal file.")
629 ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg)
633 | otherwise = ptext (sLit "Perhaps you meant") <+> vcat (map pp sugs)
635 pp mod = ppr mod <+> parens (ptext (sLit "package") <+> ppr (modulePackageId mod))