Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ecd967612877e1965ddebefe9b83acd837bb413a >--------------------------------------------------------------- commit ecd967612877e1965ddebefe9b83acd837bb413a Author: Ian Lynagh <i...@well-typed.com> Date: Sat Dec 8 19:52:24 2012 +0000 Fix loading dynamic interfaces when using -dynamic-too We need to have WayDyn in the ways in the DynFlags, or the interface loader will fail. -dynamic-too now correctly evaluates whether or not it is possible to build for the dynamic way too, but doesn't actually do so yet. >--------------------------------------------------------------- compiler/iface/LoadIface.lhs | 2 +- compiler/main/DynFlags.hs | 24 ++++++++++++++---------- compiler/typecheck/TcRnMonad.lhs | 9 +++++++++ 3 files changed, 24 insertions(+), 11 deletions(-) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 6d23419..2c36fa9 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -561,7 +561,7 @@ findAndReadIface doc_str mod hi_boot_file when (gopt Opt_BuildDynamicToo dflags) $ do let ref = canGenerateDynamicToo dflags b <- liftIO $ readIORef ref - when b $ do + when b $ withDoDynamicToo $ do let dynFilePath = replaceExtension filePath (dynHiSuf dflags) r <- read_file dynFilePath case r of diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 186c566..5e2638c 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -970,7 +970,7 @@ data Way | WayGran | WayNDP | WayDyn - deriving (Eq,Ord) + deriving (Eq, Ord, Show) allowed_combination :: [Way] -> Bool allowed_combination way = and [ x `allowedWith` y @@ -1119,7 +1119,8 @@ doDynamicToo dflags0 = let dflags1 = unSetGeneralFlag' Opt_Static dflags0 hiSuf = dynHiSuf dflags2, objectSuf = dynObjectSuf dflags2 } - in dflags3 + dflags4 = updateWays dflags3 + in dflags4 ----------------------------------------------------------------------------- @@ -1759,14 +1760,8 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do -- check for disabled flags in safe haskell let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1 - - theWays = sort $ nub $ ways dflags2 - theBuildTag = mkBuildTag (filter (not . wayRTSOnly) theWays) - dflags3 = dflags2 { - ways = theWays, - buildTag = theBuildTag, - rtsBuildTag = mkBuildTag theWays - } + dflags3 = updateWays dflags2 + theWays = ways dflags3 unless (allowed_combination theWays) $ throwGhcException (CmdLineError ("combination not supported: " ++ @@ -1778,6 +1773,15 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do return (dflags4, leftover, consistency_warnings ++ sh_warns ++ warns) +updateWays :: DynFlags -> DynFlags +updateWays dflags + = let theWays = sort $ nub $ ways dflags + theBuildTag = mkBuildTag (filter (not . wayRTSOnly) theWays) + in dflags { + ways = theWays, + buildTag = theBuildTag, + rtsBuildTag = mkBuildTag theWays + } -- | Check (and potentially disable) any extensions that aren't allowed -- in safe mode. diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index d866893..1d27729 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -306,6 +306,15 @@ getGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) } \end{code} \begin{code} +withDoDynamicToo :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a +withDoDynamicToo m = do env <- getEnv + let dflags = extractDynFlags env + dflags' = doDynamicToo dflags + env' = replaceDynFlags env dflags' + setEnv env' m +\end{code} + +\begin{code} getEpsVar :: TcRnIf gbl lcl (TcRef ExternalPackageState) getEpsVar = do { env <- getTopEnv; return (hsc_EPS env) } _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
