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
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 Show 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
104 Apr 00: We want to record dependencies on all modules other than
105 prelude modules else STG Hugs gets confused because it uses this
106 info to know what modules to link. (Compiled GHC uses command line
107 options to specify this.)
110 data ModFlavour = PrelMod -- A Prelude module
111 | UserMod -- Not library-ish
115 %************************************************************************
117 \subsection{Where from}
119 %************************************************************************
121 The @WhereFrom@ type controls where the renamer looks for an interface file
124 data WhereFrom = ImportByUser -- Ordinary user import: look for M.hi
125 | ImportByUserSource -- User {- SOURCE -}: look for M.hi-boot
126 | ImportBySystem -- Non user import. Look for M.hi if M is in
127 -- the module this module depends on, or is a system-ish module;
128 -- M.hi-boot otherwise
130 instance Outputable WhereFrom where
131 ppr ImportByUser = empty
132 ppr ImportByUserSource = ptext SLIT("{- SOURCE -}")
133 ppr ImportBySystem = ptext SLIT("{- SYSTEM IMPORT -}")
137 %************************************************************************
139 \subsection{The name of a module}
141 %************************************************************************
144 type ModuleName = EncodedFS
145 -- Haskell module names can include the quote character ',
146 -- so the module names have the z-encoding applied to them
148 -- True for names of prelude modules
149 isPrelModuleName :: ModuleName -> Bool
150 -- HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK
151 -- HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK
152 -- HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK
153 -- HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK
154 isPrelModuleName m = take 4 m_str == "Prel" && m_str /= "PrelInfo"
155 where m_str = _UNPK_ m
156 -- HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK
157 -- HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK
158 -- HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK
159 -- HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK
161 pprModuleName :: ModuleName -> SDoc
162 pprModuleName nm = pprEncodedFS nm
164 moduleNameString :: ModuleName -> EncodedString
165 moduleNameString mod = _UNPK_ mod
167 moduleNameUserString :: ModuleName -> UserString
168 moduleNameUserString mod = decode (_UNPK_ mod)
170 mkSrcModule :: UserString -> ModuleName
171 mkSrcModule s = _PK_ (encode s)
173 mkSrcModuleFS :: UserFS -> ModuleName
174 mkSrcModuleFS s = encodeFS s
176 mkSysModuleFS :: EncodedFS -> ModuleName
188 instance Outputable Module where
191 instance Eq Module where
192 (Module m1 _ _) == (Module m2 _ _) = m1 == m2
194 instance Ord Module where
195 (Module m1 _ _) `compare` (Module m2 _ _) = m1 `compare` m2
200 pprModule :: Module -> SDoc
201 pprModule (Module mod _ _) = getPprStyle $ \ sty ->
202 if userStyle sty then
203 text (moduleNameUserString mod)
210 mkModule :: FilePath -- Directory in which this module is
211 -> ModuleName -- Name of the module
214 mkModule dir_path mod_nm is_dll
215 | isPrelModuleName mod_nm = mkPrelModule mod_nm
216 | otherwise = Module mod_nm UserMod is_dll
217 -- Make every module into a 'user module'
218 -- except those constructed by mkPrelModule
221 mkVanillaModule :: ModuleName -> Module
222 mkVanillaModule name = Module name UserMod dell
224 main_mod = mkSrcModuleFS SLIT("Main")
226 -- Main can never be in a DLL - need this
227 -- special case in order to correctly
229 dell | opt_Static || opt_CompilingPrelude ||
230 name == main_mod = NotDll
234 mkThisModule :: ModuleName -> Module -- The module being comiled
236 Module name UserMod NotDll -- This is fine, a Dll flag is only
237 -- pinned on imported modules.
239 mkPrelModule :: ModuleName -> Module
240 mkPrelModule name = Module name sys dll
242 sys | opt_CompilingPrelude = UserMod
243 | otherwise = PrelMod
245 dll | opt_Static || opt_CompilingPrelude = NotDll
248 moduleString :: Module -> EncodedString
249 moduleString (Module mod _ _) = _UNPK_ mod
251 moduleName :: Module -> ModuleName
252 moduleName (Module mod _ _) = mod
254 moduleUserString :: Module -> UserString
255 moduleUserString (Module mod _ _) = moduleNameUserString mod
259 isDynamicModule :: Module -> Bool
260 isDynamicModule (Module _ _ Dll) = True
261 isDynamicModule _ = False
263 isPrelModule :: Module -> Bool
264 isPrelModule (Module _ PrelMod _) = True
265 isPrelModule _ = False
269 %************************************************************************
271 \subsection{Finding modules in the file system
273 %************************************************************************
276 type ModuleHiMap = FiniteMap ModuleName (String, Module)
277 -- Mapping from module name to
278 -- * the file path of its corresponding interface file,
279 -- * the Module, decorated with it's properties
282 (We allege that) it is quicker to build up a mapping from module names
283 to the paths to their corresponding interface files once, than to search
284 along the import part every time we slurp in a new module (which we
288 type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
289 -- for interface files.
291 mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
292 mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
296 {- A pseudo file, currently "dLL_ifs.hi",
297 signals that the interface files
298 contained in a particular directory have got their
299 corresponding object codes stashed away in a DLL
301 This stuff is only needed to deal with Win32 DLLs,
302 and conceivably we conditionally compile in support
303 for handling it. (ToDo?)
305 dir_contain_dll_his = "dLL_ifs.hi"
307 getAllFilesMatching :: SearchPath
308 -> (ModuleHiMap, ModuleHiMap)
309 -> (FilePath, String)
310 -> IO (ModuleHiMap, ModuleHiMap)
311 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
312 -- fpaths entries do not have dir_path prepended
313 fpaths <- getDirectoryContents dir_path
315 (if opt_Static || dir_path == "." then
318 do exists <- doesFileExist (dir_path ++ '/': dir_contain_dll_his)
319 return (if exists then Dll else NotDll)
321 (\ _ {-don't care-} -> return NotDll)
322 return (foldl (addModules is_dll) hims fpaths))
327 ("Import path element `" ++ dir_path ++
328 if (isDoesNotExistError err) then
329 "' does not exist, ignoring."
331 "' couldn't read, ignoring.")
336 xiffus = reverse dotted_suffix
337 dotted_suffix = case suffix of
342 hi_boot_version_xiffus =
343 reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
344 hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
346 addModules is_dll his@(hi_env, hib_env) filename = fromMaybe his $
347 FMAP add_hi (go xiffus rev_fname) `seqMaybe`
349 FMAP add_vhib (go hi_boot_version_xiffus rev_fname) `seqMaybe`
350 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
352 FMAP add_hib (go hi_boot_xiffus rev_fname)
354 rev_fname = reverse filename
355 path = dir_path ++ '/':filename
357 -- In these functions file_nm is the base of the filename,
358 -- with the path and suffix both stripped off. The filename
359 -- is the *unencoded* module name (else 'make' gets confused).
360 -- But the domain of the HiMaps is ModuleName which is encoded.
361 add_hi file_nm = (add_to_map addNewOne hi_env file_nm, hib_env)
362 add_vhib file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
363 add_hib file_nm = (hi_env, add_to_map addNewOne hib_env file_nm)
365 add_to_map combiner env file_nm
366 = addToFM_C combiner env mod_nm (path, mkModule dir_path mod_nm is_dll)
368 mod_nm = mkSrcModuleFS file_nm
370 -- go prefix (prefix ++ stuff) == Just (reverse stuff)
371 go [] xs = Just (_PK_ (reverse xs))
373 go (x:xs) (y:ys) | x == y = go xs ys
374 | otherwise = Nothing
376 addNewOne | opt_WarnHiShadows = conflict
377 | otherwise = stickWithOld
379 stickWithOld old new = old
380 overrideNew old new = new
382 conflict (old_path,mod) (new_path,_)
383 | old_path /= new_path =
384 pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
385 text (show old_path) <+> text "shadows" $$
386 text (show new_path) $$
387 text "on the import path: " <+>
388 text (concat (intersperse ":" (map fst dirs))))
390 | otherwise = (old_path,mod) -- don't warn about innocous shadowings.
394 %*********************************************************
396 \subsection{Making a search path}
398 %*********************************************************
400 @mkSearchPath@ takes a string consisting of a colon-separated list
401 of directories and corresponding suffixes, and turns it into a list
402 of (directory, suffix) pairs. For example:
405 mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
406 = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
410 mkSearchPath :: Maybe String -> SearchPath
411 mkSearchPath Nothing = [(".",".hi")] -- ToDo: default should be to look in
412 -- the directory the module we're compiling
414 mkSearchPath (Just s) = go s
418 case span (/= '%') s of
420 case span (/= opt_HiMapSep) rs of
421 (hisuf,_:rest) -> (dir,hisuf):go rest
422 (hisuf,[]) -> [(dir,hisuf)]