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
24 , mkModule -- :: ModuleName -> PackageName -> Module
26 , isLocalModule -- :: Module -> Bool
30 , mkSrcModuleFS -- :: UserFS -> ModuleName
31 , mkSysModuleFS -- :: EncodedFS -> ModuleName
33 , pprModule, pprModuleName
37 -- Where to find a .hi file
38 , WhereFrom(..), SearchPath, mkSearchPath
39 , ModuleHiMap, mkModuleHiMaps
43 #include "HsVersions.h"
47 import CmdLineOpts ( opt_Static, opt_InPackage, opt_WarnHiShadows, opt_HiMapSep )
48 import Constants ( interfaceFileFormatVersion )
49 import Maybes ( seqMaybe )
50 import Maybe ( fromMaybe )
51 import Directory ( doesFileExist )
52 import DirUtils ( getDirectoryContents )
53 import List ( intersperse )
54 import Monad ( foldM )
55 import IO ( hPutStrLn, stderr, isDoesNotExistError )
56 import FastString ( FastString )
60 %************************************************************************
62 \subsection{Interface file flavour}
64 %************************************************************************
66 A further twist to the tale is the support for dynamically linked libraries under
67 Win32. Here, dealing with the use of global variables that's residing in a DLL
68 requires special handling at the point of use (there's an extra level of indirection,
69 i.e., (**v) to get at v's value, rather than just (*v) .) When slurping in an
70 interface file we then record whether it's coming from a .hi corresponding to a
71 module that's packaged up in a DLL or not, so that we later can emit the
74 The logic for how an interface file is marked as corresponding to a module that's
75 hiding in a DLL is explained elsewhere (ToDo: give renamer href here.)
78 data PackageInfo = ThisPackage -- A module from the same package
79 -- as the one being compiled
80 | AnotherPackage PackageName -- A module from a different package
82 type PackageName = FastString -- No encoding at all
84 preludePackage :: PackageName
85 preludePackage = SLIT("std")
87 instance Show PackageInfo where -- Just used in debug prints of lex tokens
88 showsPrec n ThisPackage s = s
89 showsPrec n (AnotherPackage p) s = (_UNPK_ p) ++ s
93 %************************************************************************
95 \subsection{System/user module}
97 %************************************************************************
99 We also track whether an imported module is from a 'system-ish' place. In this case
100 we don't record the fact that this module depends on it, nor usages of things
103 Apr 00: We want to record dependencies on all modules other than
104 prelude modules else STG Hugs gets confused because it uses this
105 info to know what modules to link. (Compiled GHC uses command line
106 options to specify this.)
109 data ModFlavour = PrelMod -- A Prelude module
110 | UserMod -- Not library-ish
114 %************************************************************************
116 \subsection{Where from}
118 %************************************************************************
120 The @WhereFrom@ type controls where the renamer looks for an interface file
123 data WhereFrom = ImportByUser -- Ordinary user import: look for M.hi
124 | ImportByUserSource -- User {- SOURCE -}: look for M.hi-boot
125 | ImportBySystem -- Non user import. Look for M.hi if M is in
126 -- the module this module depends on, or is a system-ish module;
127 -- M.hi-boot otherwise
129 instance Outputable WhereFrom where
130 ppr ImportByUser = empty
131 ppr ImportByUserSource = ptext SLIT("{- SOURCE -}")
132 ppr ImportBySystem = ptext SLIT("{- SYSTEM IMPORT -}")
136 %************************************************************************
138 \subsection{The name of a module}
140 %************************************************************************
143 type ModuleName = EncodedFS
144 -- Haskell module names can include the quote character ',
145 -- 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
167 data Module = Module ModuleName PackageInfo
171 instance Outputable Module where
174 instance Eq Module where
175 (Module m1 _) == (Module m2 _) = m1 == m2
177 instance Ord Module where
178 (Module m1 _) `compare` (Module m2 _) = m1 `compare` m2
183 pprModule :: Module -> SDoc
184 pprModule (Module mod _) = getPprStyle $ \ sty ->
185 if userStyle sty then
186 text (moduleNameUserString mod)
193 mkModule :: ModuleName -- Name of the module
196 mkModule mod_nm pack_name
197 = Module mod_nm pack_info
199 pack_info | pack_name == opt_InPackage = ThisPackage
200 | otherwise = AnotherPackage pack_name
202 mkVanillaModule :: ModuleName -> Module
203 mkVanillaModule name = Module name (pprTrace "mkVanillaModule" (ppr name) ThisPackage)
204 -- Used temporarily when we first come across Foo.x in an interface
205 -- file, but before we've opened Foo.hi.
206 -- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
208 mkThisModule :: ModuleName -> Module -- The module being comiled
209 mkThisModule name = Module name ThisPackage
211 mkPrelModule :: ModuleName -> Module
212 mkPrelModule name = mkModule name preludePackage
214 moduleString :: Module -> EncodedString
215 moduleString (Module mod _) = _UNPK_ mod
217 moduleName :: Module -> ModuleName
218 moduleName (Module mod _) = mod
220 moduleUserString :: Module -> UserString
221 moduleUserString (Module mod _) = moduleNameUserString mod
225 isLocalModule :: Module -> Bool
226 isLocalModule (Module _ ThisPackage) = True
227 isLocalModule _ = False
231 %************************************************************************
233 \subsection{Finding modules in the file system
235 %************************************************************************
238 type ModuleHiMap = FiniteMap ModuleName String
239 -- Mapping from module name to
240 -- * the file path of its corresponding interface file,
244 (We allege that) it is quicker to build up a mapping from module names
245 to the paths to their corresponding interface files once, than to search
246 along the import part every time we slurp in a new module (which we
250 type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
251 -- for interface files.
253 mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
254 mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
258 getAllFilesMatching :: SearchPath
259 -> (ModuleHiMap, ModuleHiMap)
260 -> (FilePath, String)
261 -> IO (ModuleHiMap, ModuleHiMap)
262 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
263 -- fpaths entries do not have dir_path prepended
264 fpaths <- getDirectoryContents dir_path
265 return (foldl addModules hims fpaths))
270 ("Import path element `" ++ dir_path ++
271 if (isDoesNotExistError err) then
272 "' does not exist, ignoring."
274 "' couldn't read, ignoring.")
279 xiffus = reverse dotted_suffix
280 dotted_suffix = case suffix of
285 hi_boot_version_xiffus =
286 reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
287 hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
289 addModules his@(hi_env, hib_env) filename = fromMaybe his $
290 FMAP add_hi (go xiffus rev_fname) `seqMaybe`
292 FMAP add_vhib (go hi_boot_version_xiffus rev_fname) `seqMaybe`
293 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
295 FMAP add_hib (go hi_boot_xiffus rev_fname)
297 rev_fname = reverse filename
298 path = dir_path ++ '/':filename
300 -- In these functions file_nm is the base of the filename,
301 -- with the path and suffix both stripped off. The filename
302 -- is the *unencoded* module name (else 'make' gets confused).
303 -- But the domain of the HiMaps is ModuleName which is encoded.
304 add_hi file_nm = (add_to_map addNewOne hi_env file_nm, hib_env)
305 add_vhib file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
306 add_hib file_nm = (hi_env, add_to_map addNewOne hib_env file_nm)
308 add_to_map combiner env file_nm
309 = addToFM_C combiner env mod_nm path
311 mod_nm = mkSrcModuleFS file_nm
313 -- go prefix (prefix ++ stuff) == Just (reverse stuff)
314 go [] xs = Just (_PK_ (reverse xs))
316 go (x:xs) (y:ys) | x == y = go xs ys
317 | otherwise = Nothing
319 addNewOne | opt_WarnHiShadows = conflict
320 | otherwise = stickWithOld
322 stickWithOld old new = old
323 overrideNew old new = new
325 conflict old_path new_path
326 | old_path /= new_path =
327 pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
328 text (show old_path) <+> text "shadows" $$
329 text (show new_path) $$
330 text "on the import path: " <+>
331 text (concat (intersperse ":" (map fst dirs))))
333 | otherwise = old_path -- don't warn about innocous shadowings.
337 %*********************************************************
339 \subsection{Making a search path}
341 %*********************************************************
343 @mkSearchPath@ takes a string consisting of a colon-separated list
344 of directories and corresponding suffixes, and turns it into a list
345 of (directory, suffix) pairs. For example:
348 mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
349 = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
353 mkSearchPath :: Maybe String -> SearchPath
354 mkSearchPath Nothing = [(".",".hi")] -- ToDo: default should be to look in
355 -- the directory the module we're compiling
357 mkSearchPath (Just s) = go s
361 case span (/= '%') s of
363 case span (/= opt_HiMapSep) rs of
364 (hisuf,_:rest) -> (dir,hisuf):go rest
365 (hisuf,[]) -> [(dir,hisuf)]