2 % (c) The University of Glasgow, 2000
4 \section[Finder]{Module Finder}
8 initFinder, -- :: PackageConfigInfo -> IO (),
9 findModule -- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
12 #include "HsVersions.h"
14 import HscTypes ( ModuleLocation(..) )
27 import Outputable ( showSDoc, ppr ) -- debugging only
30 The Finder provides a thin filesystem abstraction to the rest of the
31 compiler. For a given module, it knows (a) which package the module
32 lives in, so it can make a Module from a ModuleName, and (b) where the
33 source, interface, and object files for a module live.
37 -- v_PkgDirCache caches contents of package directories, never expunged
38 GLOBAL_VAR(v_PkgDirCache, error "no pkg cache!", FiniteMap String (PackageName, FilePath))
40 -- v_HomeDirCache caches contents of home directories,
41 -- expunged whenever we create a new finder.
42 GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath))
45 initFinder :: PackageConfigInfo -> IO ()
47 = do { -- expunge our home cache
48 ; writeIORef v_HomeDirCache Nothing
49 -- lazilly fill in the package cache
50 ; writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
53 -- ; pkg_dbg_info <- readIORef v_PkgDirCache
54 -- ; putStrLn (unlines (map show (fmToList pkg_dbg_info)))
57 findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
59 = do { hPutStr stderr ("findModule: " ++ moduleNameUserString name ++ " ... ")
60 ; maybe_m <- findModule_wrk name
62 Nothing -> hPutStrLn stderr "Not Found"
63 Just mm -> hPutStrLn stderr (showSDoc (ppr (snd mm)))
67 findModule_wrk :: ModuleName -> IO (Maybe (Module, ModuleLocation))
69 = do { j <- maybeHomeModule name
71 Just home_module -> return (Just home_module)
72 Nothing -> maybePackageModule name
75 maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
76 maybeHomeModule mod_name = do
77 home_cache <- readIORef v_HomeDirCache
82 -- populate the home dir cache, using the import path (the import
83 -- path is changed by -i flags on the command line, and defaults
85 home_imports <- readIORef v_Import_paths
86 let extendFM fm path = do
87 contents <- getDirectoryContents' path
88 let clean_contents = filter isUsefulFile contents
89 return (addListToFM fm (zip clean_contents (repeat path)))
90 home_map <- foldM extendFM emptyFM home_imports
91 writeIORef v_HomeDirCache (Just home_map)
94 Just home_map -> return home_map
96 let basename = moduleNameString mod_name
97 hs = basename ++ ".hs"
98 lhs = basename ++ ".lhs"
100 case lookupFM home_map hs of {
101 Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) hs;
104 case lookupFM home_map lhs of {
105 Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) lhs;
106 Nothing -> return Nothing
110 mkHomeModuleLocn mod_name basename source_fn = do
112 -- figure out the .hi file name: it lives in the same dir as the
113 -- source, unless there's a -ohi flag on the command line.
114 ohi <- readIORef v_Output_hi
115 hisuf <- readIORef v_Hi_suf
116 let hifile = case ohi of
117 Nothing -> basename ++ '.':hisuf
120 -- figure out the .o file name. It also lives in the same dir
121 -- as the source, but can be overriden by a -odir flag.
122 o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
124 return (Just (mkHomeModule mod_name,
133 newPkgCache :: [Package] -> IO (FiniteMap String (PackageName, FilePath))
134 newPkgCache pkgs = do
135 let extendFM fm pkg = do
136 let dirs = import_dirs pkg
137 pkg_name = _PK_ (name pkg)
138 let addDir fm dir = do
139 contents <- getDirectoryContents' dir
140 let clean_contents = filter isUsefulFile contents
141 return (addListToFM fm (zip clean_contents
142 (repeat (pkg_name,dir))))
145 pkg_map <- foldM extendFM emptyFM pkgs
149 maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
150 maybePackageModule mod_name = do
151 pkg_cache <- readIORef v_PkgDirCache
153 -- hi-suffix for packages depends on the build tag.
155 do tag <- readIORef v_Build_tag
158 else return (tag ++ "_hi")
160 let basename = moduleNameString mod_name
161 hi = basename ++ '.':package_hisuf
163 case lookupFM pkg_cache hi of
164 Nothing -> return Nothing
165 Just (pkg_name,path) ->
166 return (Just (mkModule mod_name pkg_name,
168 hs_file = "error:_package_module;_no_source",
169 hi_file = path ++ '/':hi,
170 obj_file = "error:_package_module;_no_object"
175 = let suffix = (reverse . takeWhile (/= '.') . reverse) fn
176 in suffix `elem` ["hi", "hs", "lhs", "hi-boot", "hi-boot-5"]
178 getDirectoryContents' d
179 = IO.catch (getDirectoryContents d)
180 (\_ -> do hPutStr stderr
181 ("WARNING: error while reading directory " ++ d)