- m rn_down s_down
-
-
-emptyIfaces :: Module -> Ifaces
-emptyIfaces mod = Ifaces { iMod = mod,
- iModMap = emptyFM,
- iDecls = emptyNameEnv,
- iFixes = emptyNameEnv,
- iSlurp = emptyNameSet,
- iVSlurp = [],
- iDefInsts = (emptyBag, emptyNameSet),
- iDefData = emptyNameEnv,
- iInstMods = []
- }
-
-builtins :: FiniteMap (Module,OccName) Name
-builtins = bagToFM $
- mapBag (\ name -> ((nameModule name, nameOccName name), name))
- builtinNames
-
- -- Initial value for the occurrence pool.
-initOccs :: ([Occurrence],[Occurrence]) -- Compulsory and optional respectively
-initOccs = ([(getName boolTyCon, noSrcLoc)], [])
- -- Booleans occur implicitly a lot, so it's tiresome to keep recording the fact, and
- -- rather implausible that not one will be used in the module.
- -- We could add some other common types, notably lists, but the general idea is
- -- to do as much as possible explicitly.
-\end{code}
-
-\begin{code}
-mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
-mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
- where
- env = emptyFM
-
-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
- return (foldl addModules 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
- 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 his@(hi_env, hib_env) nm = fromMaybe his $
- FMAP (\ (mod_nm,v) -> (addToFM_C addNewOne hi_env mod_nm v, hib_env))
- (go xiffus rev_nm) `seqMaybe`
-
- FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C overrideNew hib_env mod_nm v))
- (go hi_boot_version_xiffus rev_nm) `seqMaybe`
-
- FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C addNewOne hib_env mod_nm v))
- (go hi_boot_xiffus rev_nm)
- where
- rev_nm = reverse nm
-
- go [] xs = Just (reverse xs, dir_path ++'/':nm)
- 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 new_path
- | old_path /= new_path =
- pprTrace "Warning: " (text "Identically named interface files present on 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
- | otherwise = old_path -- don't warn about innocous shadowings.