Finder.lhs 6 KB
Newer Older
1
2
3
4
5
6
7
%
% (c) The University of Glasgow, 2000
%
\section[Finder]{Module Finder}

\begin{code}
module Finder (
8
    initFinder, 	-- :: [PackageConfig] -> IO (), 
9
    findModule,		-- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
10
11
    mkHomeModuleLocn,	-- :: ModuleName -> String -> FilePath 
			--	-> IO ModuleLocation
12
    emptyHomeDirCache	-- :: IO ()
13
14
15
16
  ) where

#include "HsVersions.h"

17
import HscTypes		( ModuleLocation(..) )
18
19
20
import CmStaticInfo
import DriverPhases
import DriverState
21
import DriverUtil
22
23
24
import Module
import FiniteMap
import Util
25
import Panic		( panic )
26
import Config
27
28
29
30
31
32

import IOExts
import Directory
import List
import IO
import Monad
33
import Outputable
34
35
\end{code}

36
37
38
39
40
The Finder provides a thin filesystem abstraction to the rest of the
compiler.  For a given module, it knows (a) which package the module
lives in, so it can make a Module from a ModuleName, and (b) where the
source, interface, and object files for a module live.

41
42
\begin{code}

43
-- v_PkgDirCache caches contents of package directories, never expunged
44
45
GLOBAL_VAR(v_PkgDirCache, panic "no pkg cache!", 
           FiniteMap String (PackageName, FilePath))
46

47
48
-- v_HomeDirCache caches contents of home directories, 
-- expunged whenever we create a new finder.
49
GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath))
50
51


52
initFinder :: [PackageConfig] -> IO ()
53
54
55
56
57
58
initFinder pkgs 
  = do	{	-- expunge our home cache
	; writeIORef v_HomeDirCache Nothing
		-- lazilly fill in the package cache
	; writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
	}
59

60
61
62
63
emptyHomeDirCache :: IO ()
emptyHomeDirCache
   = writeIORef v_HomeDirCache Nothing

64
findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
65
66
67
68
findModule name
  = do	{ j <- maybeHomeModule name
	; case j of
	    Just home_module -> return (Just home_module)
69
	    Nothing	     -> maybePackageModule name
70
	}
71
72
73

maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
maybeHomeModule mod_name = do
74
   home_cache <- readIORef v_HomeDirCache
75

76
77
78
79
80
81
82
83
   home_map <- 
     case home_cache of
	Nothing -> do
	   -- populate the home dir cache, using the import path (the import 
	   -- path is changed by -i flags on the command line, and defaults 
	   -- to ["."]).
	   home_imports <- readIORef v_Import_paths
	   let extendFM fm path = do
84
		   contents <- softGetDirectoryContents path
85
86
                   let clean_contents = filter isUsefulFile contents
		   return (addListToFM fm (zip clean_contents (repeat path)))
87
	   home_map <- foldM extendFM emptyFM (reverse home_imports)
88
89
90
91
92
	   writeIORef v_HomeDirCache (Just home_map)
	   return home_map

        Just home_map -> return home_map

93
   let basename = moduleNameUserString mod_name 
94
95
96
       hs  = basename ++ ".hs"
       lhs = basename ++ ".lhs"

97
   case lookupFM home_map hs of {
98
99
	  -- special case to avoid getting "./foo.hs" all the time
	Just "."  -> mkHomeModuleLocn mod_name basename hs;
100
101
	Just path -> mkHomeModuleLocn mod_name 
			(path ++ '/':basename) (path ++ '/':hs);
102
103
	Nothing ->

104
   case lookupFM home_map lhs of {
105
106
	  -- special case to avoid getting "./foo.hs" all the time
	Just "."  -> mkHomeModuleLocn mod_name basename lhs;
107
108
	Just path ->  mkHomeModuleLocn mod_name
			(path ++ '/':basename) (path ++ '/':lhs);
109
110
111
112
113
114
	Nothing -> do

   -- can't find a source file anywhere, check for a lone .hi file.
   hisuf <- readIORef v_Hi_suf
   let hi = basename ++ '.':hisuf
   case lookupFM home_map hi of {
115
116
	Just path ->  mkHomeModuleLocn mod_name
			(path ++ '/':basename) (path ++ '/':hs);
117
	Nothing -> do
118

119
   -- last chance: .hi-boot-<ver> and .hi-boot
120
121
   let hi_boot = basename ++ ".hi-boot"
   let hi_boot_ver = basename ++ ".hi-boot-" ++ cHscIfaceFileVersion
122
   case lookupFM home_map hi_boot_ver of {
123
124
	Just path ->  mkHomeModuleLocn mod_name
			(path ++ '/':basename) (path ++ '/':hs);
125
	Nothing -> do
126
   case lookupFM home_map hi_boot of {
127
128
	Just path ->  mkHomeModuleLocn mod_name 
			(path ++ '/':basename) (path ++ '/':hs);
129
130
	Nothing -> return Nothing
   }}}}}
131

132
133
134
135
136

-- The .hi file always follows the module name, whereas the object
-- file may follow the name of the source file in the case where the
-- two differ (see summariseFile in compMan/CompManager.lhs).

137
mkHomeModuleLocn mod_name basename source_fn = do
138

139
   hisuf  <- readIORef v_Hi_suf
140
   let hifile = getdir basename ++ '/':moduleNameUserString mod_name 
141
				++ '.':hisuf
142
143
144

   -- figure out the .o file name.  It also lives in the same dir
   -- as the source, but can be overriden by a -odir flag.
145
   o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify
146
147
148

   return (Just (mkHomeModule mod_name,
                 ModuleLocation{
149
150
151
152
                    ml_hspp_file = Nothing,
		    ml_hs_file   = Just source_fn,
		    ml_hi_file   = Just hifile,
		    ml_obj_file  = Just o_file
153
154
155
	         }
	))

156

157
newPkgCache :: [PackageConfig] -> IO (FiniteMap String (PackageName, FilePath))
158
159
160
161
162
newPkgCache pkgs = do
    let extendFM fm pkg = do
    	    let dirs = import_dirs pkg
    		pkg_name = _PK_ (name pkg)
    	    let addDir fm dir = do
163
    		    contents <- softGetDirectoryContents dir
164
    		    return (addListToFM fm (zip contents 
165
166
167
168
169
    					       (repeat (pkg_name,dir))))
    	    foldM addDir fm dirs
    
    pkg_map <- foldM extendFM emptyFM pkgs
    return pkg_map
170
171


172
173
174
maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
maybePackageModule mod_name = do
  pkg_cache <- readIORef v_PkgDirCache
175
176
177

  -- hi-suffix for packages depends on the build tag.
  package_hisuf <-
178
	do tag <- readIORef v_Build_tag
179
180
181
182
	   if null tag
		then return "hi"
		else return (tag ++ "_hi")

183
  let basename = moduleNameUserString mod_name
184
      hi = basename ++ '.':package_hisuf
185
186
187
188
189
190

  case lookupFM pkg_cache hi of
	Nothing -> return Nothing
	Just (pkg_name,path) -> 
	    return (Just (mkModule mod_name pkg_name,
			  ModuleLocation{ 
191
192
193
194
                                ml_hspp_file = Nothing,
				ml_hs_file   = Nothing,
				ml_hi_file   = Just (path ++ '/':hi),
				ml_obj_file  = Nothing
195
196
197
			   }
		   ))

198
199
200
isUsefulFile fn
   = let suffix = (reverse . takeWhile (/= '.') . reverse) fn
     in  suffix `elem` ["hi", "hs", "lhs", "hi-boot", "hi-boot-5"]
201
\end{code}