X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FModule.lhs;h=2650e2e53782392cecbfadd12a8bd84678cdb8e1;hb=bb91427f27c940e4dd0fc6c7360e7ef61264b240;hp=cf86c1ce8998a15d6a58a1891447b81dc7a3e4e0;hpb=c8a3ddcbd6624db585d6d4f9fe9d7e51527db2db;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index cf86c1c..2650e2e 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -21,9 +21,9 @@ module Module , mkVanillaModule -- :: ModuleName -> Module , mkThisModule -- :: ModuleName -> Module , mkPrelModule -- :: UserString -> Module - - , isDynamicModule -- :: Module -> Bool - , isLibModule + , mkModule -- :: ModuleName -> PackageName -> Module + + , isLocalModule -- :: Module -> Bool , mkSrcModule @@ -32,11 +32,7 @@ module Module , pprModule, pprModuleName - -- DllFlavour - , DllFlavour, dll, notDll - - -- ModFlavour - , ModFlavour, libMod, userMod + , PackageName -- Where to find a .hi file , WhereFrom(..), SearchPath, mkSearchPath @@ -48,7 +44,7 @@ module Module import OccName import Outputable import FiniteMap -import CmdLineOpts ( opt_Static, opt_CompilingPrelude, opt_WarnHiShadows, opt_HiMapSep ) +import CmdLineOpts ( opt_Static, opt_InPackage, opt_WarnHiShadows, opt_HiMapSep ) import Constants ( interfaceFileFormatVersion ) import Maybes ( seqMaybe ) import Maybe ( fromMaybe ) @@ -57,6 +53,7 @@ import DirUtils ( getDirectoryContents ) import List ( intersperse ) import Monad ( foldM ) import IO ( hPutStrLn, stderr, isDoesNotExistError ) +import FastString ( FastString ) \end{code} @@ -78,16 +75,19 @@ The logic for how an interface file is marked as corresponding to a module that' 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 PackageInfo = ThisPackage -- A module from the same package + -- as the one being compiled + | AnotherPackage PackageName -- A module from a different package + +type PackageName = FastString -- No encoding at all -dll = Dll -notDll = NotDll +preludePackage :: PackageName +preludePackage = SLIT("std") -instance Text DllFlavour where -- Just used in debug prints of lex tokens - showsPrec n NotDll s = s - showsPrec n Dll s = "dll " ++ s +instance Show PackageInfo where -- Just used in debug prints of lex tokens + -- and in debug modde + showsPrec n ThisPackage s = "" ++ s + showsPrec n (AnotherPackage p) s = (_UNPK_ p) ++ s \end{code} @@ -101,12 +101,14 @@ We also track whether an imported module is from a 'system-ish' place. In this 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 = LibMod -- A library-ish module +data ModFlavour = PrelMod -- A Prelude module | UserMod -- Not library-ish - -libMod = LibMod -userMod = UserMod \end{code} @@ -143,7 +145,6 @@ type ModuleName = EncodedFS -- Haskell module names can include the quote character ', -- so the module names have the z-encoding applied to them - pprModuleName :: ModuleName -> SDoc pprModuleName nm = pprEncodedFS nm @@ -164,10 +165,7 @@ mkSysModuleFS s = s \end{code} \begin{code} -data Module = Module - ModuleName - ModFlavour - DllFlavour +data Module = Module ModuleName PackageInfo \end{code} \begin{code} @@ -175,55 +173,60 @@ instance Outputable Module where ppr = pprModule instance Eq Module where - (Module m1 _ _) == (Module m2 _ _) = m1 == m2 + (Module m1 _) == (Module m2 _) = m1 == m2 instance Ord Module where - (Module m1 _ _) `compare` (Module m2 _ _) = m1 `compare` m2 + (Module m1 _) `compare` (Module m2 _) = m1 `compare` 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 + text (show 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 mkVanillaModule :: ModuleName -> Module -mkVanillaModule name = Module name UserMod NotDll +mkVanillaModule name = Module name ThisPackage + -- 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 PackageInfo is.) -mkThisModule :: ModuleName -> Module -- The module being comiled -mkThisModule name = Module name UserMod NotDll -- ToDo: correct Dll flag? +mkThisModule :: ModuleName -> Module -- The module being compiled +mkThisModule name = Module name ThisPackage mkPrelModule :: ModuleName -> Module -mkPrelModule name = Module name sys dll - where - sys | opt_CompilingPrelude = UserMod - | otherwise = LibMod - - dll | opt_Static || opt_CompilingPrelude = NotDll - | otherwise = Dll +mkPrelModule name = mkModule name preludePackage moduleString :: Module -> EncodedString -moduleString (Module mod _ _) = _UNPK_ mod +moduleString (Module mod _) = _UNPK_ mod moduleName :: Module -> ModuleName -moduleName (Module mod _ _) = mod +moduleName (Module mod _) = mod moduleUserString :: Module -> UserString -moduleUserString (Module mod _ _) = moduleNameUserString mod +moduleUserString (Module mod _) = moduleNameUserString mod \end{code} \begin{code} -isDynamicModule :: Module -> Bool -isDynamicModule (Module _ _ Dll) = True -isDynamicModule _ = False - -isLibModule :: Module -> Bool -isLibModule (Module _ LibMod _) = True -isLibModule _ = False +isLocalModule :: Module -> Bool +isLocalModule (Module _ ThisPackage) = True +isLocalModule _ = False \end{code} @@ -234,10 +237,10 @@ isLibModule _ = False %************************************************************************ \begin{code} -type ModuleHiMap = FiniteMap ModuleName (String, Module) +type ModuleHiMap = FiniteMap ModuleName String -- Mapping from module name to -- * the file path of its corresponding interface file, - -- * the Module, decorated with it's properties + -- * the ModuleName \end{code} (We allege that) it is quicker to build up a mapping from module names @@ -249,22 +252,12 @@ do quite a lot of.) 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 +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 -{- 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) @@ -272,16 +265,8 @@ getAllFilesMatching :: SearchPath 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 + return (foldl addModules hims fpaths)) + -- soft failure `catch` (\ err -> do hPutStrLn stderr @@ -294,12 +279,6 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do 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 [] -> [] @@ -310,7 +289,7 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do 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 $ + 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` @@ -330,7 +309,7 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do 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) + = addToFM_C combiner env mod_nm path where mod_nm = mkSrcModuleFS file_nm @@ -346,15 +325,15 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do stickWithOld old new = old overrideNew old new = new - conflict (old_path,mod) (new_path,_) + 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,mod) - | otherwise = (old_path,mod) -- don't warn about innocous shadowings. + old_path + | otherwise = old_path -- don't warn about innocous shadowings. \end{code}