Commit b25d7090 authored by ian@well-typed.com's avatar ian@well-typed.com

Add the beginnings of support for building vanilla and dynamic at the same time

parent 71b5ca5a
......@@ -61,6 +61,8 @@ import FastString
import Fingerprint
import Control.Monad
import Data.IORef
import System.FilePath
\end{code}
......@@ -515,7 +517,9 @@ findAndReadIface doc_str mod hi_boot_file
if thisPackage dflags == modulePackageId mod &&
not (isOneShot (ghcMode dflags))
then return (Failed (homeModError mod loc))
else read_file file_path
else do r <- read_file file_path
checkBuildDynamicToo r
return r
err -> do
traceIf (ptext (sLit "...not found"))
dflags <- getDynFlags
......@@ -532,6 +536,21 @@ findAndReadIface doc_str mod hi_boot_file
| otherwise ->
return (Succeeded (iface, file_path))
-- Don't forget to fill in the package name...
checkBuildDynamicToo (Succeeded (iface, filePath)) = do
dflags <- getDynFlags
when (gopt Opt_BuildDynamicToo dflags) $ do
let ref = canGenerateDynamicToo dflags
b <- liftIO $ readIORef ref
when b $ do
let dynFilePath = replaceExtension filePath (dynHiSuf dflags)
r <- read_file dynFilePath
case r of
Succeeded (dynIface, _)
| mi_mod_hash iface == mi_mod_hash dynIface ->
return ()
_ ->
liftIO $ writeIORef ref False
checkBuildDynamicToo _ = return ()
\end{code}
@readIface@ tries just the one file.
......
......@@ -371,6 +371,8 @@ data GeneralFlag
| Opt_KeepRawTokenStream
| Opt_KeepLlvmFiles
| Opt_BuildDynamicToo
-- safe haskell flags
| Opt_DistrustAllPackages
| Opt_PackageTrust
......@@ -576,6 +578,10 @@ data DynFlags = DynFlags {
hcSuf :: String,
hiSuf :: String,
canGenerateDynamicToo :: IORef Bool,
dynObjectSuf :: String,
dynHiSuf :: String,
outputFile :: Maybe String,
outputHi :: Maybe String,
dynLibLoader :: DynLibLoader,
......@@ -1108,6 +1114,7 @@ wayOptP _ WayNDP = []
-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
refCanGenerateDynamicToo <- newIORef False
refFilesToClean <- newIORef []
refDirsToClean <- newIORef Map.empty
refFilesToNotIntermediateClean <- newIORef []
......@@ -1115,6 +1122,7 @@ initDynFlags dflags = do
refLlvmVersion <- newIORef 28
wrapperNum <- newIORef 0
return dflags{
canGenerateDynamicToo = refCanGenerateDynamicToo,
filesToClean = refFilesToClean,
dirsToClean = refDirsToClean,
filesToNotIntermediateClean = refFilesToNotIntermediateClean,
......@@ -1165,6 +1173,10 @@ defaultDynFlags mySettings =
hcSuf = phaseInputExt HCc,
hiSuf = "hi",
canGenerateDynamicToo = panic "defaultDynFlags: No canGenerateDynamicToo",
dynObjectSuf = "dyn_" ++ phaseInputExt StopLn,
dynHiSuf = "dyn_hi",
pluginModNames = [],
pluginModNameOpts = [],
......@@ -1533,6 +1545,7 @@ getVerbFlags dflags
| otherwise = []
setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
setDynObjectSuf, setDynHiSuf,
setDylibInstallName,
setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, addOptl, addOptc, addOptP,
......@@ -1552,9 +1565,11 @@ setDumpDir f d = d{ dumpDir = Just f}
setOutputDir f = setObjectDir f . setHiDir f . setStubDir f . setDumpDir f
setDylibInstallName f d = d{ dylibInstallName = Just f}
setObjectSuf f d = d{ objectSuf = f}
setHiSuf f d = d{ hiSuf = f}
setHcSuf f d = d{ hcSuf = f}
setObjectSuf f d = d{ objectSuf = f}
setDynObjectSuf f d = d{ dynObjectSuf = f}
setHiSuf f d = d{ hiSuf = f}
setDynHiSuf f d = d{ dynHiSuf = f}
setHcSuf f d = d{ hcSuf = f}
setOutputFile f d = d{ outputFile = f}
setOutputHi f d = d{ outputHi = f}
......@@ -1934,8 +1949,10 @@ dynamic_flags = [
, Flag "o" (sepArg (setOutputFile . Just))
, Flag "ohi" (hasArg (setOutputHi . Just ))
, Flag "osuf" (hasArg setObjectSuf)
, Flag "dynosuf" (hasArg setDynObjectSuf)
, Flag "hcsuf" (hasArg setHcSuf)
, Flag "hisuf" (hasArg setHiSuf)
, Flag "dynhisuf" (hasArg setDynHiSuf)
, Flag "hidir" (hasArg setHiDir)
, Flag "tmpdir" (hasArg setTmpDir)
, Flag "stubdir" (hasArg setStubDir)
......@@ -1943,6 +1960,8 @@ dynamic_flags = [
, Flag "outputdir" (hasArg setOutputDir)
, Flag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
, Flag "dynamic-too" (NoArg (setGeneralFlag Opt_BuildDynamicToo))
------- Keeping temporary files -------------------------------------
-- These can be singular (think ghc -c) or plural (think ghc --make)
, Flag "keep-hc-file" (NoArg (setGeneralFlag Opt_KeepHcFiles))
......
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