From 1a7d1b77334529ca96ed4cbc03fcb5f55dc2de4a Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 3 Oct 2007 16:35:36 +0000 Subject: [PATCH] refactoring only: use the parameterised InstalledPackageInfo This required moving PackageId from PackageConfig to Module --- compiler/basicTypes/Module.hi-boot-6 | 5 +- compiler/basicTypes/Module.lhs | 92 +++++++++++++++++++++++++++++++--- compiler/basicTypes/Module.lhs-boot | 4 +- compiler/basicTypes/Unique.lhs | 4 -- compiler/coreSyn/CoreUtils.lhs | 2 +- compiler/ghci/InteractiveUI.hs | 2 +- compiler/main/CodeOutput.lhs | 3 +- compiler/main/DynFlags.hs | 4 +- compiler/main/Finder.lhs | 9 +--- compiler/main/GHC.hs | 1 - compiler/main/PackageConfig.hs | 78 ++++------------------------ compiler/main/Packages.lhs | 15 ++++-- compiler/main/ParsePkgConf.y | 54 ++++++++++---------- compiler/main/TidyPgm.lhs | 3 +- compiler/parser/ParserCore.y | 1 - compiler/prelude/PrelNames.lhs | 3 +- compiler/profiling/SCCfinal.lhs | 3 +- compiler/stgSyn/CoreToStg.lhs | 2 +- compiler/stgSyn/StgSyn.lhs | 3 +- compiler/utils/Binary.hs | 5 -- compiler/utils/Outputable.lhs | 7 +-- compiler/vectorise/VectBuiltIn.hs | 3 +- 22 files changed, 149 insertions(+), 154 deletions(-) diff --git a/compiler/basicTypes/Module.hi-boot-6 b/compiler/basicTypes/Module.hi-boot-6 index 16ce07c..c3019f8 100644 --- a/compiler/basicTypes/Module.hi-boot-6 +++ b/compiler/basicTypes/Module.hi-boot-6 @@ -1,6 +1,7 @@ module Module where data Module data ModuleName +data PackageId moduleName :: Module -> ModuleName -modulePackageId :: Module -> PackageConfig.PackageId - +modulePackageId :: Module -> PackageId +packageIdString :: PackageId -> GHC.Base.String diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index 0a1c4a5..f6b8b83 100644 --- a/compiler/basicTypes/Module.lhs +++ b/compiler/basicTypes/Module.lhs @@ -9,13 +9,6 @@ These are Uniquable, hence we can build FiniteMaps with Modules as the keys. \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module Module ( -- * The ModuleName type @@ -26,6 +19,21 @@ module Module mkModuleName, mkModuleNameFS, + -- * The PackageId type + PackageId, + fsToPackageId, + packageIdFS, + stringToPackageId, + packageIdString, + + -- * Wired-in PackageIds + basePackageId, + rtsPackageId, + haskell98PackageId, + thPackageId, + ndpPackageId, + mainPackageId, + -- * The Module type Module, modulePackageId, moduleName, @@ -55,10 +63,10 @@ module Module #include "HsVersions.h" import Outputable +import qualified Pretty import Unique import FiniteMap import UniqFM -import PackageConfig import FastString import Binary \end{code} @@ -188,12 +196,16 @@ instance Binary Module where put_ bh (Module p n) = put_ bh p >> put_ bh n get bh = do p <- get bh; n <- get bh; return (Module p n) +instance Uniquable PackageId where + getUnique pid = getUnique (packageIdFS pid) + mkModule :: PackageId -> ModuleName -> Module mkModule = Module pprModule :: Module -> SDoc pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n +pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc pprPackagePrefix p mod = getPprStyle doc where doc sty @@ -209,6 +221,70 @@ pprPackagePrefix p mod = getPprStyle doc %************************************************************************ %* * +\subsection{PackageId} +%* * +%************************************************************************ + +\begin{code} +newtype PackageId = PId FastString deriving( Eq, Ord ) -- includes the version + -- here to avoid module loops with PackageConfig + +instance Outputable PackageId where + ppr pid = text (packageIdString pid) + +instance Binary PackageId where + put_ bh pid = put_ bh (packageIdFS pid) + get bh = do { fs <- get bh; return (fsToPackageId fs) } + +fsToPackageId :: FastString -> PackageId +fsToPackageId = PId + +packageIdFS :: PackageId -> FastString +packageIdFS (PId fs) = fs + +stringToPackageId :: String -> PackageId +stringToPackageId = fsToPackageId . mkFastString + +packageIdString :: PackageId -> String +packageIdString = unpackFS . packageIdFS + + +-- ----------------------------------------------------------------------------- +-- Package Ids that are wired in + +-- Certain packages are "known" to the compiler, in that we know about certain +-- entities that reside in these packages, and the compiler needs to +-- declare static Modules and Names that refer to these packages. Hence +-- the wired-in packages can't include version numbers, since we don't want +-- to bake the version numbers of these packages into GHC. +-- +-- So here's the plan. Wired-in packages are still versioned as +-- normal in the packages database, and you can still have multiple +-- versions of them installed. However, for each invocation of GHC, +-- only a single instance of each wired-in package will be recognised +-- (the desired one is selected via -package/-hide-package), and GHC +-- will use the unversioned PackageId below when referring to it, +-- including in .hi files and object file symbols. Unselected +-- versions of wired-in packages will be ignored, as will any other +-- package that depends directly or indirectly on it (much as if you +-- had used -ignore-package). + +basePackageId, rtsPackageId, haskell98PackageId, + thPackageId, ndpPackageId, mainPackageId :: PackageId +basePackageId = fsToPackageId FSLIT("base") +rtsPackageId = fsToPackageId FSLIT("rts") +haskell98PackageId = fsToPackageId FSLIT("haskell98") +thPackageId = fsToPackageId FSLIT("template-haskell") +ndpPackageId = fsToPackageId FSLIT("ndp") + +-- This is the package Id for the program. It is the default package +-- Id if you don't specify a package name. We don't add this prefix +-- to symbol name, since there can be only one main package per program. +mainPackageId = fsToPackageId FSLIT("main") +\end{code} + +%************************************************************************ +%* * \subsection{@ModuleEnv@s} %* * %************************************************************************ diff --git a/compiler/basicTypes/Module.lhs-boot b/compiler/basicTypes/Module.lhs-boot index 37fa6a9..63839b5 100644 --- a/compiler/basicTypes/Module.lhs-boot +++ b/compiler/basicTypes/Module.lhs-boot @@ -1,10 +1,10 @@ \begin{code} module Module where -import PackageConfig (PackageId) - data Module data ModuleName +data PackageId moduleName :: Module -> ModuleName modulePackageId :: Module -> PackageId +packageIdString :: PackageId -> String \end{code} diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs index ee139ab..1926f5c 100644 --- a/compiler/basicTypes/Unique.lhs +++ b/compiler/basicTypes/Unique.lhs @@ -58,7 +58,6 @@ module Unique ( #include "HsVersions.h" import BasicTypes -import PackageConfig import FastString import Outputable @@ -155,9 +154,6 @@ x `hasKey` k = getUnique x == k instance Uniquable FastString where getUnique fs = mkUniqueGrimily (I# (uniqueOfFS fs)) -instance Uniquable PackageId where - getUnique pid = getUnique (packageIdFS pid) - instance Uniquable Int where getUnique i = mkUniqueGrimily i \end{code} diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index b505a96..fcd5999 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -55,6 +55,7 @@ import SrcLoc import VarSet import VarEnv import Name +import Module #if mingw32_TARGET_OS import Packages #endif @@ -70,7 +71,6 @@ import TyCon import TysWiredIn import CostCentre import BasicTypes -import PackageConfig import Unique import Outputable import DynFlags diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 2be47c3..ff794d0 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -1448,7 +1448,7 @@ getCommonPrefix (s:ss) = foldl common s ss allExposedModules :: DynFlags -> [ModuleName] allExposedModules dflags - = map GHC.mkModuleName (concat (map exposedModules (filter exposed (eltsUFM pkg_db)))) + = concat (map exposedModules (filter exposed (eltsUFM pkg_db))) where pkg_db = pkgIdMap (pkgState dflags) #else diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index 6985bd7..6d11c65 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -30,7 +30,6 @@ import Finder ( mkStubPaths ) import PprC ( writeCs ) import CmmLint ( cmmLint ) import Packages -import PackageConfig ( rtsPackageId ) import Util import FastString ( unpackFS ) import Cmm ( RawCmm ) @@ -40,7 +39,7 @@ import DynFlags import ErrUtils ( dumpIfSet_dyn, showPass, ghcExit ) import Outputable import Pretty ( Mode(..), printDoc ) -import Module ( Module, ModLocation(..), moduleName ) +import Module import List ( nub ) import Maybes ( firstJust ) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 65ddd2d..25dddeb 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -61,7 +61,7 @@ module DynFlags ( #include "HsVersions.h" -import Module ( Module, mkModuleName, mkModule, ModLocation ) +import Module import PackageConfig import PrelNames ( mAIN ) #ifdef i386_TARGET_ARCH @@ -381,7 +381,7 @@ data DynFlags = DynFlags { -- Package state -- NB. do not modify this field, it is calculated by -- Packages.initPackages and Packages.updatePackages. - pkgDatabase :: Maybe (UniqFM InstalledPackageInfo), + pkgDatabase :: Maybe (UniqFM PackageConfig), pkgState :: PackageState, -- hsc dynamic flags diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 678966f..6e2b11d 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -4,13 +4,6 @@ \section[Finder]{Module Finder} \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module Finder ( flushFinderCaches, FindResult(..), @@ -530,7 +523,7 @@ findObjectLinkableMaybe mod locn findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable findObjectLinkable mod obj_fn obj_time = do let stub_fn = case splitFilename3 obj_fn of - (dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o" + (dir, base, _ext) -> dir ++ "/" ++ base ++ "_stub.o" stub_exist <- doesFileExist stub_fn if stub_exist then return (LM obj_time mod [DotO obj_fn, DotO stub_fn]) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 707a81d..2403e07 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -244,7 +244,6 @@ import Module import UniqFM import UniqSet import Unique -import PackageConfig import FiniteMap import Panic import Digraph diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index 14ac6b5..c070ca2 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -1,49 +1,37 @@ -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - -- -- (c) The University of Glasgow, 2004 -- module PackageConfig ( -- * PackageId - PackageId, - mkPackageId, stringToPackageId, packageIdString, packageConfigId, - packageIdFS, fsToPackageId, unpackPackageId, + mkPackageId, packageConfigId, unpackPackageId, -- * The PackageConfig type: information about a package PackageConfig, - InstalledPackageInfo(..), showPackageId, + InstalledPackageInfo_(..), showPackageId, Version(..), PackageIdentifier(..), defaultPackageConfig, - - -- * Wired-in PackageIds - basePackageId, - rtsPackageId, - haskell98PackageId, - thPackageId, - ndpPackageId, - mainPackageId ) where #include "HsVersions.h" +import Module import Distribution.InstalledPackageInfo import Distribution.Package import Distribution.Version -import FastString import Distribution.Compat.ReadP ( readP_to_S ) +-- warning suppression +_unused :: FS.FastString +_unused = FSLIT("") + -- ----------------------------------------------------------------------------- -- Our PackageConfig type is just InstalledPackageInfo from Cabal. Later we -- might need to extend it with some GHC-specific stuff, but for now it's fine. -type PackageConfig = InstalledPackageInfo +type PackageConfig = InstalledPackageInfo_ ModuleName +defaultPackageConfig :: PackageConfig defaultPackageConfig = emptyInstalledPackageInfo -- ----------------------------------------------------------------------------- @@ -60,22 +48,6 @@ defaultPackageConfig = emptyInstalledPackageInfo -- -- A PackageId is a string of the form -. -newtype PackageId = PId FastString deriving( Eq, Ord ) -- includes the version - -- easier not to use a newtype here, because we need instances of - -- Binary & Outputable, and we're too early to define them - -fsToPackageId :: FastString -> PackageId -fsToPackageId = PId - -packageIdFS :: PackageId -> FastString -packageIdFS (PId fs) = fs - -stringToPackageId :: String -> PackageId -stringToPackageId = fsToPackageId . mkFastString - -packageIdString :: PackageId -> String -packageIdString = unpackFS . packageIdFS - mkPackageId :: PackageIdentifier -> PackageId mkPackageId = stringToPackageId . showPackageId @@ -88,35 +60,3 @@ unpackPackageId p [] -> Nothing (pid:_) -> Just pid where str = packageIdString p - --- ----------------------------------------------------------------------------- --- Package Ids that are wired in - --- Certain packages are "known" to the compiler, in that we know about certain --- entities that reside in these packages, and the compiler needs to --- declare static Modules and Names that refer to these packages. Hence --- the wired-in packages can't include version numbers, since we don't want --- to bake the version numbers of these packages into GHC. --- --- So here's the plan. Wired-in packages are still versioned as --- normal in the packages database, and you can still have multiple --- versions of them installed. However, for each invocation of GHC, --- only a single instance of each wired-in package will be recognised --- (the desired one is selected via -package/-hide-package), and GHC --- will use the unversioned PackageId below when referring to it, --- including in .hi files and object file symbols. Unselected --- versions of wired-in packages will be ignored, as will any other --- package that depends directly or indirectly on it (much as if you --- had used -ignore-package). - -basePackageId = fsToPackageId FSLIT("base") -rtsPackageId = fsToPackageId FSLIT("rts") -haskell98PackageId = fsToPackageId FSLIT("haskell98") -thPackageId = fsToPackageId FSLIT("template-haskell") -ndpPackageId = fsToPackageId FSLIT("ndp") - --- This is the package Id for the program. It is the default package --- Id if you don't specify a package name. We don't add this prefix --- to symbol name, since there can be only one main package per program. -mainPackageId = fsToPackageId FSLIT("main") - diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 9904fdf..1402db1 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -557,12 +557,12 @@ mkModuleMap pkg_db = foldr extend_modmap emptyUFM pkgids extend_modmap pkgid modmap = addListToUFM_C (++) modmap - [(m, [(pkg, m `elem` exposed_mods)]) | m <- all_mods] + ([(m, [(pkg, True)]) | m <- exposed_mods] ++ + [(m, [(pkg, False)]) | m <- hidden_mods]) where pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid) - exposed_mods = map mkModuleName (exposedModules pkg) - hidden_mods = map mkModuleName (hiddenModules pkg) - all_mods = exposed_mods ++ hidden_mods + exposed_mods = exposedModules pkg + hidden_mods = hiddenModules pkg pprPkg :: PackageConfig -> SDoc pprPkg p = text (showPackageId (package p)) @@ -704,5 +704,10 @@ dumpPackages :: DynFlags -> IO () dumpPackages dflags = do let pkg_map = pkgIdMap (pkgState dflags) putMsg dflags $ - vcat (map (text.showInstalledPackageInfo) (eltsUFM pkg_map)) + vcat (map (text.showInstalledPackageInfo.to_ipi) (eltsUFM pkg_map)) + where + to_ipi pkgconf@InstalledPackageInfo_{ exposedModules = e, + hiddenModules = h } = + pkgconf{ exposedModules = map moduleNameString e, + hiddenModules = map moduleNameString h } \end{code} diff --git a/compiler/main/ParsePkgConf.y b/compiler/main/ParsePkgConf.y index 85385a7..1a13108 100644 --- a/compiler/main/ParsePkgConf.y +++ b/compiler/main/ParsePkgConf.y @@ -12,6 +12,7 @@ module ParsePkgConf( loadPackageConfig ) where import PackageConfig import Lexer +import Module import DynFlags import FastString import StringBuffer @@ -82,27 +83,27 @@ field :: { PackageConfig -> PackageConfig } -- another case of license | VARID '=' strlist - {\p -> case unpackFS $1 of - "exposedModules" -> p{exposedModules = $3} - "hiddenModules" -> p{hiddenModules = $3} - "importDirs" -> p{importDirs = $3} - "libraryDirs" -> p{libraryDirs = $3} - "hsLibraries" -> p{hsLibraries = $3} - "extraLibraries" -> p{extraLibraries = $3} - "extraGHCiLibraries"-> p{extraGHCiLibraries= $3} - "includeDirs" -> p{includeDirs = $3} - "includes" -> p{includes = $3} - "hugsOptions" -> p{hugsOptions = $3} - "ccOptions" -> p{ccOptions = $3} - "ldOptions" -> p{ldOptions = $3} - "frameworkDirs" -> p{frameworkDirs = $3} - "frameworks" -> p{frameworks = $3} - "haddockInterfaces" -> p{haddockInterfaces = $3} - "haddockHTMLs" -> p{haddockHTMLs = $3} - "depends" -> p{depends = []} - -- empty list only, non-empty handled below - other -> p - } + {\p -> case unpackFS $1 of + "exposedModules" -> p{exposedModules = map mkModuleNameFS $3} + "hiddenModules" -> p{hiddenModules = map mkModuleNameFS $3} + "importDirs" -> p{importDirs = map unpackFS $3} + "libraryDirs" -> p{libraryDirs = map unpackFS $3} + "hsLibraries" -> p{hsLibraries = map unpackFS $3} + "extraLibraries" -> p{extraLibraries = map unpackFS $3} + "extraGHCiLibraries"-> p{extraGHCiLibraries= map unpackFS $3} + "includeDirs" -> p{includeDirs = map unpackFS $3} + "includes" -> p{includes = map unpackFS $3} + "hugsOptions" -> p{hugsOptions = map unpackFS $3} + "ccOptions" -> p{ccOptions = map unpackFS $3} + "ldOptions" -> p{ldOptions = map unpackFS $3} + "frameworkDirs" -> p{frameworkDirs = map unpackFS $3} + "frameworks" -> p{frameworks = map unpackFS $3} + "haddockInterfaces" -> p{haddockInterfaces = map unpackFS $3} + "haddockHTMLs" -> p{haddockHTMLs = map unpackFS $3} + "depends" -> p{depends = []} + -- empty list only, non-empty handled below + other -> p + } | VARID '=' pkgidlist {% case unpackFS $1 of @@ -117,7 +118,8 @@ pkgid :: { PackageIdentifier } version :: { Version } : CONID '{' VARID '=' intlist ',' VARID '=' strlist '}' - { Version{ versionBranch=$5, versionTags=$9 } } + { Version{ versionBranch=$5, + versionTags=map unpackFS $9 } } pkgidlist :: { [PackageIdentifier] } : '[' pkgids ']' { $2 } @@ -135,13 +137,13 @@ ints :: { [Int] } : INT { [ fromIntegral $1 ] } | INT ',' ints { fromIntegral $1 : $3 } -strlist :: { [String] } +strlist :: { [FastString] } : '[' ']' { [] } | '[' strs ']' { $2 } -strs :: { [String] } - : STRING { [ unpackFS $1 ] } - | STRING ',' strs { unpackFS $1 : $3 } +strs :: { [FastString] } + : STRING { [ $1 ] } + | STRING ',' strs { $1 : $3 } { happyError :: P a diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 8dabe4e..b9dfa03 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -47,11 +47,10 @@ import TyCon ( TyCon, makeTyConAbstract, tyConDataCons, isNewTyCon, newTyConRep, tyConSelIds, isAlgTyCon, isEnumerationTyCon, isOpenTyCon ) import Class ( classSelIds ) -import Module ( Module ) +import Module import HscTypes import Maybes ( orElse, mapCatMaybes ) import ErrUtils ( showPass, dumpIfSet_core ) -import PackageConfig ( PackageId ) import UniqSupply ( splitUniqSupply, uniqFromSupply ) import Outputable import FastTypes hiding ( fastOr ) diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y index a85d837..86652ff 100644 --- a/compiler/parser/ParserCore.y +++ b/compiler/parser/ParserCore.y @@ -20,7 +20,6 @@ import Type ( Kind, ) import Name( Name, nameOccName, nameModule, mkExternalName ) import Module -import PackageConfig ( mainPackageId, stringToPackageId ) import ParserCoreUtils import LexCore import Literal diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 33912e9..16ec9a9 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -56,8 +56,7 @@ module PrelNames ( #include "HsVersions.h" -import PackageConfig -import Module ( Module, ModuleName, mkModule, mkModuleNameFS ) +import Module import OccName ( dataName, tcName, clsName, varName, mkOccNameFS, mkVarOccFS ) import RdrName ( RdrName, nameRdrName, mkOrig, rdrNameOcc, mkUnqual ) diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index 2cd12cc..dd72341 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -36,12 +36,11 @@ module SCCfinal ( stgMassageForProfiling ) where import StgSyn -import PackageConfig ( PackageId ) import StaticFlags ( opt_AutoSccsOnIndividualCafs ) import CostCentre -- lots of things import Id import Name -import Module ( Module ) +import Module import UniqSupply ( splitUniqSupply, UniqSupply ) #ifdef PROF_DO_BOXING import UniqSupply ( uniqFromSupply ) diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs index ddbc632..51e830c 100644 --- a/compiler/stgSyn/CoreToStg.lhs +++ b/compiler/stgSyn/CoreToStg.lhs @@ -36,7 +36,7 @@ import Name ( getOccName, isExternalName, nameOccName ) import OccName ( occNameString, occNameFS ) import BasicTypes ( Arity ) import StaticFlags ( opt_RuntimeTypes ) -import PackageConfig ( PackageId ) +import Module import Outputable infixr 9 `thenLne` diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs index b97e766..6cd7df7 100644 --- a/compiler/stgSyn/StgSyn.lhs +++ b/compiler/stgSyn/StgSyn.lhs @@ -59,7 +59,6 @@ import Var ( isId ) import Id ( Id, idName, idType, idCafInfo ) import IdInfo ( mayHaveCafRefs ) import Packages ( isDllName ) -import PackageConfig ( PackageId ) import Literal ( Literal, literalType ) import ForeignCall ( ForeignCall ) import DataCon ( DataCon, dataConName ) @@ -74,7 +73,7 @@ import UniqSet ( isEmptyUniqSet, uniqSetToList, UniqSet ) import Unique ( Unique ) import Bitmap import StaticFlags ( opt_SccProfilingOn ) -import Module ( Module, pprModule ) +import Module \end{code} %************************************************************************ diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 59c35d5..897cca3 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -66,7 +66,6 @@ import Unique import Panic import UniqFM import FastMutInt -import PackageConfig import Foreign import Data.Array.IO @@ -667,10 +666,6 @@ getFS bh = do -- go 0 -instance Binary PackageId where - put_ bh pid = put_ bh (packageIdFS pid) - get bh = do { fs <- get bh; return (fsToPackageId fs) } - instance Binary FastString where put_ bh f@(FastString id l _ fp _) = case getUserData bh of { diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index 2433cbd..85b32e4 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -51,12 +51,10 @@ module Outputable ( #include "HsVersions.h" -import {-# SOURCE #-} Module( Module, - ModuleName, moduleName ) +import {-# SOURCE #-} Module( Module, ModuleName, moduleName ) import {-# SOURCE #-} OccName( OccName ) import StaticFlags ( opt_PprStyle_Debug, opt_PprUserLength ) -import PackageConfig ( PackageId, packageIdString ) import FastString import FastTypes import GHC.Ptr @@ -477,9 +475,6 @@ instance (Outputable a, Outputable b, Outputable c, Outputable d) => instance Outputable FastString where ppr fs = ftext fs -- Prints an unadorned string, -- no double quotes or anything - -instance Outputable PackageId where - ppr pid = text (packageIdString pid) \end{code} diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index d604da7..cea139d 100644 --- a/compiler/vectorise/VectBuiltIn.hs +++ b/compiler/vectorise/VectBuiltIn.hs @@ -30,8 +30,7 @@ import TypeRep ( funTyCon ) import Type ( Type ) import TysPrim import TysWiredIn ( unitTyCon, tupleTyCon, intTyConName ) -import Module ( Module, mkModule, mkModuleNameFS ) -import PackageConfig ( ndpPackageId ) +import Module import BasicTypes ( Boxity(..) ) import FastString -- 1.7.10.4