Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
1a7d1b77
Commit
1a7d1b77
authored
Oct 03, 2007
by
Simon Marlow
Browse files
refactoring only: use the parameterised InstalledPackageInfo
This required moving PackageId from PackageConfig to Module
parent
e9325082
Changes
22
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/Module.hi-boot-6
View file @
1a7d1b77
module Module where
data Module
data ModuleName
data PackageId
moduleName :: Module -> ModuleName
modulePackageId :: Module ->
PackageConfig.
PackageId
modulePackageId :: Module -> PackageId
packageIdString :: PackageId -> GHC.Base.String
compiler/basicTypes/Module.lhs
View file @
1a7d1b77
...
...
@@ -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
...
...
@@ -207,6 +219,70 @@ pprPackagePrefix p mod = getPprStyle doc
| otherwise = empty
\end{code}
%************************************************************************
%* *
\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}
...
...
compiler/basicTypes/Module.lhs-boot
View file @
1a7d1b77
\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}
compiler/basicTypes/Unique.lhs
View file @
1a7d1b77
...
...
@@ -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}
...
...
compiler/coreSyn/CoreUtils.lhs
View file @
1a7d1b77
...
...
@@ -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
...
...
compiler/ghci/InteractiveUI.hs
View file @
1a7d1b77
...
...
@@ -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
...
...
compiler/main/CodeOutput.lhs
View file @
1a7d1b77
...
...
@@ -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 )
...
...
compiler/main/DynFlags.hs
View file @
1a7d1b77
...
...
@@ -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
Installed
Package
Info
),
pkgDatabase
::
Maybe
(
UniqFM
Package
Config
),
pkgState
::
PackageState
,
-- hsc dynamic flags
...
...
compiler/main/Finder.lhs
View file @
1a7d1b77
...
...
@@ -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])
...
...
compiler/main/GHC.hs
View file @
1a7d1b77
...
...
@@ -244,7 +244,6 @@ import Module
import
UniqFM
import
UniqSet
import
Unique
import
PackageConfig
import
FiniteMap
import
Panic
import
Digraph
...
...
compiler/main/PackageConfig.hs
View file @
1a7d1b77
{-# 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 <pkg>-<version>.
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"
)
compiler/main/Packages.lhs
View file @
1a7d1b77
...
...
@@ -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}
compiler/main/ParsePkgConf.y
View file @
1a7d1b77
...
...
@@ -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 :: { [
Fast
String] }
: '[' ']' { [] }
| '[' strs ']' { $2 }
strs :: { [String] }
: STRING { [
unpackFS
$1 ] }
| STRING ',' strs {
unpackFS
$1 : $3 }
strs :: { [
Fast
String] }
: STRING { [ $1 ] }
| STRING ',' strs { $1 : $3 }
{
happyError :: P a
...
...
compiler/main/TidyPgm.lhs
View file @
1a7d1b77
...
...
@@ -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 )
...
...
compiler/parser/ParserCore.y
View file @
1a7d1b77
...
...
@@ -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
...
...
compiler/prelude/PrelNames.lhs
View file @
1a7d1b77
...
...
@@ -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 )
...
...
compiler/profiling/SCCfinal.lhs
View file @
1a7d1b77
...
...
@@ -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 )
...
...
compiler/stgSyn/CoreToStg.lhs
View file @
1a7d1b77
...
...
@@ -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`
...
...
compiler/stgSyn/StgSyn.lhs
View file @
1a7d1b77
...
...
@@ -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}
%************************************************************************
...
...
compiler/utils/Binary.hs
View file @
1a7d1b77
...
...
@@ -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
{
...
...
Prev
1
2
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment