From 8ba124fc8acf8e71849610df41d6bd94153cabab Mon Sep 17 00:00:00 2001 From: sewardj Date: Thu, 12 Oct 2000 11:32:34 +0000 Subject: [PATCH] [project @ 2000-10-12 11:32:33 by sewardj] Propagate recent changes in module/Module.lhs. --- ghc/compiler/basicTypes/Module.lhs | 46 +++++++++++++--------------- ghc/compiler/basicTypes/RdrName.lhs | 10 +++--- ghc/compiler/hsSyn/HsImpExp.lhs | 8 ++--- ghc/compiler/hsSyn/HsSyn.lhs | 4 +-- ghc/compiler/prelude/PrelNames.lhs | 54 ++++++++++++++++----------------- ghc/compiler/profiling/CostCentre.lhs | 10 +++--- 6 files changed, 64 insertions(+), 68 deletions(-) diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 312b381..7a4e91d 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -25,21 +25,20 @@ module Module -- abstract, instance of Eq, Ord, Outputable , ModuleName , ModuleKind(..) - , isPackageKind + , isLocalModuleKind , moduleNameString -- :: ModuleName -> EncodedString , moduleNameUserString -- :: ModuleName -> UserString - , moduleString -- :: Module -> EncodedString - , moduleUserString -- :: Module -> UserString - , moduleName -- :: Module -> ModuleName + , moduleString -- :: Module -> EncodedString + , moduleUserString -- :: Module -> UserString + , moduleName -- :: Module -> ModuleName --- , mkVanillaModule -- :: ModuleName -> Module + , mkVanillaModule -- :: ModuleName -> Module -- , mkThisModule -- :: ModuleName -> Module --- , mkPrelModule -- :: UserString -> Module - , mkModule -- :: ModuleName -> ModuleKind -> Module - --- , isLocalModule -- :: Module -> Bool + , mkPrelModule -- :: UserString -> Module + , mkModule -- :: ModuleName -> ModuleKind -> Module + , isLocalModule -- :: Module -> Bool -- , mkSrcModule @@ -99,13 +98,13 @@ data ModuleKind | ObjectCode FilePath FilePath -- .o, .hi | InPackage PackageName -isPackageKind (InPackage _) = True -isPackageKind _ = False +isLocalModuleKind (InPackage _) = False +isLocalModuleKind _ = True type PackageName = FastString -- No encoding at all -preludePackage :: PackageName -preludePackage = SLIT("std") +preludePackage :: ModuleKind +preludePackage = InPackage SLIT("std") instance Outputable ModuleKind where ppr (SourceOnly path_hs) @@ -240,17 +239,17 @@ mkModule = Module -- | 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.) +-- 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.) +mkVanillaModule :: ModuleName -> Module +mkVanillaModule name = Module name (panic "mkVanillaModule:unknown mod_kind field") --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 = Module name preludePackage moduleString :: Module -> EncodedString moduleString (Module (ModuleName fs) _) = _UNPK_ fs @@ -260,12 +259,9 @@ moduleName (Module mod _) = mod moduleUserString :: Module -> UserString moduleUserString (Module mod _) = moduleNameUserString mod -\end{code} -\begin{code} ---isLocalModule :: Module -> Bool ---isLocalModule (Module _ ThisPackage) = True ---isLocalModule _ = False +isLocalModule :: Module -> Bool +isLocalModule (Module nm kind) = isLocalModuleKind kind \end{code} %************************************************************************ diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs index 5c0fc0a..4644c79 100644 --- a/ghc/compiler/basicTypes/RdrName.lhs +++ b/ghc/compiler/basicTypes/RdrName.lhs @@ -36,8 +36,8 @@ import OccName ( NameSpace, tcName, mkSrcOccFS, mkSrcVarOcc, isDataOcc, isTvOcc, mkWorkerOcc ) -import Module ( ModuleName, pprModuleName, - mkSysModuleFS, mkSrcModuleFS +import Module ( ModuleName, + mkSysModuleNameFS, mkModuleNameFS ) import FiniteMap import Outputable @@ -90,7 +90,7 @@ mkSrcUnqual :: NameSpace -> FAST_STRING -> RdrName mkSrcUnqual sp n = RdrName Unqual (mkSrcOccFS sp n) mkSrcQual :: NameSpace -> (UserFS, UserFS) -> RdrName -mkSrcQual sp (m, n) = RdrName (Qual (mkSrcModuleFS m)) (mkSrcOccFS sp n) +mkSrcQual sp (m, n) = RdrName (Qual (mkModuleNameFS m)) (mkSrcOccFS sp n) -- These two are used when parsing interface files -- They do not encode the module and occurrence name @@ -98,7 +98,7 @@ mkSysUnqual :: NameSpace -> FAST_STRING -> RdrName mkSysUnqual sp n = RdrName Unqual (mkSysOccFS sp n) mkSysQual :: NameSpace -> (FAST_STRING, FAST_STRING) -> RdrName -mkSysQual sp (m,n) = RdrName (Qual (mkSysModuleFS m)) (mkSysOccFS sp n) +mkSysQual sp (m,n) = RdrName (Qual (mkSysModuleNameFS m)) (mkSysOccFS sp n) mkPreludeQual :: NameSpace -> ModuleName -> FAST_STRING -> RdrName mkPreludeQual sp mod n = RdrName (Qual mod) (mkSrcOccFS sp n) @@ -144,7 +144,7 @@ instance Outputable RdrName where ppr (RdrName qual occ) = pp_qual qual <> ppr occ where pp_qual Unqual = empty - pp_qual (Qual mod) = pprModuleName mod <> dot + pp_qual (Qual mod) = ppr mod <> dot pprUnqualRdrName (RdrName qual occ) = ppr occ diff --git a/ghc/compiler/hsSyn/HsImpExp.lhs b/ghc/compiler/hsSyn/HsImpExp.lhs index 5ee9777..8f51b6d 100644 --- a/ghc/compiler/hsSyn/HsImpExp.lhs +++ b/ghc/compiler/hsSyn/HsImpExp.lhs @@ -8,7 +8,7 @@ module HsImpExp where #include "HsVersions.h" -import Module ( ModuleName, WhereFrom, pprModuleName ) +import Module ( ModuleName, WhereFrom ) import Outputable import SrcLoc ( SrcLoc ) \end{code} @@ -34,14 +34,14 @@ data ImportDecl name instance (Outputable name) => Outputable (ImportDecl name) where ppr (ImportDecl mod from qual as spec _) = hang (hsep [ptext SLIT("import"), ppr from, - pp_qual qual, pprModuleName mod, pp_as as]) + pp_qual qual, ppr mod, pp_as as]) 4 (pp_spec spec) where pp_qual False = empty pp_qual True = ptext SLIT("qualified") pp_as Nothing = empty - pp_as (Just a) = ptext SLIT("as ") <+> pprModuleName a + pp_as (Just a) = ptext SLIT("as ") <+> ppr a pp_spec Nothing = empty pp_spec (Just (False, spec)) @@ -88,6 +88,6 @@ instance (Outputable name) => Outputable (IE name) where ppr (IEThingWith thing withs) = ppr thing <> parens (fsep (punctuate comma (map ppr withs))) ppr (IEModuleContents mod) - = ptext SLIT("module") <+> pprModuleName mod + = ptext SLIT("module") <+> ppr mod \end{code} diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs index f0f7c94..ed94533 100644 --- a/ghc/compiler/hsSyn/HsSyn.lhs +++ b/ghc/compiler/hsSyn/HsSyn.lhs @@ -45,7 +45,7 @@ import BasicTypes ( Fixity, Version, NewOrData ) import Outputable import SrcLoc ( SrcLoc ) import Bag -import Module ( ModuleName, pprModuleName ) +import Module ( ModuleName ) \end{code} All we actually declare here is the top-level structure for a module. @@ -88,7 +88,7 @@ instance (Outputable name, Outputable pat) Nothing -> pp_modname <+> rest Just d -> vcat [ pp_modname, ppr d, rest ] - pp_modname = ptext SLIT("module") <+> pprModuleName name + pp_modname = ptext SLIT("module") <+> ppr name pp_nonnull [] = empty pp_nonnull xs = vcat (map ppr xs) diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index e1284ba..279a2c7 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -35,7 +35,7 @@ module PrelNames ( #include "HsVersions.h" -import Module ( ModuleName, mkPrelModule, mkSrcModule ) +import Module ( ModuleName, mkPrelModule, mkModuleName ) import OccName ( NameSpace, varName, dataName, tcName, clsName ) import RdrName ( RdrName, mkPreludeQual ) import UniqFM @@ -167,32 +167,32 @@ knownKeyRdrNames %************************************************************************ \begin{code} -pRELUDE_Name = mkSrcModule "Prelude" -pREL_GHC_Name = mkSrcModule "PrelGHC" -- Primitive types and values -pREL_BASE_Name = mkSrcModule "PrelBase" -pREL_ENUM_Name = mkSrcModule "PrelEnum" -pREL_SHOW_Name = mkSrcModule "PrelShow" -pREL_READ_Name = mkSrcModule "PrelRead" -pREL_NUM_Name = mkSrcModule "PrelNum" -pREL_LIST_Name = mkSrcModule "PrelList" -pREL_TUP_Name = mkSrcModule "PrelTup" -pREL_PACK_Name = mkSrcModule "PrelPack" -pREL_CONC_Name = mkSrcModule "PrelConc" -pREL_IO_BASE_Name = mkSrcModule "PrelIOBase" -pREL_ST_Name = mkSrcModule "PrelST" -pREL_ARR_Name = mkSrcModule "PrelArr" -pREL_BYTEARR_Name = mkSrcModule "PrelByteArr" -pREL_FOREIGN_Name = mkSrcModule "PrelForeign" -pREL_STABLE_Name = mkSrcModule "PrelStable" -pREL_ADDR_Name = mkSrcModule "PrelAddr" -pREL_ERR_Name = mkSrcModule "PrelErr" -pREL_REAL_Name = mkSrcModule "PrelReal" -pREL_FLOAT_Name = mkSrcModule "PrelFloat" - -pREL_MAIN_Name = mkSrcModule "PrelMain" -mAIN_Name = mkSrcModule "Main" -iNT_Name = mkSrcModule "Int" -wORD_Name = mkSrcModule "Word" +pRELUDE_Name = mkModuleName "Prelude" +pREL_GHC_Name = mkModuleName "PrelGHC" -- Primitive types and values +pREL_BASE_Name = mkModuleName "PrelBase" +pREL_ENUM_Name = mkModuleName "PrelEnum" +pREL_SHOW_Name = mkModuleName "PrelShow" +pREL_READ_Name = mkModuleName "PrelRead" +pREL_NUM_Name = mkModuleName "PrelNum" +pREL_LIST_Name = mkModuleName "PrelList" +pREL_TUP_Name = mkModuleName "PrelTup" +pREL_PACK_Name = mkModuleName "PrelPack" +pREL_CONC_Name = mkModuleName "PrelConc" +pREL_IO_BASE_Name = mkModuleName "PrelIOBase" +pREL_ST_Name = mkModuleName "PrelST" +pREL_ARR_Name = mkModuleName "PrelArr" +pREL_BYTEARR_Name = mkModuleName "PrelByteArr" +pREL_FOREIGN_Name = mkModuleName "PrelForeign" +pREL_STABLE_Name = mkModuleName "PrelStable" +pREL_ADDR_Name = mkModuleName "PrelAddr" +pREL_ERR_Name = mkModuleName "PrelErr" +pREL_REAL_Name = mkModuleName "PrelReal" +pREL_FLOAT_Name = mkModuleName "PrelFloat" + +pREL_MAIN_Name = mkModuleName "PrelMain" +mAIN_Name = mkModuleName "Main" +iNT_Name = mkModuleName "Int" +wORD_Name = mkModuleName "Word" pREL_GHC = mkPrelModule pREL_GHC_Name pREL_BASE = mkPrelModule pREL_BASE_Name diff --git a/ghc/compiler/profiling/CostCentre.lhs b/ghc/compiler/profiling/CostCentre.lhs index 15cd2af..9495140 100644 --- a/ghc/compiler/profiling/CostCentre.lhs +++ b/ghc/compiler/profiling/CostCentre.lhs @@ -32,7 +32,7 @@ import Name ( UserFS, EncodedFS, encodeFS, decode, getOccName, occNameFS ) import Module ( Module, ModuleName, moduleName, - pprModuleName, moduleNameUserString + moduleNameUserString ) import Outputable import CStrings ( pprStringInCStyle ) @@ -332,12 +332,12 @@ instance Outputable CostCentre where -- Printing in an interface file or in Core generally pprCostCentreCore (AllCafsCC {cc_mod = m}) - = text "__sccC" <+> braces (pprModuleName m) + = text "__sccC" <+> braces (ppr m) pprCostCentreCore (NormalCC {cc_name = n, cc_mod = m, cc_is_caf = caf, cc_is_dupd = dup}) = text "__scc" <+> braces (hsep [ ptext n, - pprModuleName m, + ppr m, pp_dup dup, pp_caf caf ]) @@ -351,9 +351,9 @@ pp_caf other = empty -- Printing as a C label ppCostCentreLbl (NoCostCentre) = text "NONE_cc" -ppCostCentreLbl (AllCafsCC {cc_mod = m}) = pprModuleName m <> text "_CAFs_cc" +ppCostCentreLbl (AllCafsCC {cc_mod = m}) = ppr m <> text "_CAFs_cc" ppCostCentreLbl (NormalCC {cc_name = n, cc_mod = m, cc_is_caf = is_caf}) - = pprModuleName m <> ptext n <> + = ppr m <> ptext n <> text (case is_caf of { CafCC -> "_CAF"; _ -> "" }) <> text "_cc" -- This is the name to go in the user-displayed string, -- 1.7.10.4