X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FModule.lhs;h=9b43ed70bd996099199f7af3e1517a6c378c3134;hb=bbffa95af87bb66635aaffdaddcd31be063752dc;hp=cf86c1ce8998a15d6a58a1891447b81dc7a3e4e0;hpb=c8a3ddcbd6624db585d6d4f9fe9d7e51527db2db;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index cf86c1c..9b43ed7 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -5,58 +5,76 @@ 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 ( - Module -- abstract, instance of Eq, Ord, Outputable + Module, -- Abstract, instance of Eq, Ord, Outputable + + , PackageName -- = FastString; instance of Outputable, Uniquable + , modulePackage -- :: Module -> PackageName + , preludePackage -- :: PackageName name of Standard Prelude package + , ModuleName + , pprModuleName -- :: ModuleName -> SDoc + , printModulePrefix + , moduleName -- :: Module -> ModuleName , moduleNameString -- :: ModuleName -> EncodedString , moduleNameUserString -- :: ModuleName -> UserString + , moduleNameFS -- :: ModuleName -> EncodedFS - , moduleString -- :: Module -> EncodedString - , moduleUserString -- :: Module -> UserString - , moduleName -- :: Module -> ModuleName - - , mkVanillaModule -- :: ModuleName -> Module - , mkThisModule -- :: ModuleName -> Module - , mkPrelModule -- :: UserString -> Module - - , isDynamicModule -- :: Module -> Bool - , isLibModule + , moduleString -- :: Module -> EncodedString + , moduleUserString -- :: Module -> UserString - , mkSrcModule + , mkVanillaModule -- :: ModuleName -> Module + , isVanillaModule -- :: Module -> Bool + , mkPrelModule -- :: UserString -> Module + , isPrelModule -- :: Module -> Bool + , mkModule -- :: ModuleName -> PackageName -> Module + , mkHomeModule -- :: ModuleName -> Module + , isHomeModule -- :: Module -> Bool - , mkSrcModuleFS -- :: UserFS -> ModuleName - , mkSysModuleFS -- :: EncodedFS -> ModuleName + , mkModuleName -- :: UserString -> ModuleName + , mkModuleNameFS -- :: UserFS -> ModuleName + , mkSysModuleNameFS -- :: EncodedFS -> ModuleName - , pprModule, pprModuleName + , pprModule, - -- DllFlavour - , DllFlavour, dll, notDll + -- Where to find a .hi file + , WhereFrom(..) - -- ModFlavour - , ModFlavour, libMod, userMod + , ModuleEnv, + , elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C + , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv + , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv + , moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv + , lookupModuleEnvByName, extendModuleEnv_C - -- Where to find a .hi file - , WhereFrom(..), SearchPath, mkSearchPath - , ModuleHiMap, mkModuleHiMaps + , ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet ) where #include "HsVersions.h" import OccName import Outputable -import FiniteMap -import CmdLineOpts ( opt_Static, opt_CompilingPrelude, 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 ) +import Unique ( Uniquable(..) ) +import UniqFM +import UniqSet \end{code} @@ -66,47 +84,46 @@ import IO ( hPutStrLn, stderr, isDoesNotExistError ) %* * %************************************************************************ -A further twist to the tale is the support for dynamically linked libraries under -Win32. Here, dealing with the use of global variables that's residing in a DLL -requires special handling at the point of use (there's an extra level of indirection, -i.e., (**v) to get at v's value, rather than just (*v) .) When slurping in an -interface file we then record whether it's coming from a .hi corresponding to a -module that's packaged up in a DLL or not, so that we later can emit the +A further twist to the tale is the support for dynamically linked +libraries under Win32. Here, dealing with the use of global variables +that's residing in a DLL requires special handling at the point of use +(there's an extra level of indirection, i.e., (**v) to get at v's +value, rather than just (*v) .) When slurping in an interface file we +then record whether it's coming from a .hi corresponding to a module +that's packaged up in a DLL or not, so that we later can emit the appropriate code. -The logic for how an interface file is marked as corresponding to a module that's -hiding in a DLL is explained elsewhere (ToDo: give renamer href here.) +The logic for how an interface file is marked as corresponding to a +module that's hiding in a DLL is explained elsewhere (ToDo: give +renamer href here.) \begin{code} -data DllFlavour = NotDll -- Ordinary module - | Dll -- The module's object code lives in a DLL. - deriving( Eq ) +data Module = Module ModuleName PackageInfo -dll = Dll -notDll = NotDll +data PackageInfo + = ThisPackage -- A module from the same package + -- as the one being compiled + | AnotherPackage PackageName -- A module from a different package -instance Text DllFlavour where -- Just used in debug prints of lex tokens - showsPrec n NotDll s = s - showsPrec n Dll s = "dll " ++ s -\end{code} + | DunnoYet -- This is used when we don't yet know + -- Main case: we've come across Foo.x in an interface file + -- but we havn't yet opened Foo.hi. We need a Name for Foo.x + -- Later on (in RnEnv.newTopBinder) we'll update the cache + -- to have the right PackageName +type PackageName = FastString -- No encoding at all -%************************************************************************ -%* * -\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. +preludePackage :: PackageName +preludePackage = SLIT("std") -\begin{code} -data ModFlavour = LibMod -- A library-ish module - | UserMod -- Not library-ish +packageInfoPackage :: PackageInfo -> PackageName +packageInfoPackage ThisPackage = opt_InPackage +packageInfoPackage DunnoYet = SLIT("") +packageInfoPackage (AnotherPackage p) = p -libMod = LibMod -userMod = UserMod +instance Outputable PackageInfo where + -- Just used in debug prints of lex tokens and in debug modde + ppr pkg_info = ppr (packageInfoPackage pkg_info) \end{code} @@ -124,6 +141,9 @@ data WhereFrom = ImportByUser -- Ordinary user import: look for M.hi | ImportBySystem -- Non user import. Look for M.hi if M is in -- the module this module depends on, or is a system-ish module; -- M.hi-boot otherwise + | ImportByCmdLine -- The user typed a qualified name at + -- the GHCi prompt, try to demand-load + -- the interface. instance Outputable WhereFrom where ppr ImportByUser = empty @@ -139,253 +159,196 @@ instance Outputable WhereFrom where %************************************************************************ \begin{code} -type ModuleName = EncodedFS +newtype ModuleName = ModuleName EncodedFS -- Haskell module names can include the quote character ', -- so the module names have the z-encoding applied to them +instance Uniquable ModuleName where + getUnique (ModuleName nm) = getUnique nm + +instance Eq ModuleName where + nm1 == nm2 = getUnique nm1 == getUnique nm2 + +-- Warning: gives an ordering relation based on the uniques of the +-- FastStrings which are the (encoded) module names. This is _not_ +-- a lexicographical ordering. +instance Ord ModuleName where + nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2 + +instance Outputable ModuleName where + ppr = pprModuleName + pprModuleName :: ModuleName -> SDoc -pprModuleName nm = pprEncodedFS nm +pprModuleName (ModuleName nm) = pprEncodedFS nm + +moduleNameFS :: ModuleName -> EncodedFS +moduleNameFS (ModuleName mod) = mod moduleNameString :: ModuleName -> EncodedString -moduleNameString mod = _UNPK_ mod +moduleNameString (ModuleName mod) = _UNPK_ mod moduleNameUserString :: ModuleName -> UserString -moduleNameUserString mod = decode (_UNPK_ mod) +moduleNameUserString (ModuleName mod) = decode (_UNPK_ mod) -mkSrcModule :: UserString -> ModuleName -mkSrcModule s = _PK_ (encode s) +-- used to be called mkSrcModule +mkModuleName :: UserString -> ModuleName +mkModuleName s = ModuleName (_PK_ (encode s)) -mkSrcModuleFS :: UserFS -> ModuleName -mkSrcModuleFS s = encodeFS s +-- used to be called mkSrcModuleFS +mkModuleNameFS :: UserFS -> ModuleName +mkModuleNameFS s = ModuleName (encodeFS s) -mkSysModuleFS :: EncodedFS -> ModuleName -mkSysModuleFS s = s -\end{code} - -\begin{code} -data Module = Module - ModuleName - ModFlavour - DllFlavour +-- used to be called mkSysModuleFS +mkSysModuleNameFS :: EncodedFS -> ModuleName +mkSysModuleNameFS s = ModuleName s \end{code} \begin{code} instance Outputable Module where ppr = pprModule +instance Uniquable Module where + getUnique (Module nm _) = getUnique nm + +-- Same if they have the same name. instance Eq Module where - (Module m1 _ _) == (Module m2 _ _) = m1 == m2 + m1 == m2 = getUnique m1 == getUnique m2 +-- Warning: gives an ordering relation based on the uniques of the +-- FastStrings which are the (encoded) module names. This is _not_ +-- a lexicographical ordering. instance Ord Module where - (Module m1 _ _) `compare` (Module m2 _ _) = m1 `compare` m2 + m1 `compare` m2 = getUnique m1 `compare` getUnique m2 \end{code} \begin{code} pprModule :: Module -> SDoc -pprModule (Module mod _ _) = pprEncodedFS mod +pprModule (Module mod p) = getPprStyle $ \ sty -> + if debugStyle sty then + -- Print the package too + ppr p <> dot <> pprModuleName mod + else + pprModuleName mod \end{code} \begin{code} -mkModule = Module +mkModule :: ModuleName -- Name of the module + -> PackageName + -> Module +mkModule mod_nm pack_name + = Module mod_nm pack_info + where + pack_info | pack_name == opt_InPackage = ThisPackage + | otherwise = AnotherPackage pack_name + +mkHomeModule :: ModuleName -> Module +mkHomeModule mod_nm = Module mod_nm ThisPackage +isHomeModule :: Module -> Bool +isHomeModule (Module nm ThisPackage) = True +isHomeModule _ = False + +-- Used temporarily when we first come across Foo.x in an interface +-- file, but before we've opened Foo.hi. +-- (Until we've opened Foo.hi we don't know what the Package is.) mkVanillaModule :: ModuleName -> Module -mkVanillaModule name = Module name UserMod NotDll +mkVanillaModule name = Module name DunnoYet -mkThisModule :: ModuleName -> Module -- The module being comiled -mkThisModule name = Module name UserMod NotDll -- ToDo: correct Dll flag? +isVanillaModule :: Module -> Bool +isVanillaModule (Module nm DunnoYet) = True +isVanillaModule _ = False mkPrelModule :: ModuleName -> Module -mkPrelModule name = Module name sys dll - where - sys | opt_CompilingPrelude = UserMod - | otherwise = LibMod +mkPrelModule name = mkModule name preludePackage - dll | opt_Static || opt_CompilingPrelude = NotDll - | otherwise = Dll +isPrelModule :: Module -> Bool +isPrelModule (Module nm (AnotherPackage p)) | p == preludePackage = True +isPrelModule _ = False moduleString :: Module -> EncodedString -moduleString (Module mod _ _) = _UNPK_ mod +moduleString (Module (ModuleName fs) _) = _UNPK_ fs moduleName :: Module -> ModuleName -moduleName (Module mod _ _) = mod +moduleName (Module mod pkg_info) = mod -moduleUserString :: Module -> UserString -moduleUserString (Module mod _ _) = moduleNameUserString mod -\end{code} +modulePackage :: Module -> PackageName +modulePackage (Module mod pkg_info) = packageInfoPackage pkg_info -\begin{code} -isDynamicModule :: Module -> Bool -isDynamicModule (Module _ _ Dll) = True -isDynamicModule _ = False +moduleUserString :: Module -> UserString +moduleUserString (Module mod _) = moduleNameUserString mod -isLibModule :: Module -> Bool -isLibModule (Module _ LibMod _) = True -isLibModule _ = False +printModulePrefix :: Module -> Bool + -- When printing, say M.x +printModulePrefix (Module nm ThisPackage) = False +printModulePrefix _ = True \end{code} %************************************************************************ -%* * -\subsection{Finding modules in the file system -%* * +%* * +\subsection{@ModuleEnv@s} +%* * %************************************************************************ \begin{code} -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 +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 +lookupModuleEnvByName:: ModuleEnv a -> ModuleName -> Maybe a +lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a +elemModuleEnv :: Module -> ModuleEnv a -> Bool +foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b + +elemModuleEnv = elemUFM +extendModuleEnv = addToUFM +extendModuleEnv_C = addToUFM_C +extendModuleEnvList = addListToUFM +plusModuleEnv_C = plusUFM_C +delModuleEnvList = delListFromUFM +delModuleEnv = delFromUFM +plusModuleEnv = plusUFM +lookupModuleEnv = lookupUFM +lookupModuleEnvByName = lookupUFM +lookupWithDefaultModuleEnv = lookupWithDefaultUFM +mapModuleEnv = mapUFM +mkModuleEnv = listToUFM +emptyModuleEnv = emptyUFM +moduleEnvElts = eltsUFM +unitModuleEnv = unitUFM +isEmptyModuleEnv = isNullUFM +foldModuleEnv = foldUFM \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. -\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)] +type ModuleSet = UniqSet Module +mkModuleSet :: [Module] -> ModuleSet +extendModuleSet :: ModuleSet -> Module -> ModuleSet +emptyModuleSet :: ModuleSet +moduleSetElts :: ModuleSet -> [Module] +elemModuleSet :: Module -> ModuleSet -> Bool + +emptyModuleSet = emptyUniqSet +mkModuleSet = mkUniqSet +extendModuleSet = addOneToUniqSet +moduleSetElts = uniqSetToList +elemModuleSet = elementOfUniqSet \end{code} -