Finder.lhs 5.45 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, 	-- :: PackageConfigInfo -> IO (), 
9
    findModule		-- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
10
11
12
13
  ) where

#include "HsVersions.h"

14
import HscTypes		( ModuleLocation(..) )
15
16
17
18
19
20
21
22
23
24
25
26
import CmStaticInfo
import DriverPhases
import DriverState
import Module
import FiniteMap
import Util

import IOExts
import Directory
import List
import IO
import Monad
27
import Outputable	( showSDoc, ppr )	-- debugging only
28
29
\end{code}

30
31
32
33
34
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.

35
36
\begin{code}

37
-- v_PkgDirCache caches contents of package directories, never expunged
38
GLOBAL_VAR(v_PkgDirCache,    error "no pkg cache!",  FiniteMap String (PackageName, FilePath))
39

40
41
-- v_HomeDirCache caches contents of home directories, 
-- expunged whenever we create a new finder.
42
GLOBAL_VAR(v_HomeDirCache,   Nothing,  Maybe (FiniteMap String FilePath))
43
44


45
initFinder :: PackageConfigInfo -> IO ()
46
47
48
49
50
51
52
53
54
55
initFinder pkgs 
  = do	{	-- expunge our home cache
	; writeIORef v_HomeDirCache Nothing
		-- lazilly fill in the package cache
	; writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
	
-- Debug output
--	; pkg_dbg_info <- readIORef v_PkgDirCache
--	; putStrLn (unlines (map show (fmToList pkg_dbg_info)))
	}
56

57
findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
58
59
60
61
62
63
64
65
66
findModule name
  = do 	{ hPutStr stderr ("findModule: " ++ moduleNameUserString name ++ " ... ")
	; maybe_m <- findModule_wrk name
	; case maybe_m of
	     Nothing -> hPutStrLn stderr "Not Found"
	     Just mm -> hPutStrLn stderr (showSDoc (ppr (snd mm)))
	; return maybe_m
	}

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

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

79
80
81
82
83
84
85
86
87
   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
		   contents <- getDirectoryContents' path
88
89
                   let clean_contents = filter isUsefulFile contents
		   return (addListToFM fm (zip clean_contents (repeat path)))
90
91
92
93
94
95
	   home_map <- foldM extendFM emptyFM home_imports
	   writeIORef v_HomeDirCache (Just home_map)
	   return home_map

        Just home_map -> return home_map

96
97
98
99
   let basename = moduleNameString mod_name
       hs  = basename ++ ".hs"
       lhs = basename ++ ".lhs"

100
   case lookupFM home_map hs of {
101
	Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) hs;
102
103
	Nothing ->

104
   case lookupFM home_map lhs of {
105
	Just path ->  mkHomeModuleLocn mod_name (path ++ '/':basename) lhs;
106
107
108
109
	Nothing -> return Nothing

   }}

110
mkHomeModuleLocn mod_name basename source_fn = do
111
112
113

   -- figure out the .hi file name: it lives in the same dir as the
   -- source, unless there's a -ohi flag on the command line.
114
115
   ohi    <- readIORef v_Output_hi
   hisuf  <- readIORef v_Hi_suf
116
   let hifile = case ohi of
117
		   Nothing -> basename ++ '.':hisuf
118
119
120
121
		   Just fn -> fn

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

   return (Just (mkHomeModule mod_name,
                 ModuleLocation{
126
127
128
129
                    ml_hspp_file = Nothing,
		    ml_hs_file   = Just source_fn,
		    ml_hi_file   = Just hifile,
		    ml_obj_file  = Just o_file
130
131
132
	         }
	))

133

134
135
136
137
138
139
140
newPkgCache :: [Package] -> IO (FiniteMap String (PackageName, FilePath))
newPkgCache pkgs = do
    let extendFM fm pkg = do
    	    let dirs = import_dirs pkg
    		pkg_name = _PK_ (name pkg)
    	    let addDir fm dir = do
    		    contents <- getDirectoryContents' dir
141
142
		    let clean_contents = filter isUsefulFile contents
    		    return (addListToFM fm (zip clean_contents 
143
144
145
146
147
    					       (repeat (pkg_name,dir))))
    	    foldM addDir fm dirs
    
    pkg_map <- foldM extendFM emptyFM pkgs
    return pkg_map
148
149


150
151
152
maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
maybePackageModule mod_name = do
  pkg_cache <- readIORef v_PkgDirCache
153
154
155

  -- hi-suffix for packages depends on the build tag.
  package_hisuf <-
156
	do tag <- readIORef v_Build_tag
157
158
159
160
161
	   if null tag
		then return "hi"
		else return (tag ++ "_hi")

  let basename = moduleNameString mod_name
162
      hi = basename ++ '.':package_hisuf
163
164
165
166
167
168

  case lookupFM pkg_cache hi of
	Nothing -> return Nothing
	Just (pkg_name,path) -> 
	    return (Just (mkModule mod_name pkg_name,
			  ModuleLocation{ 
169
170
171
172
                                ml_hspp_file = Nothing,
				ml_hs_file   = Nothing,
				ml_hi_file   = Just (path ++ '/':hi),
				ml_obj_file  = Nothing
173
174
175
			   }
		   ))

176
177
178
179
isUsefulFile fn
   = let suffix = (reverse . takeWhile (/= '.') . reverse) fn
     in  suffix `elem` ["hi", "hs", "lhs", "hi-boot", "hi-boot-5"]

180
181
182
183
184
185
186
187
getDirectoryContents' d
   = IO.catch (getDirectoryContents d)
	  (\_ -> do hPutStr stderr 
		          ("WARNING: error while reading directory " ++ d)
		    return []
	  )
	 
\end{code}