module Module where
data Module
data ModuleName
+data PackageId
moduleName :: Module -> ModuleName
-modulePackageId :: Module -> PackageConfig.PackageId
-
+modulePackageId :: Module -> PackageId
+packageIdString :: PackageId -> GHC.Base.String
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
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,
#include "HsVersions.h"
import Outputable
+import qualified Pretty
import Unique
import FiniteMap
import UniqFM
-import PackageConfig
import FastString
import Binary
\end{code}
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
%************************************************************************
%* *
+\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}
%* *
%************************************************************************
\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}
#include "HsVersions.h"
import BasicTypes
-import PackageConfig
import FastString
import Outputable
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}
import VarSet
import VarEnv
import Name
+import Module
#if mingw32_TARGET_OS
import Packages
#endif
import TysWiredIn
import CostCentre
import BasicTypes
-import PackageConfig
import Unique
import Outputable
import DynFlags
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
import PprC ( writeCs )
import CmmLint ( cmmLint )
import Packages
-import PackageConfig ( rtsPackageId )
import Util
import FastString ( unpackFS )
import Cmm ( RawCmm )
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 )
#include "HsVersions.h"
-import Module ( Module, mkModuleName, mkModule, ModLocation )
+import Module
import PackageConfig
import PrelNames ( mAIN )
#ifdef i386_TARGET_ARCH
-- 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
\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(..),
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])
import UniqFM
import UniqSet
import Unique
-import PackageConfig
import FiniteMap
import Panic
import Digraph
-{-# 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
-- -----------------------------------------------------------------------------
--
-- 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
[] -> 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")
-
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))
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}
import PackageConfig
import Lexer
+import Module
import DynFlags
import FastString
import StringBuffer
-- 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
version :: { Version }
: CONID '{' VARID '=' intlist ',' VARID '=' strlist '}'
- { Version{ versionBranch=$5, versionTags=$9 } }
+ { Version{ versionBranch=$5,
+ versionTags=map unpackFS $9 } }
pkgidlist :: { [PackageIdentifier] }
: '[' pkgids ']' { $2 }
: 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
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 )
)
import Name( Name, nameOccName, nameModule, mkExternalName )
import Module
-import PackageConfig ( mainPackageId, stringToPackageId )
import ParserCoreUtils
import LexCore
import Literal
#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 )
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 )
import OccName ( occNameString, occNameFS )
import BasicTypes ( Arity )
import StaticFlags ( opt_RuntimeTypes )
-import PackageConfig ( PackageId )
+import Module
import Outputable
infixr 9 `thenLne`
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 )
import Unique ( Unique )
import Bitmap
import StaticFlags ( opt_SccProfilingOn )
-import Module ( Module, pprModule )
+import Module
\end{code}
%************************************************************************
import Panic
import UniqFM
import FastMutInt
-import PackageConfig
import Foreign
import Data.Array.IO
--
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 {
#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
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}
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
projects / ghc-hetmet.git / commitdiff