X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FModule.lhs;h=0cc8d1605e03fa3bd77805084ca0bbfa48e646f2;hb=1211c4e59dd9c4f5e7b027649a1e3c6eb459f5e1;hp=6220780d799c0cf0d36d4aaddb70b068c3c2bf53;hpb=4ee4015514f6955b9f9f17361ce3bf0218fffae2;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 6220780..0cc8d16 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -5,6 +5,19 @@ Representing modules and their flavours. + +Notes on DLLs +~~~~~~~~~~~~~ +When compiling module A, which imports module B, we need to +know whether B will be in the same DLL as A. + If it's in the same DLL, we refer to B_f_closure + If it isn't, we refer to _imp__B_f_closure +When compiling A, we record in B's Module value whether it's +in a different DLL, by setting the DLL flag. + + + + \begin{code} module Module ( @@ -35,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} @@ -93,27 +96,6 @@ instance Show PackageInfo where -- Just used in debug prints of lex tokens %************************************************************************ %* * -\subsection{System/user module} -%* * -%************************************************************************ - -We also track whether an imported module is from a 'system-ish' place. In this case -we don't record the fact that this module depends on it, nor usages of things -inside it. - -Apr 00: We want to record dependencies on all modules other than -prelude modules else STG Hugs gets confused because it uses this -info to know what modules to link. (Compiled GHC uses command line -options to specify this.) - -\begin{code} -data ModFlavour = PrelMod -- A Prelude module - | UserMod -- Not library-ish -\end{code} - - -%************************************************************************ -%* * \subsection{Where from} %* * %************************************************************************ @@ -183,9 +165,7 @@ instance Ord Module where \begin{code} pprModule :: Module -> SDoc pprModule (Module mod p) = getPprStyle $ \ sty -> - if userStyle sty then - text (moduleNameUserString mod) - else if debugStyle sty then + if debugStyle sty then -- Print the package too text (show p) <> dot <> pprModuleName mod else @@ -203,6 +183,7 @@ mkModule mod_nm pack_name pack_info | pack_name == opt_InPackage = ThisPackage | otherwise = AnotherPackage pack_name + mkVanillaModule :: ModuleName -> Module mkVanillaModule name = Module name ThisPackage -- Used temporarily when we first come across Foo.x in an interface @@ -230,142 +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 (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) 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} -