Commit 9a219892 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-10-11 14:08:23 by simonmar]

nuke all the search path cruft in this file
parent 3e4dae71
......@@ -48,24 +48,14 @@ module Module
, PackageName
-- Where to find a .hi file
, WhereFrom(..), SearchPath, mkSearchPath
, ModuleHiMap, mkModuleHiMaps
, WhereFrom(..)
) where
#include "HsVersions.h"
import OccName
import Outputable
import FiniteMap
import CmdLineOpts ( opt_Static, opt_InPackage, opt_WarnHiShadows, opt_HiMapSep )
import Constants ( interfaceFileFormatVersion )
import Maybes ( seqMaybe )
import Maybe ( fromMaybe )
import Directory ( doesFileExist )
import DirUtils ( getDirectoryContents )
import List ( intersperse )
import Monad ( foldM )
import IO ( hPutStrLn, stderr, isDoesNotExistError )
import CmdLineOpts ( opt_InPackage )
import FastString ( FastString )
\end{code}
......@@ -221,143 +211,3 @@ isLocalModule :: Module -> Bool
isLocalModule (Module _ ThisPackage) = True
isLocalModule _ = False
\end{code}
%************************************************************************
%* *
\subsection{Finding modules in the file system
%* *
%************************************************************************
\begin{code}
type ModuleHiMap = FiniteMap ModuleName String
-- Mapping from module name to
-- * the file path of its corresponding interface file,
-- * the ModuleName
\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 (SearchPath, ModuleHiMap, ModuleHiMap)
mkModuleHiMaps dirs = do (hi,hi_boot) <- foldM (getAllFilesMatching dirs) (env,env) dirs
return (dirs, hi, hi_boot)
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) 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
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 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
| otherwise = old_path -- don't warn about innocous shadowings.
\end{code}
%*********************************************************
%* *
\subsection{Making a search path}
%* *
%*********************************************************
@mkSearchPath@ takes a string consisting of a colon-separated list
of directories and corresponding suffixes, and turns it into a list
of (directory, suffix) pairs. For example:
\begin{verbatim}
mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
= [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
\begin{verbatim}
\begin{code}
mkSearchPath :: Maybe String -> SearchPath
mkSearchPath Nothing = [(".",".hi")] -- ToDo: default should be to look in
-- the directory the module we're compiling
-- lives.
mkSearchPath (Just s) = go s
where
go "" = []
go s =
case span (/= '%') s of
(dir,'%':rs) ->
case span (/= opt_HiMapSep) rs of
(hisuf,_:rest) -> (dir,hisuf):go rest
(hisuf,[]) -> [(dir,hisuf)]
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment