Hardcoding ["m","gmp"] is bad. We shouldn't link with any of the DLLs from a already linked package.

This commit is contained in:
lemmih 2006-01-25 10:45:40 +00:00
parent e930951796
commit 5d497a1c60

View File

@ -40,6 +40,8 @@ module System.Plugins.Env (
addMerge, addMerge,
addPkgConf, addPkgConf,
union, union,
addStaticPkg,
isStaticPkg,
grabDefaultPkgConf, grabDefaultPkgConf,
readPackageConf, readPackageConf,
lookupPkg lookupPkg
@ -71,12 +73,11 @@ import System.IO.Error ( catch, ioError, isDoesNotExistError )
import Control.Concurrent.MVar ( MVar(), newMVar, withMVar ) import Control.Concurrent.MVar ( MVar(), newMVar, withMVar )
#if __GLASGOW_HASKELL__ < 604 import Distribution.Package
import Data.FiniteMap import Text.ParserCombinators.ReadP
#else
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S
-- --
-- and map Data.Map terms to FiniteMap terms -- and map Data.Map terms to FiniteMap terms
-- --
@ -94,8 +95,6 @@ delFromFM = flip M.delete
lookupFM :: (Ord key) => FiniteMap key elt -> key -> Maybe elt lookupFM :: (Ord key) => FiniteMap key elt -> key -> Maybe elt
lookupFM = flip M.lookup lookupFM = flip M.lookup
#endif
-- --
-- | We need to record what modules and packages we have loaded, so if -- | We need to record what modules and packages we have loaded, so if
-- we read a .hi file that wants to load something already loaded, we -- we read a .hi file that wants to load something already loaded, we
@ -132,6 +131,8 @@ type DepEnv = FiniteMap Module [Module]
-- represents a package.conf file -- represents a package.conf file
type PkgEnv = FiniteMap PackageName PackageConfig type PkgEnv = FiniteMap PackageName PackageConfig
type StaticPkgEnv = S.Set PackageName
-- record dependencies between (src,stub) -> merged modid -- record dependencies between (src,stub) -> merged modid
type MergeEnv = FiniteMap (FilePath,FilePath) FilePath type MergeEnv = FiniteMap (FilePath,FilePath) FilePath
@ -142,6 +143,7 @@ type Env = (MVar (),
IORef ModEnv, IORef ModEnv,
IORef DepEnv, IORef DepEnv,
IORef PkgEnvs, IORef PkgEnvs,
IORef StaticPkgEnv,
IORef MergeEnv) IORef MergeEnv)
-- --
@ -155,8 +157,9 @@ env = unsafePerformIO $ do
ref2 <- newIORef emptyFM ref2 <- newIORef emptyFM
p <- grabDefaultPkgConf p <- grabDefaultPkgConf
ref3 <- newIORef p -- package.conf info ref3 <- newIORef p -- package.conf info
ref4 <- newIORef emptyFM -- merged files ref4 <- newIORef (S.fromList ["base","Cabal","haskell-src"])
return (mvar, ref1, ref2, ref3, ref4) ref5 <- newIORef emptyFM -- merged files
return (mvar, ref1, ref2, ref3, ref4, ref5)
{-# NOINLINE env #-} {-# NOINLINE env #-}
-- ----------------------------------------------------------- -- -----------------------------------------------------------
@ -168,12 +171,14 @@ env = unsafePerformIO $ do
withModEnv :: Env -> (ModEnv -> IO a) -> IO a withModEnv :: Env -> (ModEnv -> IO a) -> IO a
withDepEnv :: Env -> (DepEnv -> IO a) -> IO a withDepEnv :: Env -> (DepEnv -> IO a) -> IO a
withPkgEnvs :: Env -> (PkgEnvs -> IO a) -> IO a withPkgEnvs :: Env -> (PkgEnvs -> IO a) -> IO a
withStaticPkgEnv :: Env -> (StaticPkgEnv -> IO a) -> IO a
withMerged :: Env -> (MergeEnv -> IO a) -> IO a withMerged :: Env -> (MergeEnv -> IO a) -> IO a
withModEnv (mvar,ref,_,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f) withModEnv (mvar,ref,_,_,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f)
withDepEnv (mvar,_,ref,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f) withDepEnv (mvar,_,ref,_,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f)
withPkgEnvs (mvar,_,_,ref,_) f = withMVar mvar (\_ -> readIORef ref >>= f) withPkgEnvs (mvar,_,_,ref,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f)
withMerged (mvar,_,_,_,ref) f = withMVar mvar (\_ -> readIORef ref >>= f) withStaticPkgEnv (mvar,_,_,_,ref,_) f = withMVar mvar (\_ -> readIORef ref >>= f)
withMerged (mvar,_,_,_,_,ref) f = withMVar mvar (\_ -> readIORef ref >>= f)
-- ----------------------------------------------------------- -- -----------------------------------------------------------
-- --
@ -183,12 +188,14 @@ withMerged (mvar,_,_,_,ref) f = withMVar mvar (\_ -> readIORef ref >>= f)
modifyModEnv :: Env -> (ModEnv -> IO ModEnv) -> IO () modifyModEnv :: Env -> (ModEnv -> IO ModEnv) -> IO ()
modifyDepEnv :: Env -> (DepEnv -> IO DepEnv) -> IO () modifyDepEnv :: Env -> (DepEnv -> IO DepEnv) -> IO ()
modifyPkgEnv :: Env -> (PkgEnvs -> IO PkgEnvs) -> IO () modifyPkgEnv :: Env -> (PkgEnvs -> IO PkgEnvs) -> IO ()
modifyStaticPkgEnv :: Env -> (StaticPkgEnv -> IO StaticPkgEnv) -> IO ()
modifyMerged :: Env -> (MergeEnv -> IO MergeEnv)-> IO () modifyMerged :: Env -> (MergeEnv -> IO MergeEnv)-> IO ()
modifyModEnv (mvar,ref,_,_,_) f = lockAndWrite mvar ref f modifyModEnv (mvar,ref,_,_,_,_) f = lockAndWrite mvar ref f
modifyDepEnv (mvar,_,ref,_,_) f = lockAndWrite mvar ref f modifyDepEnv (mvar,_,ref,_,_,_) f = lockAndWrite mvar ref f
modifyPkgEnv (mvar,_,_,ref,_) f = lockAndWrite mvar ref f modifyPkgEnv (mvar,_,_,ref,_,_) f = lockAndWrite mvar ref f
modifyMerged (mvar,_,_,_,ref) f = lockAndWrite mvar ref f modifyStaticPkgEnv (mvar,_,_,_,ref,_) f = lockAndWrite mvar ref f
modifyMerged (mvar,_,_,_,_,ref) f = lockAndWrite mvar ref f
-- private -- private
lockAndWrite mvar ref f = withMVar mvar (\_->readIORef ref>>=f>>=writeIORef ref) lockAndWrite mvar ref f = withMVar mvar (\_->readIORef ref>>=f>>=writeIORef ref)
@ -311,6 +318,18 @@ readPackageConf f = do
expand s | "$libdir" `isPrefixOf` s = ghcLibraryPath ++ drop 7 s expand s | "$libdir" `isPrefixOf` s = ghcLibraryPath ++ drop 7 s
expand s = s expand s = s
-- -----------------------------------------------------------
-- Static package management stuff. A static package is linked with the base
-- application and we should therefore not link with any of the DLLs it requires.
addStaticPkg :: PackageName -> IO ()
addStaticPkg pkg = modifyStaticPkgEnv env $ \set -> return $ S.insert pkg set
isStaticPkg :: PackageName -> IO Bool
isStaticPkg pkg
= case readP_to_S parsePackageName pkg of
((pkgName,_):_) -> withStaticPkgEnv env $ \set -> return $ S.member pkgName set
[] -> return False
-- --
-- Package path, given a package name, look it up in the environment and -- Package path, given a package name, look it up in the environment and
@ -333,10 +352,12 @@ readPackageConf f = do
lookupPkg :: PackageName -> IO ([FilePath],[FilePath]) lookupPkg :: PackageName -> IO ([FilePath],[FilePath])
lookupPkg p = do lookupPkg p = do
t <- lookupPkg' p t <- lookupPkg' p
case t of ([],(f,g)) -> return (f,g) static <- isStaticPkg p
case t of ([],(f,g)) -> return (f,if static then [] else g)
(ps,(f,g)) -> do gss <- mapM lookupPkg ps (ps,(f,g)) -> do gss <- mapM lookupPkg ps
let (f',g') = unzip gss let (f',g') = unzip gss
return $ (nub $ (concat f') ++ f,nub $ (concat g') ++ g) return $ (nub $ (concat f') ++ f
,if static then [] else nub $ (concat g') ++ g)
data LibrarySpec data LibrarySpec
= DLL String -- -lLib = DLL String -- -lLib
@ -382,7 +403,7 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
let hslibs = hsLibraries package let hslibs = hsLibraries package
extras' = extraLibraries package extras' = extraLibraries package
cbits = filter (\e -> reverse (take (length "_cbits") (reverse e)) == "_cbits") extras' cbits = filter (\e -> reverse (take (length "_cbits") (reverse e)) == "_cbits") extras'
extras = filter (not . flip elem (cbits++["m","gmp"])) extras' extras = filter (flip notElem cbits) extras'
ldopts = ldOptions package ldopts = ldOptions package
deppkgs = packageDeps package deppkgs = packageDeps package
ldInput <- mapM classifyLdInput ldopts ldInput <- mapM classifyLdInput ldopts