Don't store LlvmConfig into DynFlags

LlvmConfig contains information read from llvm-passes and llvm-targets
files in GHC's top directory. Reading these files is done only when
needed (i.e. when the LLVM backend is used) and cached for the whole
compiler session. This patch changes the way this is done:

- Split LlvmConfig into LlvmConfig and LlvmConfigCache

- Store LlvmConfigCache in HscEnv instead of DynFlags: there is no
  good reason to store it in DynFlags. As it is fixed per session, we
  store it in the session state instead (HscEnv).

- Initializing LlvmConfigCache required some changes to driver functions
  such as newHscEnv. I've used the opportunity to untangle initHscEnv
  from initGhcMonad (in top-level GHC module) and to move it to
  GHC.Driver.Main, close to newHscEnv.

- I've also made `cmmPipeline` independent of HscEnv in order to remove
  the call to newHscEnv in regalloc_unit_tests.

2 files changed, 113 insertions, 50 deletions

diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index cc4377240b..338aa3a927 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -15,10 +15,6 @@ module GHC.CmmToLlvm.Base (
         LiveGlobalRegs,
         LlvmUnresData, LlvmData, UnresLabel, UnresStatic,
 
-        LlvmVersion, supportedLlvmVersionLowerBound, supportedLlvmVersionUpperBound,
-        llvmVersionSupported, parseLlvmVersion,
-        llvmVersionStr, llvmVersionList,
-
         LlvmM,
         runLlvm, withClearVars, varLookup, varInsert,
         markStackReg, checkStackReg,
@@ -66,10 +62,8 @@ import GHC.Utils.Logger
 
 import Data.Maybe (fromJust)
 import Control.Monad (ap)
-import Data.Char (isDigit)
-import Data.List (sortBy, groupBy, intercalate)
+import Data.List (sortBy, groupBy)
 import Data.Ord (comparing)
-import qualified Data.List.NonEmpty as NE
 
 -- ----------------------------------------------------------------------------
 -- * Some Data Types
@@ -261,42 +255,6 @@ llvmPtrBits :: Platform -> Int
 llvmPtrBits platform = widthInBits $ typeWidth $ gcWord platform
 
 -- ----------------------------------------------------------------------------
--- * Llvm Version
---
-
-parseLlvmVersion :: String -> Maybe LlvmVersion
-parseLlvmVersion =
-    fmap LlvmVersion . NE.nonEmpty . go [] . dropWhile (not . isDigit)
-  where
-    go vs s
-      | null ver_str
-      = reverse vs
-      | '.' : rest' <- rest
-      = go (read ver_str : vs) rest'
-      | otherwise
-      = reverse (read ver_str : vs)
-      where
-        (ver_str, rest) = span isDigit s
-
--- | The (inclusive) lower bound on the LLVM Version that is currently supported.
-supportedLlvmVersionLowerBound :: LlvmVersion
-supportedLlvmVersionLowerBound = LlvmVersion (sUPPORTED_LLVM_VERSION_MIN NE.:| [])
-
--- | The (not-inclusive) upper bound  bound on the LLVM Version that is currently supported.
-supportedLlvmVersionUpperBound :: LlvmVersion
-supportedLlvmVersionUpperBound = LlvmVersion (sUPPORTED_LLVM_VERSION_MAX NE.:| [])
-
-llvmVersionSupported :: LlvmVersion -> Bool
-llvmVersionSupported v =
-  v >= supportedLlvmVersionLowerBound && v < supportedLlvmVersionUpperBound
-
-llvmVersionStr :: LlvmVersion -> String
-llvmVersionStr = intercalate "." . map show . llvmVersionList
-
-llvmVersionList :: LlvmVersion -> [Int]
-llvmVersionList = NE.toList . llvmVersionNE
-
--- ----------------------------------------------------------------------------
 -- * Environment Handling
 --
 
diff --git a/compiler/GHC/CmmToLlvm/Config.hs b/compiler/GHC/CmmToLlvm/Config.hs
index 84455a8b2c..f516b9787b 100644
--- a/compiler/GHC/CmmToLlvm/Config.hs
+++ b/compiler/GHC/CmmToLlvm/Config.hs
@@ -1,20 +1,35 @@
+{-# LANGUAGE CPP #-}
+
 -- | Llvm code generator configuration
 module GHC.CmmToLlvm.Config
   ( LlvmCgConfig(..)
+  , LlvmConfig(..)
+  , LlvmTarget(..)
+  , initLlvmConfig
+  -- * LLVM version
   , LlvmVersion(..)
+  , supportedLlvmVersionLowerBound
+  , supportedLlvmVersionUpperBound
+  , parseLlvmVersion
+  , llvmVersionSupported
+  , llvmVersionStr
+  , llvmVersionList
   )
 where
 
+#include "ghc-llvm-version.h"
+
 import GHC.Prelude
 import GHC.Platform
 
 import GHC.Utils.Outputable
-import GHC.Driver.Session
+import GHC.Settings.Utils
+import GHC.Utils.Panic
 
+import Data.Char (isDigit)
+import Data.List (intercalate)
 import qualified Data.List.NonEmpty as NE
-
-newtype LlvmVersion = LlvmVersion { llvmVersionNE :: NE.NonEmpty Int }
-  deriving (Eq, Ord)
+import System.FilePath
 
 data LlvmCgConfig = LlvmCgConfig
   { llvmCgPlatform          :: !Platform     -- ^ Target platform
@@ -25,7 +40,97 @@ data LlvmCgConfig = LlvmCgConfig
   , llvmCgLlvmVersion       :: Maybe LlvmVersion -- ^ version of Llvm we're using
   , llvmCgDoWarn            :: !Bool         -- ^ True ==> warn unsupported Llvm version
   , llvmCgLlvmTarget        :: !String       -- ^ target triple passed to LLVM
-  , llvmCgLlvmConfig        :: !LlvmConfig   -- ^ mirror DynFlags LlvmConfig.
-    -- see Note [LLVM configuration] in "GHC.SysTools". This can be strict since
-    -- GHC.Driver.Config.CmmToLlvm.initLlvmCgConfig verifies the files are present.
+  , llvmCgLlvmConfig        :: !LlvmConfig   -- ^ Supported LLVM configurations.
+                                             -- see Note [LLVM configuration]
+  }
+
+data LlvmTarget = LlvmTarget
+  { lDataLayout :: String
+  , lCPU        :: String
+  , lAttributes :: [String]
+  }
+
+-- Note [LLVM configuration]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The `llvm-targets` and `llvm-passes` files are shipped with GHC and contain
+-- information needed by the LLVM backend to invoke `llc` and `opt`.
+-- Specifically:
+--
+--  * llvm-targets maps autoconf host triples to the corresponding LLVM
+--    `data-layout` declarations. This information is extracted from clang using
+--    the script in utils/llvm-targets/gen-data-layout.sh and should be updated
+--    whenever we target a new version of LLVM.
+--
+--  * llvm-passes maps GHC optimization levels to sets of LLVM optimization
+--    flags that GHC should pass to `opt`.
+--
+-- This information is contained in files rather the GHC source to allow users
+-- to add new targets to GHC without having to recompile the compiler.
+--
+
+initLlvmConfig :: FilePath -> IO LlvmConfig
+initLlvmConfig top_dir
+  = do
+      targets <- readAndParse "llvm-targets"
+      passes <- readAndParse "llvm-passes"
+      return $ LlvmConfig
+        { llvmTargets = fmap mkLlvmTarget <$> targets
+        , llvmPasses = passes
+        }
+  where
+    readAndParse :: Read a => String -> IO a
+    readAndParse name = do
+      let f = top_dir </> name
+      llvmConfigStr <- readFile f
+      case maybeReadFuzzy llvmConfigStr of
+        Just s -> return s
+        Nothing -> pgmError ("Can't parse LLVM config file: " ++ show f)
+
+    mkLlvmTarget :: (String, String, String) -> LlvmTarget
+    mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs)
+
+data LlvmConfig = LlvmConfig
+  { llvmTargets :: [(String, LlvmTarget)]
+  , llvmPasses  :: [(Int, String)]
   }
+
+
+---------------------------------------------------------
+-- LLVM version
+---------------------------------------------------------
+
+newtype LlvmVersion = LlvmVersion { llvmVersionNE :: NE.NonEmpty Int }
+  deriving (Eq, Ord)
+
+parseLlvmVersion :: String -> Maybe LlvmVersion
+parseLlvmVersion =
+    fmap LlvmVersion . NE.nonEmpty . go [] . dropWhile (not . isDigit)
+  where
+    go vs s
+      | null ver_str
+      = reverse vs
+      | '.' : rest' <- rest
+      = go (read ver_str : vs) rest'
+      | otherwise
+      = reverse (read ver_str : vs)
+      where
+        (ver_str, rest) = span isDigit s
+
+-- | The (inclusive) lower bound on the LLVM Version that is currently supported.
+supportedLlvmVersionLowerBound :: LlvmVersion
+supportedLlvmVersionLowerBound = LlvmVersion (sUPPORTED_LLVM_VERSION_MIN NE.:| [])
+
+-- | The (not-inclusive) upper bound  bound on the LLVM Version that is currently supported.
+supportedLlvmVersionUpperBound :: LlvmVersion
+supportedLlvmVersionUpperBound = LlvmVersion (sUPPORTED_LLVM_VERSION_MAX NE.:| [])
+
+llvmVersionSupported :: LlvmVersion -> Bool
+llvmVersionSupported v =
+  v >= supportedLlvmVersionLowerBound && v < supportedLlvmVersionUpperBound
+
+llvmVersionStr :: LlvmVersion -> String
+llvmVersionStr = intercalate "." . map show . llvmVersionList
+
+llvmVersionList :: LlvmVersion -> [Int]
+llvmVersionList = NE.toList . llvmVersionNE
+