2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
\r
4 \section[Module]{The @Module@ module.}
\r
6 Representing modules and their flavours.
\r
11 Module -- abstract, instance of Eq, Ord, Outputable
\r
14 , moduleNameString -- :: ModuleName -> EncodedString
\r
15 , moduleNameUserString -- :: ModuleName -> UserString
\r
17 , moduleString -- :: Module -> EncodedString
\r
18 , moduleUserString -- :: Module -> UserString
\r
19 , moduleName -- :: Module -> ModuleName
\r
21 , mkVanillaModule -- :: ModuleName -> Module
\r
22 , mkThisModule -- :: ModuleName -> Module
\r
23 , mkPrelModule -- :: UserString -> Module
\r
25 , isDynamicModule -- :: Module -> Bool
\r
30 , mkSrcModuleFS -- :: UserFS -> ModuleName
\r
31 , mkSysModuleFS -- :: EncodedFS -> ModuleName
\r
33 , pprModule, pprModuleName
\r
36 , DllFlavour, dll, notDll
\r
39 , ModFlavour, libMod, userMod
\r
41 -- Where to find a .hi file
\r
42 , WhereFrom(..), SearchPath, mkSearchPath
\r
43 , ModuleHiMap, mkModuleHiMaps
\r
47 #include "HsVersions.h"
\r
51 import CmdLineOpts ( opt_Static, opt_CompilingPrelude, opt_WarnHiShadows )
\r
52 import Constants ( interfaceFileFormatVersion )
\r
53 import Maybes ( seqMaybe )
\r
54 import Maybe ( fromMaybe )
\r
55 import Directory ( doesFileExist )
\r
56 import DirUtils ( getDirectoryContents )
\r
57 import List ( intersperse )
\r
58 import Monad ( foldM )
\r
59 import IO ( hPutStrLn, stderr, isDoesNotExistError )
\r
63 %************************************************************************
\r
65 \subsection{Interface file flavour}
\r
67 %************************************************************************
\r
69 A further twist to the tale is the support for dynamically linked libraries under
\r
70 Win32. Here, dealing with the use of global variables that's residing in a DLL
\r
71 requires special handling at the point of use (there's an extra level of indirection,
\r
72 i.e., (**v) to get at v's value, rather than just (*v) .) When slurping in an
\r
73 interface file we then record whether it's coming from a .hi corresponding to a
\r
74 module that's packaged up in a DLL or not, so that we later can emit the
\r
77 The logic for how an interface file is marked as corresponding to a module that's
\r
78 hiding in a DLL is explained elsewhere (ToDo: give renamer href here.)
\r
81 data DllFlavour = NotDll -- Ordinary module
\r
82 | Dll -- The module's object code lives in a DLL.
\r
88 instance Text DllFlavour where -- Just used in debug prints of lex tokens
\r
89 showsPrec n NotDll s = s
\r
90 showsPrec n Dll s = "dll " ++ s
\r
94 %************************************************************************
\r
96 \subsection{System/user module}
\r
98 %************************************************************************
\r
100 We also track whether an imported module is from a 'system-ish' place. In this case
\r
101 we don't record the fact that this module depends on it, nor usages of things
\r
105 data ModFlavour = LibMod -- A library-ish module
\r
106 | UserMod -- Not library-ish
\r
113 %************************************************************************
\r
115 \subsection{Where from}
\r
117 %************************************************************************
\r
119 The @WhereFrom@ type controls where the renamer looks for an interface file
\r
122 data WhereFrom = ImportByUser -- Ordinary user import: look for M.hi
\r
123 | ImportByUserSource -- User {- SOURCE -}: look for M.hi-boot
\r
124 | ImportBySystem -- Non user import. Look for M.hi if M is in
\r
125 -- the module this module depends on, or is a system-ish module;
\r
126 -- M.hi-boot otherwise
\r
128 instance Outputable WhereFrom where
\r
129 ppr ImportByUser = empty
\r
130 ppr ImportByUserSource = ptext SLIT("{- SOURCE -}")
\r
131 ppr ImportBySystem = ptext SLIT("{- SYSTEM IMPORT -}")
\r
135 %************************************************************************
\r
137 \subsection{The name of a module}
\r
139 %************************************************************************
\r
142 type ModuleName = EncodedFS
\r
143 -- Haskell module names can include the quote character ',
\r
144 -- so the module names have the z-encoding applied to them
\r
147 pprModuleName :: ModuleName -> SDoc
\r
148 pprModuleName nm = pprEncodedFS nm
\r
150 moduleNameString :: ModuleName -> EncodedString
\r
151 moduleNameString mod = _UNPK_ mod
\r
153 moduleNameUserString :: ModuleName -> UserString
\r
154 moduleNameUserString mod = decode (_UNPK_ mod)
\r
156 mkSrcModule :: UserString -> ModuleName
\r
157 mkSrcModule s = _PK_ (encode s)
\r
159 mkSrcModuleFS :: UserFS -> ModuleName
\r
160 mkSrcModuleFS s = encodeFS s
\r
162 mkSysModuleFS :: EncodedFS -> ModuleName
\r
163 mkSysModuleFS s = s
\r
167 data Module = Module
\r
174 instance Outputable Module where
\r
177 instance Eq Module where
\r
178 (Module m1 _ _) == (Module m2 _ _) = m1 == m2
\r
180 instance Ord Module where
\r
181 (Module m1 _ _) `compare` (Module m2 _ _) = m1 `compare` m2
\r
186 pprModule :: Module -> SDoc
\r
187 pprModule (Module mod _ _) = pprEncodedFS mod
\r
194 mkVanillaModule :: ModuleName -> Module
\r
195 mkVanillaModule name = Module name UserMod NotDll
\r
197 mkThisModule :: ModuleName -> Module -- The module being comiled
\r
198 mkThisModule name = Module name UserMod NotDll -- ToDo: correct Dll flag?
\r
200 mkPrelModule :: ModuleName -> Module
\r
201 mkPrelModule name = Module name sys dll
\r
203 sys | opt_CompilingPrelude = UserMod
\r
204 | otherwise = LibMod
\r
206 dll | opt_Static || opt_CompilingPrelude = NotDll
\r
209 moduleString :: Module -> EncodedString
\r
210 moduleString (Module mod _ _) = _UNPK_ mod
\r
212 moduleName :: Module -> ModuleName
\r
213 moduleName (Module mod _ _) = mod
\r
215 moduleUserString :: Module -> UserString
\r
216 moduleUserString (Module mod _ _) = moduleNameUserString mod
\r
220 isDynamicModule :: Module -> Bool
\r
221 isDynamicModule (Module _ _ Dll) = True
\r
222 isDynamicModule _ = False
\r
224 isLibModule :: Module -> Bool
\r
225 isLibModule (Module _ LibMod _) = True
\r
226 isLibModule _ = False
\r
230 %************************************************************************
\r
232 \subsection{Finding modules in the file system
\r
234 %************************************************************************
\r
237 type ModuleHiMap = FiniteMap ModuleName (String, Module)
\r
238 -- Mapping from module name to
\r
239 -- * the file path of its corresponding interface file,
\r
240 -- * the Module, decorated with it's properties
\r
243 (We allege that) it is quicker to build up a mapping from module names
\r
244 to the paths to their corresponding interface files once, than to search
\r
245 along the import part every time we slurp in a new module (which we
\r
246 do quite a lot of.)
\r
249 type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
\r
250 -- for interface files.
\r
252 mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
\r
253 mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
\r
257 {- A pseudo file, currently "dLL_ifs.hi",
\r
258 signals that the interface files
\r
259 contained in a particular directory have got their
\r
260 corresponding object codes stashed away in a DLL
\r
262 This stuff is only needed to deal with Win32 DLLs,
\r
263 and conceivably we conditionally compile in support
\r
264 for handling it. (ToDo?)
\r
266 dir_contain_dll_his = "dLL_ifs.hi"
\r
268 getAllFilesMatching :: SearchPath
\r
269 -> (ModuleHiMap, ModuleHiMap)
\r
270 -> (FilePath, String)
\r
271 -> IO (ModuleHiMap, ModuleHiMap)
\r
272 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
\r
273 -- fpaths entries do not have dir_path prepended
\r
274 fpaths <- getDirectoryContents dir_path
\r
276 (if opt_Static || dir_path == "." then
\r
279 do exists <- doesFileExist (dir_path ++ '/': dir_contain_dll_his)
\r
280 return (if exists then Dll else NotDll)
\r
282 (\ _ {-don't care-} -> return NotDll)
\r
283 return (foldl (addModules is_dll) hims fpaths)
\r
288 ("Import path element `" ++ dir_path ++
\r
289 if (isDoesNotExistError err) then
\r
290 "' does not exist, ignoring."
\r
292 "' couldn't read, ignoring.")
\r
298 -- Dreadfully crude. We want a better way to distinguish
\r
299 -- "library-ish" modules.
\r
300 is_sys | head dir_path == '/' = LibMod
\r
301 | otherwise = UserMod
\r
303 xiffus = reverse dotted_suffix
\r
304 dotted_suffix = case suffix of
\r
309 hi_boot_version_xiffus =
\r
310 reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
\r
311 hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
\r
313 addModules is_dll his@(hi_env, hib_env) filename = fromMaybe his $
\r
314 FMAP add_hi (go xiffus rev_fname) `seqMaybe`
\r
316 FMAP add_vhib (go hi_boot_version_xiffus rev_fname) `seqMaybe`
\r
317 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
\r
319 FMAP add_hib (go hi_boot_xiffus rev_fname)
\r
321 rev_fname = reverse filename
\r
322 path = dir_path ++ '/':filename
\r
324 -- In these functions file_nm is the base of the filename,
\r
325 -- with the path and suffix both stripped off. The filename
\r
326 -- is the *unencoded* module name (else 'make' gets confused).
\r
327 -- But the domain of the HiMaps is ModuleName which is encoded.
\r
328 add_hi file_nm = (add_to_map addNewOne hi_env file_nm, hib_env)
\r
329 add_vhib file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
\r
330 add_hib file_nm = (hi_env, add_to_map addNewOne hib_env file_nm)
\r
332 add_to_map combiner env file_nm
\r
333 = addToFM_C combiner env mod_nm (path, mkModule mod_nm is_sys is_dll)
\r
335 mod_nm = mkSrcModuleFS file_nm
\r
337 -- go prefix (prefix ++ stuff) == Just (reverse stuff)
\r
338 go [] xs = Just (_PK_ (reverse xs))
\r
340 go (x:xs) (y:ys) | x == y = go xs ys
\r
341 | otherwise = Nothing
\r
343 addNewOne | opt_WarnHiShadows = conflict
\r
344 | otherwise = stickWithOld
\r
346 stickWithOld old new = old
\r
347 overrideNew old new = new
\r
349 conflict (old_path,mod) (new_path,_)
\r
350 | old_path /= new_path =
\r
351 pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
\r
352 text (show old_path) <+> text "shadows" $$
\r
353 text (show new_path) $$
\r
354 text "on the import path: " <+>
\r
355 text (concat (intersperse ":" (map fst dirs))))
\r
357 | otherwise = (old_path,mod) -- don't warn about innocous shadowings.
\r
361 %*********************************************************
\r
363 \subsection{Making a search path}
\r
365 %*********************************************************
\r
367 @mkSearchPath@ takes a string consisting of a colon-separated list
\r
368 of directories and corresponding suffixes, and turns it into a list
\r
369 of (directory, suffix) pairs. For example:
\r
372 mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
\r
373 = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
\r
377 mkSearchPath :: Maybe String -> SearchPath
\r
378 mkSearchPath Nothing = [(".",".hi")] -- ToDo: default should be to look in
\r
379 -- the directory the module we're compiling
\r
381 mkSearchPath (Just s) = go s
\r
385 case span (/= '%') s of
\r
387 case span (/= ':') rs of
\r
388 (hisuf,_:rest) -> (dir,hisuf):go rest
\r
389 (hisuf,[]) -> [(dir,hisuf)]
\r