dc7e190f41b5114bc462fc73ec34aa3f101c953f
[ghc-hetmet.git] / ghc / 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
10     findModule,         -- :: ModuleName 
11                         --   -> IO (Either [FilePath] (Module, ModLocation))
12
13     findPackageModule,  -- :: ModuleName
14                         --   -> IO (Either [FilePath] (Module, ModLocation))
15
16     mkHomeModLocation,  -- :: ModuleName -> String -> FilePath 
17                         --      -> IO ModLocation
18
19     findLinkable,       -- :: ModuleName -> ModLocation -> IO (Maybe Linkable)
20
21     hiBootExt,          -- :: String
22     hiBootVerExt,       -- :: String
23
24   ) where
25
26 #include "HsVersions.h"
27
28 import Module
29 import UniqFM           ( filterUFM )
30 import HscTypes         ( Linkable(..), Unlinked(..) )
31 import DriverState
32 import DriverUtil       ( split_longest_prefix, splitFilename3 )
33 import FastString
34 import Config
35 import Util
36
37 import DATA_IOREF       ( IORef, writeIORef, readIORef )
38
39 import List
40 import Directory
41 import IO
42 import Monad
43
44 -- -----------------------------------------------------------------------------
45 -- The Finder
46
47 -- The Finder provides a thin filesystem abstraction to the rest of the
48 -- compiler.  For a given module, it knows (a) whether the module lives
49 -- in the home package or in another package, so it can make a Module
50 -- from a ModuleName, and (b) where the source, interface, and object
51 -- files for a module live.
52 -- 
53 -- It does *not* know which particular package a module lives in, because
54 -- that information is only contained in the interface file.
55
56 -- -----------------------------------------------------------------------------
57 -- The finder's cache
58
59 GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv (Module,ModLocation))
60
61 -- remove all the home modules from the cache; package modules are
62 -- assumed to not move around during a session.
63 flushFinderCache :: IO ()
64 flushFinderCache = do
65   fm <- readIORef finder_cache
66   writeIORef finder_cache (filterUFM (not . isHomeModule . fst) fm)
67
68 addToFinderCache :: ModuleName -> (Module,ModLocation) -> IO ()
69 addToFinderCache mod_name stuff = do
70   fm <- readIORef finder_cache
71   writeIORef finder_cache (extendModuleEnvByName fm mod_name stuff)
72
73 lookupFinderCache :: ModuleName -> IO (Maybe (Module,ModLocation))
74 lookupFinderCache mod_name = do
75   fm <- readIORef finder_cache
76   return $! lookupModuleEnvByName fm mod_name
77
78 -- -----------------------------------------------------------------------------
79 -- Locating modules
80
81 -- This is the main interface to the finder, which maps ModuleNames to
82 -- Modules and ModLocations.
83 --
84 -- The Module contains one crucial bit of information about a module:
85 -- whether it lives in the current ("home") package or not (see Module
86 -- for more details).
87 --
88 -- The ModLocation contains the names of all the files associated with
89 -- that module: its source file, .hi file, object file, etc.
90
91 findModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
92 findModule name = do
93   r <- lookupFinderCache name
94   case r of
95    Just result -> return (Right result)
96    Nothing -> do  
97        j <- maybeHomeModule name
98        case j of
99          Right home_module -> return (Right home_module)
100          Left home_files   -> do
101             r <- findPackageMod name
102             case r of
103                 Right pkg_module -> return (Right pkg_module)
104                 Left pkg_files   -> return (Left (home_files ++ pkg_files))
105
106 findPackageModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
107 findPackageModule name = do
108   r <- lookupFinderCache name
109   case r of
110    Just result -> return (Right result)
111    Nothing     -> findPackageMod name
112
113 hiBootExt = "hi-boot"
114 hiBootVerExt = "hi-boot-" ++ cHscIfaceFileVersion
115
116 maybeHomeModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
117 maybeHomeModule mod_name = do
118    home_path <- readIORef v_Import_paths
119    hisuf     <- readIORef v_Hi_suf
120    mode      <- readIORef v_GhcMode
121
122    let
123      source_exts = 
124       [ ("hs",   mkHomeModLocation mod_name False)
125       , ("lhs",  mkHomeModLocation mod_name False)
126       ]
127      
128      hi_exts = [ (hisuf,  mkHiOnlyModLocation hisuf mod_name) ]
129      
130      boot_exts =
131        [ (hiBootVerExt, mkHiOnlyModLocation hisuf mod_name)
132        , (hiBootExt,    mkHiOnlyModLocation hisuf mod_name)
133        ]
134      
135         -- In compilation manager modes, we look for source files in the home
136         -- package because we can compile these automatically.  In one-shot
137         -- compilation mode we look for .hi and .hi-boot files only.
138         --
139         -- When generating dependencies, we're interested in either category.
140         --
141      exts
142          | mode == DoMkDependHS   = hi_exts ++ source_exts ++ boot_exts
143          | isCompManagerMode mode = source_exts
144          | otherwise {-one-shot-} = hi_exts ++ boot_exts
145
146    searchPathExts home_path mod_name exts
147         
148 -- -----------------------------------------------------------------------------
149 -- Looking for a package module
150
151 findPackageMod :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
152 findPackageMod mod_name = do
153   mode     <- readIORef v_GhcMode
154   imp_dirs <- getPackageImportPath -- including the 'auto' ones
155
156    -- hi-suffix for packages depends on the build tag.
157   package_hisuf <-
158         do tag <- readIORef v_Build_tag
159            if null tag
160                 then return "hi"
161                 else return (tag ++ "_hi")
162
163   let
164      hi_exts =
165         [ (package_hisuf, mkPackageModLocation package_hisuf mod_name) ]
166
167      source_exts = 
168        [ ("hs",   mkPackageModLocation package_hisuf mod_name)
169        , ("lhs",  mkPackageModLocation package_hisuf mod_name)
170        ]
171      
172      -- mkdependHS needs to look for source files in packages too, so
173      -- that we can make dependencies between package before they have
174      -- been built.
175      exts 
176       | mode == DoMkDependHS = hi_exts ++ source_exts
177       | otherwise = hi_exts
178
179       -- we never look for a .hi-boot file in an external package;
180       -- .hi-boot files only make sense for the home package.
181   searchPathExts imp_dirs mod_name exts
182
183 -- -----------------------------------------------------------------------------
184 -- General path searching
185
186 searchPathExts
187   :: [FilePath]         -- paths to search
188   -> ModuleName         -- module name
189   -> [ (
190         String,                                         -- suffix
191         String -> String -> String -> IO (Module, ModLocation)  -- action
192        )
193      ] 
194   -> IO (Either [FilePath] (Module, ModLocation))
195
196 searchPathExts path mod_name exts = search to_search
197   where
198     mod_str = moduleNameUserString mod_name
199     basename = map (\c -> if c == '.' then '/' else c) mod_str
200
201     to_search :: [(FilePath, IO (Module,ModLocation))]
202     to_search = [ (file, fn p basename ext)
203                 | p <- path, 
204                   (ext,fn) <- exts,
205                   let base | p == "."  = basename
206                            | otherwise = p ++ '/':basename
207                       file = base ++ '.':ext
208                 ]
209
210     search [] = return (Left (map fst to_search))
211     search ((file, result) : rest) = do
212       b <- doesFileExist file
213       if b 
214         then Right `liftM` result
215         else search rest
216
217 -- -----------------------------------------------------------------------------
218 -- Building ModLocations
219
220 mkHiOnlyModLocation hisuf mod_name path basename extension = do
221   loc <- hiOnlyModLocation path basename hisuf
222   let result = (mkHomeModule mod_name, loc)
223   addToFinderCache mod_name result
224   return result
225
226 mkPackageModLocation hisuf mod_name path basename _extension = do
227   loc <- hiOnlyModLocation path basename hisuf
228   let result = (mkPackageModule mod_name, loc)
229   addToFinderCache mod_name result
230   return result
231
232 hiOnlyModLocation path basename hisuf 
233  = do { obj_fn <- mkObjPath path basename ;
234         return (ModLocation{ ml_hspp_file = Nothing,
235                              ml_hs_file   = Nothing,
236                              ml_hi_file   = path ++ '/':basename ++ '.':hisuf,
237                                 -- Remove the .hi-boot suffix from
238                                 -- hi_file, if it had one.  We always
239                                 -- want the name of the real .hi file
240                                 -- in the ml_hi_file field.
241                              ml_obj_file  = obj_fn
242                  })}
243
244 -- -----------------------------------------------------------------------------
245 -- Constructing a home module location
246
247 -- The .hi file always follows the module name, whereas the object
248 -- file may follow the name of the source file in the case where the
249 -- two differ (see summariseFile in compMan/CompManager.lhs).
250
251 -- The source filename is specified in three components.  For example,
252 -- if we have a module "A.B.C" which was found along the patch "/P/Q/R"
253 -- with extension ".hs", then the full filename is "/P/Q/R/A/B/C.hs".  The
254 -- components passed to mkHomeModLocation are
255 --
256 --   path:      "/P/Q/R"
257 --   basename:  "A/B/C"
258 --   extension: "hs"
259 --
260 -- the object file and interface file are constructed by possibly
261 -- replacing the path component with the values of the -odir or the
262 -- -hidr options respectively, and the extension with the values of
263 -- the -osuf and -hisuf options respectively.  That is, the basename
264 -- always remains intact.
265 --
266 -- mkHomeModLocation is called directly by the compilation manager to
267 -- construct the information for a root module.  For a "root" module,
268 -- the rules are slightly different. The filename is allowed to
269 -- diverge from the module name, but we have to name the interface
270 -- file after the module name.  For example, a root module
271 -- "/P/Q/R/foo.hs" will have components
272 --
273 --  path:       "/P/Q/R"
274 --  basename:   "foo"
275 --  extension:  "hs"
276 -- 
277 -- and we set the flag is_root to True, to indicate that the basename
278 -- portion for the .hi file should be replaced by the last component
279 -- of the module name.  eg. if the module name is "A.B.C" then basename
280 -- will be replaced by "C" for the .hi file only, resulting in an
281 -- .hi file like "/P/Q/R/C.hi" (subject to -hidir and -hisuf as usual).
282
283 mkHomeModLocation mod_name is_root path basename extension = do
284
285    hisuf  <- readIORef v_Hi_suf
286    hidir  <- readIORef v_Hi_dir
287
288    obj_fn <- mkObjPath path basename
289
290    let  -- hi filename
291        mod_str = moduleNameUserString mod_name
292        (_,mod_suf) = split_longest_prefix mod_str (=='.')
293
294        hi_basename
295           | is_root   = mod_suf
296           | otherwise = basename
297
298        hi_path | Just d <- hidir = d
299                | otherwise       = path
300        hi_fn = hi_path ++ '/':hi_basename ++ '.':hisuf
301
302         -- source filename (extension is always .hs or .lhs)
303        source_fn
304          | path == "."  = basename ++ '.':extension
305          | otherwise    = path ++ '/':basename ++ '.':extension
306
307        result = ( mkHomeModule mod_name,
308                   ModLocation{ ml_hspp_file = Nothing,
309                                ml_hs_file   = Just source_fn,
310                                ml_hi_file   = hi_fn,
311                                ml_obj_file  = obj_fn,
312                        })
313
314    addToFinderCache mod_name result
315    return result
316
317 mkObjPath :: String -> FilePath -> IO FilePath
318 -- Construct the filename of a .o file from the path/basename
319 -- derived either from a .hs file or a .hi file.
320 --
321 -- Does *not* check whether the .o file exists
322 mkObjPath path basename
323   = do  odir   <- readIORef v_Output_dir
324         osuf   <- readIORef v_Object_suf
325         let obj_path | Just d <- odir = d
326                      | otherwise      = path
327         return (obj_path ++ '/':basename ++ '.':osuf)
328
329   
330
331 -- -----------------------------------------------------------------------------
332 -- findLinkable isn't related to the other stuff in here, 
333 -- but there' no other obvious place for it
334
335 findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable)
336 findLinkable mod locn
337    = do let obj_fn = ml_obj_file locn
338         obj_exist <- doesFileExist obj_fn
339         if not obj_exist 
340          then return Nothing 
341          else 
342          do let stub_fn = case splitFilename3 obj_fn of
343                              (dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o"
344             stub_exist <- doesFileExist stub_fn
345             obj_time <- getModificationTime obj_fn
346             if stub_exist
347              then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn]))
348              else return (Just (LM obj_time mod [DotO obj_fn]))
349 \end{code}