Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b25d70908b8f843ecd6502281dc1d3c5dfde3876 >--------------------------------------------------------------- commit b25d70908b8f843ecd6502281dc1d3c5dfde3876 Author: Ian Lynagh <i...@well-typed.com> Date: Wed Dec 5 21:42:50 2012 +0000 Add the beginnings of support for building vanilla and dynamic at the same time >--------------------------------------------------------------- compiler/iface/LoadIface.lhs | 21 ++++++++++++++++++++- compiler/main/DynFlags.hs | 25 ++++++++++++++++++++++--- 2 files changed, 42 insertions(+), 4 deletions(-) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 01a0d97..3174135 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -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. diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index a2d75e5..8686e55 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -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)) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
