From: sewardj Date: Thu, 12 Oct 2000 09:56:52 +0000 (+0000) Subject: [project @ 2000-10-12 09:56:52 by sewardj] X-Git-Tag: Approximately_9120_patches~3626 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a1cd15d30fb22dc5a315342ccaeb5b3eef1aa32f;p=ghc-hetmet.git [project @ 2000-10-12 09:56:52 by sewardj] Rationalise Module/PackageInfo/ModLocation mess. Now we just have Module and ModuleKind. --- diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 0cc8d16..92d3cee 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -23,6 +23,8 @@ module Module ( Module -- abstract, instance of Eq, Ord, Outputable , ModuleName + , ModuleKind(..) + , isPackageKind , moduleNameString -- :: ModuleName -> EncodedString , moduleNameUserString -- :: ModuleName -> UserString @@ -31,12 +33,12 @@ module Module , moduleUserString -- :: Module -> UserString , moduleName -- :: Module -> ModuleName - , mkVanillaModule -- :: ModuleName -> Module - , mkThisModule -- :: ModuleName -> Module - , mkPrelModule -- :: UserString -> Module - , mkModule -- :: ModuleName -> PackageName -> Module +-- , mkVanillaModule -- :: ModuleName -> Module +-- , mkThisModule -- :: ModuleName -> Module +-- , mkPrelModule -- :: UserString -> Module + , mkModule -- :: ModuleName -> ModuleKind -> Module - , isLocalModule -- :: Module -> Bool +-- , isLocalModule -- :: Module -> Bool , mkSrcModule @@ -56,7 +58,8 @@ module Module import OccName import Outputable import CmdLineOpts ( opt_InPackage ) -import FastString ( FastString ) +import FastString ( FastString, uniqueOfFS ) +import Unique ( Uniquable(..), mkUniqueGrimily ) \end{code} @@ -77,20 +80,31 @@ 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.) +@SourceOnly@ and @ObjectCode@ indicate a module from the same package +as the one being compiled, i.e. a home module. @InPackage@ means one +from a different package. + \begin{code} -data PackageInfo = ThisPackage -- A module from the same package - -- as the one being compiled - | AnotherPackage PackageName -- A module from a different package +data ModuleKind + = SourceOnly FilePath -- .hs + | ObjectCode FilePath FilePath -- .o, .hi + | InPackage PackageName + +isPackageKind (InPackage _) = True +isPackageKind _ = False type PackageName = FastString -- No encoding at all preludePackage :: PackageName preludePackage = SLIT("std") -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 +instance Outputable ModuleKind where + ppr (SourceOnly path_hs) + = text "SourceOnly" <+> text (show path_hs) + ppr (ObjectCode path_o path_hi) + = text "ObjectCode" <+> text (show path_o) <+> text (show path_hi) + ppr (InPackage pkgname) + = text "InPackage" <+> text (show pkgname) \end{code} @@ -147,18 +161,29 @@ mkSysModuleFS s = s \end{code} \begin{code} -data Module = Module ModuleName PackageInfo +data Module + = Module { + mod_name :: ModuleName, + mod_kind :: ModuleKind + } \end{code} \begin{code} instance Outputable Module where ppr = pprModule +instance Uniquable Module where + getUnique (Module nm _) = mkUniqueGrimily (uniqueOfFS 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} @@ -167,34 +192,38 @@ pprModule :: Module -> SDoc pprModule (Module mod p) = getPprStyle $ \ sty -> if debugStyle sty then -- Print the package too - text (show p) <> dot <> pprModuleName mod + ppr p <> dot <> pprModuleName mod else pprModuleName mod \end{code} \begin{code} -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 ThisPackage +mkModule :: ModuleName -> ModuleKind -> Module +mkModule = Module +-- I don't think anybody except the Finder should ever try to create a +-- Module now, so this lot commented out pro tem (JRS) +--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 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 compiled -mkThisModule name = Module name ThisPackage +--mkThisModule :: ModuleName -> Module -- The module being compiled +--mkThisModule name = Module name ThisPackage -mkPrelModule :: ModuleName -> Module -mkPrelModule name = mkModule name preludePackage +--mkPrelModule :: ModuleName -> Module +--mkPrelModule name = mkModule name preludePackage moduleString :: Module -> EncodedString moduleString (Module mod _) = _UNPK_ mod @@ -207,7 +236,7 @@ moduleUserString (Module mod _) = moduleNameUserString mod \end{code} \begin{code} -isLocalModule :: Module -> Bool -isLocalModule (Module _ ThisPackage) = True -isLocalModule _ = False +--isLocalModule :: Module -> Bool +--isLocalModule (Module _ ThisPackage) = True +--isLocalModule _ = False \end{code} diff --git a/ghc/compiler/ghci/CmFind.lhs b/ghc/compiler/ghci/CmFind.lhs index 7206447..ec4a250 100644 --- a/ghc/compiler/ghci/CmFind.lhs +++ b/ghc/compiler/ghci/CmFind.lhs @@ -4,8 +4,7 @@ \section[CmFind]{Module finder for GHCI} \begin{code} -module CmFind ( ModLocation(..), ml_modname, isPackageLoc, - Finder, newFinder ) +module CmFind ( Finder, newFinder ) where #include "HsVersions.h" @@ -17,38 +16,13 @@ import Time ( ClockTime ) import Directory ( doesFileExist, getModificationTime ) import Outputable -import Module ( Module, ModuleName, PackageName, - moduleNameUserString ) +import Module ( Module, ModuleName, ModuleKind(..), PackageName, + mkModule, moduleNameUserString ) import CmStaticInfo ( Package(..), PackageConfigInfo(..) ) \end{code} \begin{code} --- make a product type, with Maybe return --> Module,lhs -data ModLocation - = SourceOnly ModuleName FilePath -- .hs - | ObjectCode ModuleName FilePath FilePath -- .o, .hi - | InPackage ModuleName PackageName - | NotFound - -instance Outputable ModLocation where - ppr (SourceOnly nm path_hs) - = hsep [text "SourceOnly", text (show nm), text (show path_hs)] - ppr (ObjectCode nm path_o path_hi) - = hsep [text "ObjectCode", text (show nm), - text (show path_o), text (show path_hi)] - ppr (InPackage nm pkgname) - = hsep [text "InPackage", text (show nm), text (show pkgname)] - - - -type Finder = ModuleName -> IO ModLocation - -ml_modname (SourceOnly nm _) = nm -ml_modname (ObjectCode nm _ _) = nm -ml_modname (InPackage nm _) = nm - -isPackageLoc (InPackage _ _) = True -isPackageLoc _ = False +type Finder = ModuleName -> IO (Maybe Module) mkFinder :: [(ModuleName,PackageName,FilePath)] -> [FilePath] -> Finder mkFinder pkg_ifaces home_dirs modnm @@ -63,31 +37,32 @@ mkFinderX pkg_ifaces home_dirs modnm -- If the module exists both as package and home, emit a warning -- and (arbitrarily) choose the user's one. = do home_maybe_found <- mapM (homeModuleExists modnm) home_dirs - :: IO [Maybe (ModLocation, ClockTime)] + :: IO [Maybe (Module, ClockTime)] case (in_package, catMaybes home_maybe_found) of ([], []) - -> return NotFound + -> return Nothing ([], locs_n_times@(_:_)) - -> return (homeMod locs_n_times) + -> return (Just (homeMod locs_n_times)) ((pkgname,path):_, []) - -> return (InPackage modnm pkgname) + -> return (Just (mkModule modnm (InPackage pkgname))) (packages, locs_n_times) - -> do --hPutStr stderr ( "GHCI: warning: module `" ++ modnm ++ - -- "' appears as both a home and package module\n") - return (homeMod locs_n_times) + -> do hPutStr stderr ( "GHCI: warning: module `" + ++ moduleNameUserString modnm + ++ "' appears as both a home and package module\n") + return (Just (homeMod locs_n_times)) where in_package = [(pkgname,path) | (modname,pkgname,path) <- pkg_ifaces, modname == modnm] - homeMod :: [(ModLocation, ClockTime)] -> ModLocation + homeMod :: [(Module, ClockTime)] -> Module homeMod locs_n_times = fst (maximumBy (\lt1 lt2 -> if snd lt1 > snd lt2 then lt1 else lt2) locs_n_times) -- See if a .hs or (.hi, .o) pair exist on the given path, --- and return a ModLocation for whichever is younger -homeModuleExists :: ModuleName -> FilePath -> IO (Maybe (ModLocation, ClockTime)) +-- and return a Module for whichever is younger +homeModuleExists :: ModuleName -> FilePath -> IO (Maybe (Module, ClockTime)) homeModuleExists modname path = do m_ths <- maybeTime nm_hs m_thi <- maybeTime nm_hi @@ -102,8 +77,10 @@ homeModuleExists modname path (Nothing, _, _) -> Nothing ) where - object thi to = Just (ObjectCode modname nm_o nm_hi, max thi to) - source ths = Just (SourceOnly modname nm_hs, ths) + object thi to = Just (mkModule modname (ObjectCode nm_o nm_hi), + max thi to) + source ths = Just (mkModule modname (SourceOnly nm_hs), + ths) nm = path ++ "/" ++ moduleNameUserString modname nm_hs = nm ++ ".hs" nm_hi = nm ++ ".hi"