Finder.lhs 6.52 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))
sof's avatar
sof committed
10
    findModuleDep,	-- :: ModuleName -> Bool -> IO (Maybe (Module, ModuleLocation))
11
    findPackageModule,	-- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
12
    mkHomeModuleLocn,	-- :: ModuleName -> String -> FilePath 
13
			--	-> IO ModuleLocation
14
15
    emptyHomeDirCache,	-- :: IO ()
    flushPackageCache   -- :: [PackageConfig] -> IO ()
16
17
18
19
  ) where

#include "HsVersions.h"

20
import HscTypes		( ModuleLocation(..) )
21
import Packages		( PackageConfig(..) )
22
23
import DriverPhases
import DriverState
24
import DriverUtil
25
import Module
26
import FastString
27
import Config
28
29
30

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

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

It does *not* know which particular package a module lives in, because
that information is only contained in the interface file.
44

45
\begin{code}
46
initFinder :: [PackageConfig] -> IO ()
47
initFinder pkgs = return ()
48
49
50

-- empty, and lazilly fill in the package cache
flushPackageCache :: [PackageConfig] -> IO ()
51
flushPackageCache pkgs = return ()
52

53
emptyHomeDirCache :: IO ()
54
emptyHomeDirCache = return ()
55

56
findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
sof's avatar
sof committed
57
58
59
60
61
findModule name = findModuleDep name False

findModuleDep :: ModuleName -> Bool -> IO (Maybe (Module, ModuleLocation))
findModuleDep name is_source
  = do	{ j <- maybeHomeModule name is_source
62
63
	; case j of
	    Just home_module -> return (Just home_module)
sof's avatar
sof committed
64
	    Nothing	     -> findPackageMod name False
65
	}
66

sof's avatar
sof committed
67
68
maybeHomeModule :: ModuleName -> Bool -> IO (Maybe (Module, ModuleLocation))
maybeHomeModule mod_name is_source = do
69
   home_path <- readIORef v_Import_paths
sof's avatar
sof committed
70
   hisuf     <- readIORef v_Hi_suf
71
   mode      <- readIORef v_GhcMode
72

73
74
   let mod_str  = moduleNameUserString mod_name 
       basename = map (\c -> if c == '.' then '/' else c) mod_str
sof's avatar
sof committed
75
       
76
77
78
	-- In compilation manager modes, we look for source files in the home
	-- package because we can compile these automatically.  In one-shot
	-- compilation mode we look for .hi files only.
sof's avatar
sof committed
79
80
81
82
	--
	-- When generating dependencies, we're interested in either category.
	--
       source_exts = 
83
84
85
86
             [ ("hs",   \ fName path -> mkHomeModuleLocn mod_name path fName)
	     , ("lhs",  \ fName path -> mkHomeModuleLocn mod_name path fName)
	     ]
       hi_exts = [ (hisuf,  \ fName path -> mkHiOnlyModuleLocn mod_name fName) ]
sof's avatar
sof committed
87

88
       std_exts
sof's avatar
sof committed
89
90
91
         | mode == DoMkDependHS   = hi_exts ++ source_exts
         | isCompManagerMode mode = source_exts
	 | otherwise              = hi_exts
92
93
94

        -- last chance: .hi-boot-<ver> and .hi-boot
       hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion
sof's avatar
sof committed
95
96

       boot_exts = 
97
98
       	[ (hi_boot_ver, \ fName path -> mkHiOnlyModuleLocn mod_name fName)
	, ("hi-boot",   \ fName path -> mkHiOnlyModuleLocn mod_name fName)
99
	]
sof's avatar
sof committed
100

101
   searchPathExts home_path basename
102
	(if is_source then (boot_exts++std_exts) else std_exts ++ boot_exts)
sof's avatar
sof committed
103
104
105
106
107
108
109
110
111
112
113
114
115
			-- for SOURCE imports, check the hi-boot extensions
			-- before the source/iface ones, to avoid
			-- creating circ Makefile deps.

