-type ModuleHiMap = FiniteMap ModuleName (String, Module)
- -- Mapping from module name to
- -- * the file path of its corresponding interface file,
- -- * the Module, decorated with it's properties
-\end{code}
-
-(We allege that) it is quicker to build up a mapping from module names
-to the paths to their corresponding interface files once, than to search
-along the import part every time we slurp in a new module (which we
-do quite a lot of.)
-
-\begin{code}
-type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
- -- for interface files.
-
-mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
-mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
- where
- env = emptyFM
-
-{- A pseudo file, currently "dLL_ifs.hi",
- signals that the interface files
- contained in a particular directory have got their
- corresponding object codes stashed away in a DLL
-
- This stuff is only needed to deal with Win32 DLLs,
- and conceivably we conditionally compile in support
- for handling it. (ToDo?)
--}
-dir_contain_dll_his = "dLL_ifs.hi"
-
-getAllFilesMatching :: SearchPath
- -> (ModuleHiMap, ModuleHiMap)
- -> (FilePath, String)
- -> IO (ModuleHiMap, ModuleHiMap)
-getAllFilesMatching dirs hims (dir_path, suffix) = ( do
- -- fpaths entries do not have dir_path prepended
- fpaths <- getDirectoryContents dir_path
- is_dll <- catch
- (if opt_Static || dir_path == "." then
- return NotDll
- else
- do exists <- doesFileExist (dir_path ++ '/': dir_contain_dll_his)
- return (if exists then Dll else NotDll)
- )
- (\ _ {-don't care-} -> return NotDll)
- return (foldl (addModules is_dll) hims fpaths)
- ) -- soft failure
- `catch`
- (\ err -> do
- hPutStrLn stderr
- ("Import path element `" ++ dir_path ++
- if (isDoesNotExistError err) then
- "' does not exist, ignoring."
- else
- "' couldn't read, ignoring.")
-
- return hims
- )
- where
-
- -- Dreadfully crude. We want a better way to distinguish
- -- "library-ish" modules.
- is_sys | head dir_path == '/' = LibMod
- | otherwise = UserMod
-
- xiffus = reverse dotted_suffix
- dotted_suffix = case suffix of
- [] -> []
- ('.':xs) -> suffix
- ls -> '.':ls
-
- hi_boot_version_xiffus =
- reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
- hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
-
- addModules is_dll his@(hi_env, hib_env) filename = fromMaybe his $
- FMAP add_hi (go xiffus rev_fname) `seqMaybe`
-
- FMAP add_vhib (go hi_boot_version_xiffus rev_fname) `seqMaybe`
- -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
-
- FMAP add_hib (go hi_boot_xiffus rev_fname)
- where
- rev_fname = reverse filename
- path = dir_path ++ '/':filename
-
- -- In these functions file_nm is the base of the filename,
- -- with the path and suffix both stripped off. The filename
- -- is the *unencoded* module name (else 'make' gets confused).
- -- But the domain of the HiMaps is ModuleName which is encoded.
- add_hi file_nm = (add_to_map addNewOne hi_env file_nm, hib_env)
- add_vhib file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
- add_hib file_nm = (hi_env, add_to_map addNewOne hib_env file_nm)
-
- add_to_map combiner env file_nm
- = addToFM_C combiner env mod_nm (path, mkModule mod_nm is_sys is_dll)
- where
- mod_nm = mkSrcModuleFS file_nm
-
- -- go prefix (prefix ++ stuff) == Just (reverse stuff)
- go [] xs = Just (_PK_ (reverse xs))
- go _ [] = Nothing
- go (x:xs) (y:ys) | x == y = go xs ys
- | otherwise = Nothing
-
- addNewOne | opt_WarnHiShadows = conflict
- | otherwise = stickWithOld
-
- stickWithOld old new = old
- overrideNew old new = new
-
- conflict (old_path,mod) (new_path,_)
- | old_path /= new_path =
- pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
- text (show old_path) <+> text "shadows" $$
- text (show new_path) $$
- text "on the import path: " <+>
- text (concat (intersperse ":" (map fst dirs))))
- (old_path,mod)
- | otherwise = (old_path,mod) -- don't warn about innocous shadowings.
+type ModuleEnv elt = UniqFM elt
+
+emptyModuleEnv :: ModuleEnv a
+mkModuleEnv :: [(Module, a)] -> ModuleEnv a
+unitModuleEnv :: Module -> a -> ModuleEnv a
+extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnv_C :: (a->a->a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
+plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
+
+delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
+delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
+plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
+moduleEnvElts :: ModuleEnv a -> [a]
+
+isEmptyModuleEnv :: ModuleEnv a -> Bool
+lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
+lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
+elemModuleEnv :: Module -> ModuleEnv a -> Bool
+foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
+filterModuleEnv :: (a -> Bool) -> ModuleEnv a -> ModuleEnv a
+
+filterModuleEnv = filterUFM
+elemModuleEnv = elemUFM
+extendModuleEnv = addToUFM
+extendModuleEnv_C = addToUFM_C
+extendModuleEnvList = addListToUFM
+plusModuleEnv_C = plusUFM_C
+delModuleEnvList = delListFromUFM
+delModuleEnv = delFromUFM
+plusModuleEnv = plusUFM
+lookupModuleEnv = lookupUFM
+lookupWithDefaultModuleEnv = lookupWithDefaultUFM
+mapModuleEnv = mapUFM
+mkModuleEnv = listToUFM
+emptyModuleEnv = emptyUFM
+moduleEnvElts = eltsUFM
+unitModuleEnv = unitUFM
+isEmptyModuleEnv = isNullUFM
+foldModuleEnv = foldUFM