From 977e13bf2f6218c6c4f651ff563959dc736674fa Mon Sep 17 00:00:00 2001 From: sewardj Date: Thu, 12 Oct 2000 10:32:41 +0000 Subject: [PATCH] [project @ 2000-10-12 10:32:40 by sewardj] Changes to do with making Module and ModuleName into Uniquables. --- ghc/compiler/basicTypes/Module.lhs | 64 +++++++++++++++++++++++------------- ghc/compiler/ghci/CmStaticInfo.lhs | 4 +-- ghc/compiler/ghci/CmSummarise.lhs | 55 +++++++++++++++---------------- 3 files changed, 71 insertions(+), 52 deletions(-) diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 92d3cee..2fd7c87 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -21,7 +21,8 @@ in a different DLL, by setting the DLL flag. \begin{code} module Module ( - Module -- abstract, instance of Eq, Ord, Outputable + Module, mod_name, mod_kind + -- abstract, instance of Eq, Ord, Outputable , ModuleName , ModuleKind(..) , isPackageKind @@ -40,12 +41,13 @@ module Module -- , isLocalModule -- :: Module -> Bool - , mkSrcModule +-- , mkSrcModule - , mkSrcModuleFS -- :: UserFS -> ModuleName - , mkSysModuleFS -- :: EncodedFS -> ModuleName + , mkModuleName -- :: UserString -> ModuleName + , mkModuleNameFS -- :: UserFS -> ModuleName + , mkSysModuleNameFS -- :: EncodedFS -> ModuleName - , pprModule, pprModuleName + , pprModule, , PackageName @@ -137,35 +139,53 @@ 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) = mkUniqueGrimily (uniqueOfFS 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 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 +-- used to be called mkSysModuleFS +mkSysModuleNameFS :: EncodedFS -> ModuleName +mkSysModuleNameFS s = ModuleName s \end{code} \begin{code} -data Module - = Module { - mod_name :: ModuleName, - mod_kind :: ModuleKind - } +data Module = Module ModuleName ModuleKind + +mod_name (Module nm kind) = nm +mod_kind (Module nm kind) = kind \end{code} \begin{code} @@ -173,7 +193,7 @@ instance Outputable Module where ppr = pprModule instance Uniquable Module where - getUnique (Module nm _) = mkUniqueGrimily (uniqueOfFS nm) + getUnique (Module nm _) = getUnique nm -- Same if they have the same name. instance Eq Module where @@ -226,7 +246,7 @@ mkModule = Module --mkPrelModule name = mkModule name preludePackage moduleString :: Module -> EncodedString -moduleString (Module mod _) = _UNPK_ mod +moduleString (Module (ModuleName fs) _) = _UNPK_ fs moduleName :: Module -> ModuleName moduleName (Module mod _) = mod diff --git a/ghc/compiler/ghci/CmStaticInfo.lhs b/ghc/compiler/ghci/CmStaticInfo.lhs index e5b32b1..6a4d00b 100644 --- a/ghc/compiler/ghci/CmStaticInfo.lhs +++ b/ghc/compiler/ghci/CmStaticInfo.lhs @@ -13,7 +13,7 @@ import List ( nub ) import Char ( isUpper ) import Directory ( getDirectoryContents ) -import Module ( ModuleName, PackageName ) +import Module ( ModuleName, mkModuleName, PackageName ) \end{code} \begin{code} @@ -63,7 +63,7 @@ mk_module_table raw_info return iface_table where fsifyStrings (mod_str, pkg_str, path_str) - = (_PK_ mod_str, _PK_ pkg_str, path_str) + = (mkModuleName mod_str, _PK_ pkg_str, path_str) -- nm_and_paths :: Package -> [(PkgName,Path)] nm_and_paths package = [(name package, path) | path <- nub (import_dirs package)] diff --git a/ghc/compiler/ghci/CmSummarise.lhs b/ghc/compiler/ghci/CmSummarise.lhs index cc966f0..00c0eec 100644 --- a/ghc/compiler/ghci/CmSummarise.lhs +++ b/ghc/compiler/ghci/CmSummarise.lhs @@ -15,14 +15,15 @@ where import List ( nub ) import Char ( ord, isAlphaNum ) -import CmFind ( ModName, ModLocation(..), ml_modname ) +import Module ( Module, mod_name, mod_kind, + ModuleName, mkModuleName, ModuleKind(..) ) import Outputable \end{code} \begin{code} --- The ModLocation contains the original source filename of the module. +-- The Module contains the original source filename of the module. -- The ms_ppsource field contains another filename, which is intended to -- be the cleaned-up source file after all preprocessing has happened to -- it. The point is that the summariser will have to cpp/unlit/whatever @@ -31,7 +32,7 @@ import Outputable -- and let @compile@ read from that file on the way back up. data ModSummary = ModSummary { - ms_loc :: ModLocation, -- location and kind + ms_mod :: Module, -- location and kind ms_ppsource :: (Maybe (FilePath, Fingerprint)), -- preprocessed and sig if .hs ms_imports :: (Maybe [ModImport]) -- imports if .hs or .hi } @@ -39,7 +40,7 @@ data ModSummary instance Outputable ModSummary where ppr ms = sep [text "ModSummary {", - nest 3 (sep [text "ms_loc =" <+> ppr (ms_loc ms), + nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms), text "ms_ppsource =" <+> fooble (ms_ppsource ms), text "ms_imports=" <+> ppr (ms_imports ms)]), char '}' @@ -51,21 +52,21 @@ instance Outputable ModSummary where <+> text (show cppd_source_name) <> text ")" data ModImport - = MINormal ModName | MISource ModName + = MINormal ModuleName | MISource ModuleName deriving Eq instance Outputable ModImport where - ppr (MINormal nm) = text nm - ppr (MISource nm) = text "{-# SOURCE #-}" <+> text nm + ppr (MINormal nm) = ppr nm + ppr (MISource nm) = text "{-# SOURCE #-}" <+> ppr nm mi_name (MINormal nm) = nm mi_name (MISource nm) = nm -name_of_summary :: ModSummary -> ModName -name_of_summary = ml_modname . ms_loc +name_of_summary :: ModSummary -> ModuleName +name_of_summary = mod_name . ms_mod -deps_of_summary :: ModSummary -> [ModName] +deps_of_summary :: ModSummary -> [ModuleName] deps_of_summary = map mi_name . ms_get_imports ms_get_imports :: ModSummary -> [ModImport] @@ -74,24 +75,21 @@ ms_get_imports summ type Fingerprint = Int -summarise :: ModLocation -> IO ModSummary - -summarise loc - = case loc of - InPackage mod path -- if in a package, investigate no further - -> return (ModSummary loc Nothing Nothing) - SourceOnly mod path -- source; read, cache and get imports +summarise :: Module -> IO ModSummary +summarise mod + = case mod_kind mod of + InPackage path -- if in a package, investigate no further + -> return (ModSummary mod Nothing Nothing) + SourceOnly path -- source; read, cache and get imports -> readFile path >>= \ modsrc -> let imps = getImports modsrc fp = fingerprint modsrc - in return (ModSummary loc (Just (path,fp)) (Just imps)) - ObjectCode mod oPath hiPath -- can we get away with the src summariser - -- for interface files? + in return (ModSummary mod (Just (path,fp)) (Just imps)) + ObjectCode oPath hiPath -- can we get away with the src summariser + -- for interface files? -> readFile hiPath >>= \ hisrc -> let imps = getImports hisrc - in return (ModSummary loc Nothing (Just imps)) - NotFound - -> pprPanic "summarise:NotFound" (ppr loc) + in return (ModSummary mod Nothing (Just imps)) fingerprint :: String -> Int fingerprint s @@ -123,17 +121,18 @@ gmiBase s where f ("foreign" : "import" : ws) = f ws f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws) - = MISource (takeWhile isModId m) : f ws + = MISource (mkMN m) : f ws f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws) - = MISource (takeWhile isModId m) : f ws + = MISource (mkMN m) : f ws f ("import" : "qualified" : m : ws) - = MINormal (takeWhile isModId m) : f ws + = MINormal (mkMN m) : f ws f ("import" : m : ws) - = MINormal (takeWhile isModId m) : f ws + = MINormal (mkMN m) : f ws f (w:ws) = f ws f [] = [] -isModId c = isAlphaNum c || c `elem` "'_" + mkMN str = mkModuleName (takeWhile isModId str) + isModId c = isAlphaNum c || c `elem` "'_" -- remove literals and comments from a string clean :: String -> String -- 1.7.10.4