2 % (c) The University of Glasgow, 2000
4 \section[Finder]{Module Finder}
8 initFinder, -- :: PackageConfigInfo -> IO (),
9 findModule, -- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
10 mkHomeModuleLocn, -- :: ModuleName -> String -> FilePath
11 -- -> IO ModuleLocation
12 emptyHomeDirCache -- :: IO ()
15 #include "HsVersions.h"
17 import HscTypes ( ModuleLocation(..) )
25 import Panic ( panic )
33 import Outputable ( showSDoc, ppr ) -- debugging only
36 The Finder provides a thin filesystem abstraction to the rest of the
37 compiler. For a given module, it knows (a) which package the module
38 lives in, so it can make a Module from a ModuleName, and (b) where the
39 source, interface, and object files for a module live.
43 -- v_PkgDirCache caches contents of package directories, never expunged
44 GLOBAL_VAR(v_PkgDirCache, panic "no pkg cache!",
45 FiniteMap String (PackageName, FilePath))
47 -- v_HomeDirCache caches contents of home directories,
48 -- expunged whenever we create a new finder.
49 GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath))
52 initFinder :: PackageConfigInfo -> IO ()
54 = do { -- expunge our home cache
55 ; writeIORef v_HomeDirCache Nothing
56 -- lazilly fill in the package cache
57 ; writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
60 emptyHomeDirCache :: IO ()
62 = writeIORef v_HomeDirCache Nothing
64 findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
66 = do { j <- maybeHomeModule name
68 Just home_module -> return (Just home_module)
69 Nothing -> maybePackageModule name
72 maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
73 maybeHomeModule mod_name = do
74 home_cache <- readIORef v_HomeDirCache
79 -- populate the home dir cache, using the import path (the import
80 -- path is changed by -i flags on the command line, and defaults
82 home_imports <- readIORef v_Import_paths
83 let extendFM fm path = do
84 contents <- getDirectoryContents' path
85 let clean_contents = filter isUsefulFile contents
86 return (addListToFM fm (zip clean_contents (repeat path)))
87 home_map <- foldM extendFM emptyFM home_imports
88 writeIORef v_HomeDirCache (Just home_map)
91 Just home_map -> return home_map
93 let basename = moduleNameUserString mod_name
94 hs = basename ++ ".hs"
95 lhs = basename ++ ".lhs"
97 case lookupFM home_map hs of {
98 Just path -> mkHomeModuleLocn mod_name
99 (path ++ '/':basename) (path ++ '/':hs);
102 case lookupFM home_map lhs of {
103 Just path -> mkHomeModuleLocn mod_name
104 (path ++ '/':basename) (path ++ '/':lhs);
107 -- can't find a source file anywhere, check for a lone .hi file.
108 hisuf <- readIORef v_Hi_suf
109 let hi = basename ++ '.':hisuf
110 case lookupFM home_map hi of {
111 Just path -> mkHomeModuleLocn mod_name
112 (path ++ '/':basename) (path ++ '/':hs);
115 -- last chance: .hi-boot-<ver> and .hi-boot
116 let hi_boot = basename ++ ".hi-boot"
117 let hi_boot_ver = basename ++ ".hi-boot-" ++ cHscIfaceFileVersion
118 case lookupFM home_map hi_boot_ver of {
119 Just path -> mkHomeModuleLocn mod_name
120 (path ++ '/':basename) (path ++ '/':hs);
122 case lookupFM home_map hi_boot of {
123 Just path -> mkHomeModuleLocn mod_name
124 (path ++ '/':basename) (path ++ '/':hs);
125 Nothing -> return Nothing
129 -- The .hi file always follows the module name, whereas the object
130 -- file may follow the name of the source file in the case where the
131 -- two differ (see summariseFile in compMan/CompManager.lhs).
133 mkHomeModuleLocn mod_name basename source_fn = do
135 -- figure out the .hi file name: it lives in the same dir as the
136 -- source, unless there's a -ohi flag on the command line.
137 ohi <- readIORef v_Output_hi
138 hisuf <- readIORef v_Hi_suf
139 let hifile = case ohi of
140 Nothing -> getdir basename
141 ++ '/':moduleNameUserString mod_name
145 -- figure out the .o file name. It also lives in the same dir
146 -- as the source, but can be overriden by a -odir flag.
147 o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
149 return (Just (mkHomeModule mod_name,
151 ml_hspp_file = Nothing,
152 ml_hs_file = Just source_fn,
153 ml_hi_file = Just hifile,
154 ml_obj_file = Just o_file
159 newPkgCache :: [Package] -> IO (FiniteMap String (PackageName, FilePath))
160 newPkgCache pkgs = do
161 let extendFM fm pkg = do
162 let dirs = import_dirs pkg
163 pkg_name = _PK_ (name pkg)
164 let addDir fm dir = do
165 contents <- getDirectoryContents' dir
166 return (addListToFM fm (zip contents
167 (repeat (pkg_name,dir))))
170 pkg_map <- foldM extendFM emptyFM pkgs
174 maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
175 maybePackageModule mod_name = do
176 pkg_cache <- readIORef v_PkgDirCache
178 -- hi-suffix for packages depends on the build tag.
180 do tag <- readIORef v_Build_tag
183 else return (tag ++ "_hi")
185 let basename = moduleNameUserString mod_name
186 hi = basename ++ '.':package_hisuf
188 case lookupFM pkg_cache hi of
189 Nothing -> return Nothing
190 Just (pkg_name,path) ->
191 return (Just (mkModule mod_name pkg_name,
193 ml_hspp_file = Nothing,
194 ml_hs_file = Nothing,
195 ml_hi_file = Just (path ++ '/':hi),
196 ml_obj_file = Nothing
201 = let suffix = (reverse . takeWhile (/= '.') . reverse) fn
202 in suffix `elem` ["hi", "hs", "lhs", "hi-boot", "hi-boot-5"]
204 getDirectoryContents' d
205 = IO.catch (getDirectoryContents d)
206 (\_ -> do hPutStr stderr
207 ("WARNING: error while reading directory " ++ d)