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
89 showsPrec n ThisPackage s = "<THIS>" ++ s
90 showsPrec n (AnotherPackage p) s = (_UNPK_ p) ++ 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 pprModuleName :: ModuleName -> SDoc
149 pprModuleName nm = pprEncodedFS nm
151 moduleNameString :: ModuleName -> EncodedString
152 moduleNameString mod = _UNPK_ mod
154 moduleNameUserString :: ModuleName -> UserString
155 moduleNameUserString mod = decode (_UNPK_ mod)
157 mkSrcModule :: UserString -> ModuleName
158 mkSrcModule s = _PK_ (encode s)
160 mkSrcModuleFS :: UserFS -> ModuleName
161 mkSrcModuleFS s = encodeFS s
163 mkSysModuleFS :: EncodedFS -> ModuleName
168 data Module = Module ModuleName PackageInfo
172 instance Outputable Module where
175 instance Eq Module where
176 (Module m1 _) == (Module m2 _) = m1 == m2
178 instance Ord Module where
179 (Module m1 _) `compare` (Module m2 _) = m1 `compare` m2
184 pprModule :: Module -> SDoc
185 pprModule (Module mod p) = getPprStyle $ \ sty ->
186 if debugStyle sty then
187 -- Print the package too
188 text (show p) <> dot <> pprModuleName mod
195 mkModule :: ModuleName -- Name of the module
198 mkModule mod_nm pack_name
199 = Module mod_nm pack_info
201 pack_info | pack_name == opt_InPackage = ThisPackage
202 | otherwise = AnotherPackage pack_name
204 mkVanillaModule :: ModuleName -> Module
205 mkVanillaModule name = Module name ThisPackage
206 -- Used temporarily when we first come across Foo.x in an interface
207 -- file, but before we've opened Foo.hi.
208 -- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
210 mkThisModule :: ModuleName -> Module -- The module being compiled
211 mkThisModule name = Module name ThisPackage
213 mkPrelModule :: ModuleName -> Module
214 mkPrelModule name = mkModule name preludePackage
216 moduleString :: Module -> EncodedString
217 moduleString (Module mod _) = _UNPK_ mod
219 moduleName :: Module -> ModuleName
220 moduleName (Module mod _) = mod
222 moduleUserString :: Module -> UserString
223 moduleUserString (Module mod _) = moduleNameUserString mod
227 isLocalModule :: Module -> Bool
228 isLocalModule (Module _ ThisPackage) = True
229 isLocalModule _ = False
233 %************************************************************************
235 \subsection{Finding modules in the file system
237 %************************************************************************
240 type ModuleHiMap = FiniteMap ModuleName String
241 -- Mapping from module name to
242 -- * the file path of its corresponding interface file,
246 (We allege that) it is quicker to build up a mapping from module names
247 to the paths to their corresponding interface files once, than to search
248 along the import part every time we slurp in a new module (which we
252 type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
253 -- for interface files.
255 mkModuleHiMaps :: SearchPath -> IO (SearchPath, ModuleHiMap, ModuleHiMap)
256 mkModuleHiMaps dirs = do (hi,hi_boot) <- foldM (getAllFilesMatching dirs) (env,env) dirs
257 return (dirs, hi, hi_boot)
261 getAllFilesMatching :: SearchPath
262 -> (ModuleHiMap, ModuleHiMap)
263 -> (FilePath, String)
264 -> IO (ModuleHiMap, ModuleHiMap)
265 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
266 -- fpaths entries do not have dir_path prepended
267 fpaths <- getDirectoryContents dir_path
268 return (foldl addModules hims fpaths))
273 ("Import path element `" ++ dir_path ++
274 if (isDoesNotExistError err) then
275 "' does not exist, ignoring."
277 "' couldn't read, ignoring.")
282 xiffus = reverse dotted_suffix
283 dotted_suffix = case suffix of
288 hi_boot_version_xiffus =
289 reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
290 hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
292 addModules his@(hi_env, hib_env) filename = fromMaybe his $
293 FMAP add_hi (go xiffus rev_fname) `seqMaybe`
295 FMAP add_vhib (go hi_boot_version_xiffus rev_fname) `seqMaybe`
296 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
298 FMAP add_hib (go hi_boot_xiffus rev_fname)
300 rev_fname = reverse filename
301 path = dir_path ++ '/':filename
303 -- In these functions file_nm is the base of the filename,
304 -- with the path and suffix both stripped off. The filename
305 -- is the *unencoded* module name (else 'make' gets confused).
306 -- But the domain of the HiMaps is ModuleName which is encoded.
307 add_hi file_nm = (add_to_map addNewOne hi_env file_nm, hib_env)
308 add_vhib file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
309 add_hib file_nm = (hi_env, add_to_map addNewOne hib_env file_nm)
311 add_to_map combiner env file_nm
312 = addToFM_C combiner env mod_nm path
314 mod_nm = mkSrcModuleFS file_nm
316 -- go prefix (prefix ++ stuff) == Just (reverse stuff)
317 go [] xs = Just (_PK_ (reverse xs))
319 go (x:xs) (y:ys) | x == y = go xs ys
320 | otherwise = Nothing
322 addNewOne | opt_WarnHiShadows = conflict
323 | otherwise = stickWithOld
325 stickWithOld old new = old
326 overrideNew old new = new
328 conflict old_path new_path
329 | old_path /= new_path =
330 pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
331 text (show old_path) <+> text "shadows" $$
332 text (show new_path) $$
333 text "on the import path: " <+>
334 text (concat (intersperse ":" (map fst dirs))))
336 | otherwise = old_path -- don't warn about innocous shadowings.
340 %*********************************************************
342 \subsection{Making a search path}
344 %*********************************************************
346 @mkSearchPath@ takes a string consisting of a colon-separated list
347 of directories and corresponding suffixes, and turns it into a list
348 of (directory, suffix) pairs. For example:
351 mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
352 = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
356 mkSearchPath :: Maybe String -> SearchPath
357 mkSearchPath Nothing = [(".",".hi")] -- ToDo: default should be to look in
358 -- the directory the module we're compiling
360 mkSearchPath (Just s) = go s
364 case span (/= '%') s of
366 case span (/= opt_HiMapSep) rs of
367 (hisuf,_:rest) -> (dir,hisuf):go rest
368 (hisuf,[]) -> [(dir,hisuf)]