mkHiOnlyModuleLocn mod_name hi_file =
 return
   ( mkHomeModule mod_name
   , ModuleLocation{ ml_hspp_file = Nothing
    		   , ml_hs_file   = Nothing
		   , ml_hi_file   = hi_file
		   , ml_obj_file  = Nothing
	           }
   )
116

117
118
119
120
-- 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).

121
122
123
124
mkHomeModuleLocn mod_name 
	basename		-- everything but the extension
	source_fn		-- full path to the source (required)
  = do
125

126
   hisuf  <- readIORef v_Hi_suf
127
128
   hidir  <- readIORef v_Hi_dir

129
130
   -- take the *last* component of the module name (if a hierarchical name),
   -- and append it to the directory to get the .hi file name.
sof's avatar
sof committed
131
   let (_,mod_str) = split_longest_prefix (moduleNameUserString mod_name) (=='.')
132
133
134
135
       hi_filename = mod_str ++ '.':hisuf
       hi_path | Just d <- hidir = d
	       | otherwise       = getdir basename
       hi = hi_path ++ '/':hi_filename
136
137
138

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

sof's avatar
sof committed
141
142
   return (mkHomeModule mod_name,
           ModuleLocation{ ml_hspp_file = Nothing
143
144
	   		 , ml_hs_file   = Just source_fn
			 , ml_hi_file   = hi
sof's avatar
sof committed
145
146
147
148
149
150
151
			 , ml_obj_file  = Just o_file
			 })

findPackageMod :: ModuleName
	       -> Bool
	       -> IO (Maybe (Module, ModuleLocation))
findPackageMod mod_name hiOnly = do
152
  pkgs <- getPackageInfo
153

sof's avatar
sof committed
154
   -- hi-suffix for packages depends on the build tag.
155
  package_hisuf <-
156
	do tag <- readIORef v_Build_tag
157
158
159
	   if null tag
		then return "hi"
		else return (tag ++ "_hi")
160
  let imp_dirs = concatMap import_dirs pkgs
sof's avatar
sof committed
161
      mod_str  = moduleNameUserString mod_name 
162
      basename = map (\c -> if c == '.' then '/' else c) mod_str
163

164
165
      retPackageModule mod_name mbFName path =
        return ( mkPackageModule mod_name
166
167
168
169
170
171
               , ModuleLocation{ ml_hspp_file = Nothing
		 	       , ml_hs_file   = mbFName
			       , ml_hi_file   = path ++ '.':package_hisuf
			       , ml_obj_file  = Nothing
			       })

sof's avatar
sof committed
172
173
  searchPathExts
  	imp_dirs basename
174
        ((package_hisuf,\ fName path -> retPackageModule mod_name Nothing path) :
sof's avatar
sof committed
175
176
      	  -- can packages contain hi-boots?
	 (if hiOnly then [] else
177
178
	  [ ("hs",  \ fName path -> retPackageModule mod_name (Just fName) path)
	  , ("lhs", \ fName path -> retPackageModule mod_name (Just fName) path)
sof's avatar
sof committed
179
	  ]))
180
181
 where

sof's avatar
sof committed
182
183
184
findPackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
findPackageModule mod_name = findPackageMod mod_name True

185
searchPathExts :: [FilePath]
sof's avatar
sof committed
186
	       -> String
187
	       -> [(String, FilePath -> String -> IO (Module, ModuleLocation))] 
sof's avatar
sof committed
188
	       -> IO (Maybe (Module, ModuleLocation))
189
searchPathExts path basename exts = search path
sof's avatar
sof committed
190
  where
191
192
193
194
195
196
197
198
199
200
201
202
    search [] = return Nothing
    search (p:ps) = loop exts
      where	
	base | p == "."  = basename
	     | otherwise = p ++ '/':basename

	loop [] = search ps
	loop ((ext,fn):exts) = do
	    let file = base ++ '.':ext
	    b <- doesFileExist file
	    if b then Just `liftM` fn file base
		 else loop exts
203
\end{code}