[commit: ghc] master: Add the beginnings of support for building vanilla and dynamic at the same time (b25d709)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b25d70908b8f843ecd6502281dc1d3c5dfde3876

>---------------------------------------------------------------

commit b25d70908b8f843ecd6502281dc1d3c5dfde3876
Author: Ian Lynagh <[email protected]>
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))