Commit ecd96761 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

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.
parent 0c4a9f38
......@@ -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
......
......@@ -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.
......
......@@ -305,6 +305,15 @@ getGhcMode :: TcRnIf gbl lcl GhcMode
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) }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment