[commit: ghc] master: Cache compiler info in DynFlags (3428f76)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3428f76e50508be4cbc85c8f72b0ad1dc784b0d4/ghc

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

commit 3428f76e50508be4cbc85c8f72b0ad1dc784b0d4
Author: Austin Seipp <austin at well-typed.com>
Date:   Wed Jan 15 18:56:44 2014 -0600

    Cache compiler info in DynFlags
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


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

3428f76e50508be4cbc85c8f72b0ad1dc784b0d4
 compiler/main/DynFlags.hs  |   26 ++++++++++++++++-----
 compiler/main/SysTools.lhs |   54 ++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 72 insertions(+), 8 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index f720db0..35e9c7e 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -138,8 +138,9 @@ module DynFlags (
         isAvx512fEnabled,
         isAvx512pfEnabled,
 
-        -- * Linker information
+        -- * Linker/compiler information
         LinkerInfo(..),
+        CompilerInfo(..),
   ) where
 
 #include "HsVersions.h"
@@ -792,7 +793,10 @@ data DynFlags = DynFlags {
   avx512pf              :: Bool, -- Enable AVX-512 PreFetch Instructions.
 
   -- | Run-time linker information (what options we need, etc.)
-  rtldFlags             :: IORef (Maybe LinkerInfo)
+  rtldInfo              :: IORef (Maybe LinkerInfo),
+
+  -- | Run-time compiler information
+  rtccInfo              :: IORef (Maybe CompilerInfo)
  }
 
 class HasDynFlags m where
@@ -1270,7 +1274,8 @@ initDynFlags dflags = do
  refFilesToNotIntermediateClean <- newIORef []
  refGeneratedDumps <- newIORef Set.empty
  refLlvmVersion <- newIORef 28
- refRtldFlags <- newIORef Nothing
+ refRtldInfo <- newIORef Nothing
+ refRtccInfo <- newIORef Nothing
  wrapperNum <- newIORef emptyModuleEnv
  canUseUnicodeQuotes <- do let enc = localeEncoding
                                str = "‛’"
@@ -1288,7 +1293,8 @@ initDynFlags dflags = do
         llvmVersion    = refLlvmVersion,
         nextWrapperNum = wrapperNum,
         useUnicodeQuotes = canUseUnicodeQuotes,
-        rtldFlags      = refRtldFlags
+        rtldInfo      = refRtldInfo,
+        rtccInfo      = refRtccInfo
         }
 
 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
@@ -1438,7 +1444,8 @@ defaultDynFlags mySettings =
         avx512er = False,
         avx512f = False,
         avx512pf = False,
-        rtldFlags = panic "defaultDynFlags: no rtldFlags"
+        rtldInfo = panic "defaultDynFlags: no rtldInfo",
+        rtccInfo = panic "defaultDynFlags: no rtccInfo"
       }
 
 defaultWays :: Settings -> [Way]
@@ -3722,7 +3729,7 @@ isAvx512pfEnabled :: DynFlags -> Bool
 isAvx512pfEnabled dflags = avx512pf dflags
 
 -- -----------------------------------------------------------------------------
--- Linker information
+-- Linker/compiler information
 
 -- LinkerInfo contains any extra options needed by the system linker.
 data LinkerInfo
@@ -3733,6 +3740,13 @@ data LinkerInfo
   | UnknownLD
   deriving Eq
 
+-- CompilerInfo tells us which C compiler we're using
+data CompilerInfo
+   = GCC
+   | Clang
+   | UnknownCC
+   deriving Eq
+
 -- -----------------------------------------------------------------------------
 -- RTS hooks
 
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index c179356..2150c6d 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -25,6 +25,7 @@ module SysTools (
         readElfSection,
 
         getLinkerInfo,
+        getCompilerInfo,
 
         linkDynLib,
 
@@ -644,12 +645,12 @@ neededLinkArgs UnknownLD     = []
 -- Grab linker info and cache it in DynFlags.
 getLinkerInfo :: DynFlags -> IO LinkerInfo
 getLinkerInfo dflags = do
-  info <- readIORef (rtldFlags dflags)
+  info <- readIORef (rtldInfo dflags)
   case info of
     Just v  -> return v
     Nothing -> do
       v <- getLinkerInfo' dflags
-      writeIORef (rtldFlags dflags) (Just v)
+      writeIORef (rtldInfo dflags) (Just v)
       return v
 
 -- See Note [Run-time linker info].
@@ -721,6 +722,55 @@ getLinkerInfo' dflags = do
                 return UnknownLD)
   return info
 
+-- Grab compiler info and cache it in DynFlags.
+getCompilerInfo :: DynFlags -> IO CompilerInfo
+getCompilerInfo dflags = do
+  info <- readIORef (rtccInfo dflags)
+  case info of
+    Just v  -> return v
+    Nothing -> do
+      v <- getCompilerInfo' dflags
+      writeIORef (rtccInfo dflags) (Just v)
+      return v
+
+-- See Note [Run-time linker info].
+getCompilerInfo' :: DynFlags -> IO CompilerInfo
+getCompilerInfo' dflags = do
+  let (pgm,_) = pgm_c dflags
+      -- Try to grab the info from the process output.
+      parseCompilerInfo _stdo stde _exitc
+        -- Regular GCC
+        | any ("gcc version" `isPrefixOf`) stde =
+          return GCC
+        -- Regular clang
+        | any ("clang version" `isPrefixOf`) stde =
+          return Clang
+        -- XCode 5 clang
+        | any ("Apple LLVM version" `isPrefixOf`) stde =
+          return Clang
+        -- XCode 4.1 clang
+        | any ("Apple clang version" `isPrefixOf`) stde =
+          return Clang
+         -- Unknown linker.
+        | otherwise = fail "invalid -v output, or compiler is unsupported"
+
+  -- Process the executable call
+  info <- catchIO (do
+                (exitc, stdo, stde) <- readProcessWithExitCode pgm ["-v"] ""
+                -- Split the output by lines to make certain kinds
+                -- of processing easier.
+                parseCompilerInfo (lines stdo) (lines stde) exitc
+            )
+            (\err -> do
+                debugTraceMsg dflags 2
+                    (text "Error (figuring out compiler information):" <+>
+                     text (show err))
+                errorMsg dflags $ hang (text "Warning:") 9 $
+                  text "Couldn't figure out linker information!" $$
+                  text "Make sure you're using GNU gcc, or clang"
+                return UnknownCC)
+  return info
+
 runLink :: DynFlags -> [Option] -> IO ()
 runLink dflags args = do
   -- See Note [Run-time linker info]