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