From 5d497a1c603d0a955e2ef2bcb181e1b9e707e902 Mon Sep 17 00:00:00 2001 From: lemmih Date: Wed, 25 Jan 2006 10:45:40 +0000 Subject: [PATCH] Hardcoding ["m","gmp"] is bad. We shouldn't link with any of the DLLs from a already linked package. --- src/System/Plugins/Env.hs | 59 ++++++++++++++++++++++++++------------- 1 file changed, 40 insertions(+), 19 deletions(-) diff --git a/src/System/Plugins/Env.hs b/src/System/Plugins/Env.hs index 45102ac..e9294e8 100644 --- a/src/System/Plugins/Env.hs +++ b/src/System/Plugins/Env.hs @@ -40,6 +40,8 @@ module System.Plugins.Env ( addMerge, addPkgConf, union, + addStaticPkg, + isStaticPkg, grabDefaultPkgConf, readPackageConf, lookupPkg @@ -71,12 +73,11 @@ import System.IO.Error ( catch, ioError, isDoesNotExistError ) import Control.Concurrent.MVar ( MVar(), newMVar, withMVar ) -#if __GLASGOW_HASKELL__ < 604 -import Data.FiniteMap +import Distribution.Package +import Text.ParserCombinators.ReadP -#else import qualified Data.Map as M - +import qualified Data.Set as S -- -- 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 = flip M.lookup -#endif - -- -- | 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 @@ -132,6 +131,8 @@ type DepEnv = FiniteMap Module [Module] -- represents a package.conf file type PkgEnv = FiniteMap PackageName PackageConfig +type StaticPkgEnv = S.Set PackageName + -- record dependencies between (src,stub) -> merged modid type MergeEnv = FiniteMap (FilePath,FilePath) FilePath @@ -142,6 +143,7 @@ type Env = (MVar (), IORef ModEnv, IORef DepEnv, IORef PkgEnvs, + IORef StaticPkgEnv, IORef MergeEnv) -- @@ -155,8 +157,9 @@ env = unsafePerformIO $ do ref2 <- newIORef emptyFM p <- grabDefaultPkgConf ref3 <- newIORef p -- package.conf info - ref4 <- newIORef emptyFM -- merged files - return (mvar, ref1, ref2, ref3, ref4) + ref4 <- newIORef (S.fromList ["base","Cabal","haskell-src"]) + ref5 <- newIORef emptyFM -- merged files + return (mvar, ref1, ref2, ref3, ref4, ref5) {-# NOINLINE env #-} -- ----------------------------------------------------------- @@ -168,12 +171,14 @@ env = unsafePerformIO $ do withModEnv :: Env -> (ModEnv -> IO a) -> IO a withDepEnv :: Env -> (DepEnv -> 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 -withModEnv (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) -withMerged (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) +withPkgEnvs (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 () modifyDepEnv :: Env -> (DepEnv -> IO DepEnv) -> IO () modifyPkgEnv :: Env -> (PkgEnvs -> IO PkgEnvs) -> IO () +modifyStaticPkgEnv :: Env -> (StaticPkgEnv -> IO StaticPkgEnv) -> IO () modifyMerged :: Env -> (MergeEnv -> IO MergeEnv)-> IO () -modifyModEnv (mvar,ref,_,_,_) f = lockAndWrite mvar ref f -modifyDepEnv (mvar,_,ref,_,_) f = lockAndWrite mvar ref f -modifyPkgEnv (mvar,_,_,ref,_) f = lockAndWrite mvar ref f -modifyMerged (mvar,_,_,_,ref) f = lockAndWrite mvar ref f +modifyModEnv (mvar,ref,_,_,_,_) f = lockAndWrite mvar ref f +modifyDepEnv (mvar,_,ref,_,_,_) f = lockAndWrite mvar ref f +modifyPkgEnv (mvar,_,_,ref,_,_) f = lockAndWrite mvar ref f +modifyStaticPkgEnv (mvar,_,_,_,ref,_) f = lockAndWrite mvar ref f +modifyMerged (mvar,_,_,_,_,ref) f = lockAndWrite mvar ref f -- private 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 = 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 @@ -333,10 +352,12 @@ readPackageConf f = do lookupPkg :: PackageName -> IO ([FilePath],[FilePath]) lookupPkg p = do 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 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 = DLL String -- -lLib @@ -382,7 +403,7 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p let hslibs = hsLibraries package extras' = extraLibraries package 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 deppkgs = packageDeps package ldInput <- mapM classifyLdInput ldopts