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 _ _) = getPprStyle $ \ sty ->
188 if userStyle sty then
189 text (moduleNameUserString mod)
198 mkVanillaModule :: ModuleName -> Module
199 mkVanillaModule name = Module name UserMod dell
201 main_mod = mkSrcModuleFS SLIT("Main")
203 -- Main can never be in a DLL - need this
204 -- special case in order to correctly
206 dell | opt_Static || opt_CompilingPrelude ||
207 name == main_mod = NotDll
211 mkThisModule :: ModuleName -> Module -- The module being comiled
213 Module name UserMod NotDll -- This is fine, a Dll flag is only
214 -- pinned on imported modules.
216 mkPrelModule :: ModuleName -> Module
217 mkPrelModule name = Module name sys dll
219 sys | opt_CompilingPrelude = UserMod
222 dll | opt_Static || opt_CompilingPrelude = NotDll
225 moduleString :: Module -> EncodedString
226 moduleString (Module mod _ _) = _UNPK_ mod
228 moduleName :: Module -> ModuleName
229 moduleName (Module mod _ _) = mod
231 moduleUserString :: Module -> UserString
232 moduleUserString (Module mod _ _) = moduleNameUserString mod
236 isDynamicModule :: Module -> Bool
237 isDynamicModule (Module _ _ Dll) = True
238 isDynamicModule _ = False
240 isLibModule :: Module -> Bool
241 isLibModule (Module _ LibMod _) = True
242 isLibModule _ = False
246 %************************************************************************
248 \subsection{Finding modules in the file system
250 %************************************************************************
253 type ModuleHiMap = FiniteMap ModuleName (String, Module)
254 -- Mapping from module name to
255 -- * the file path of its corresponding interface file,
256 -- * the Module, decorated with it's properties
259 (We allege that) it is quicker to build up a mapping from module names
260 to the paths to their corresponding interface files once, than to search
261 along the import part every time we slurp in a new module (which we
265 type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
266 -- for interface files.
268 mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
269 mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
273 {- A pseudo file, currently "dLL_ifs.hi",
274 signals that the interface files
275 contained in a particular directory have got their
276 corresponding object codes stashed away in a DLL
278 This stuff is only needed to deal with Win32 DLLs,
279 and conceivably we conditionally compile in support
280 for handling it. (ToDo?)
282 dir_contain_dll_his = "dLL_ifs.hi"
284 getAllFilesMatching :: SearchPath
285 -> (ModuleHiMap, ModuleHiMap)
286 -> (FilePath, String)
287 -> IO (ModuleHiMap, ModuleHiMap)
288 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
289 -- fpaths entries do not have dir_path prepended
290 fpaths <- getDirectoryContents dir_path
292 (if opt_Static || dir_path == "." then
295 do exists <- doesFileExist (dir_path ++ '/': dir_contain_dll_his)
296 return (if exists then Dll else NotDll)
298 (\ _ {-don't care-} -> return NotDll)
299 return (foldl (addModules is_dll) hims fpaths)
304 ("Import path element `" ++ dir_path ++
305 if (isDoesNotExistError err) then
306 "' does not exist, ignoring."
308 "' couldn't read, ignoring.")
314 is_sys | isLibraryPath dir_path = LibMod
315 | otherwise = UserMod
317 -- Dreadfully crude way to tell whether a module is a "library"
318 -- module or not. The current story is simply that if path is
319 -- absolute we treat it as a library. Specifically:
323 isLibraryPath ('/' : _ ) = True
324 isLibraryPath (_ : ':' : '/' : _) = True
325 isLibraryPath (_ : ':' : '\\' : _) = True
326 isLibraryPath other = False
328 xiffus = reverse dotted_suffix
329 dotted_suffix = case suffix of
334 hi_boot_version_xiffus =
335 reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
336 hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
338 addModules is_dll his@(hi_env, hib_env) filename = fromMaybe his $
339 FMAP add_hi (go xiffus rev_fname) `seqMaybe`
341 FMAP add_vhib (go hi_boot_version_xiffus rev_fname) `seqMaybe`
342 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
344 FMAP add_hib (go hi_boot_xiffus rev_fname)
346 rev_fname = reverse filename
347 path = dir_path ++ '/':filename
349 -- In these functions file_nm is the base of the filename,
350 -- with the path and suffix both stripped off. The filename
351 -- is the *unencoded* module name (else 'make' gets confused).
352 -- But the domain of the HiMaps is ModuleName which is encoded.
353 add_hi file_nm = (add_to_map addNewOne hi_env file_nm, hib_env)
354 add_vhib file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
355 add_hib file_nm = (hi_env, add_to_map addNewOne hib_env file_nm)
357 add_to_map combiner env file_nm
358 = addToFM_C combiner env mod_nm (path, mkModule mod_nm is_sys is_dll)
360 mod_nm = mkSrcModuleFS file_nm
362 -- go prefix (prefix ++ stuff) == Just (reverse stuff)
363 go [] xs = Just (_PK_ (reverse xs))
365 go (x:xs) (y:ys) | x == y = go xs ys
366 | otherwise = Nothing
368 addNewOne | opt_WarnHiShadows = conflict
369 | otherwise = stickWithOld
371 stickWithOld old new = old
372 overrideNew old new = new
374 conflict (old_path,mod) (new_path,_)
375 | old_path /= new_path =
376 pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
377 text (show old_path) <+> text "shadows" $$
378 text (show new_path) $$
379 text "on the import path: " <+>
380 text (concat (intersperse ":" (map fst dirs))))
382 | otherwise = (old_path,mod) -- don't warn about innocous shadowings.
386 %*********************************************************
388 \subsection{Making a search path}
390 %*********************************************************
392 @mkSearchPath@ takes a string consisting of a colon-separated list
393 of directories and corresponding suffixes, and turns it into a list
394 of (directory, suffix) pairs. For example:
397 mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
398 = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
402 mkSearchPath :: Maybe String -> SearchPath
403 mkSearchPath Nothing = [(".",".hi")] -- ToDo: default should be to look in
404 -- the directory the module we're compiling
406 mkSearchPath (Just s) = go s
410 case span (/= '%') s of
412 case span (/= opt_HiMapSep) rs of
413 (hisuf,_:rest) -> (dir,hisuf):go rest
414 (hisuf,[]) -> [(dir,hisuf)]