Refactor, document, and optimize LLVM configuration loading

As described in the new Note [LLVM Configuration] in SysTools, we now
load llvm-targets and llvm-passes lazily to avoid the overhead of doing
so when -fllvm isn't used (also known as "the common case").

Noticed in #17003.

Metric Decrease:
    T12234
    T12150

8 files changed, 59 insertions, 31 deletions

diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index cc86c4254e..b566b99a1f 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -94,12 +94,18 @@ llvmCodeGen' cmm_stream
     header :: SDoc
     header = sdocWithDynFlags $ \dflags ->
       let target = platformMisc_llvmTarget $ platformMisc dflags
-          layout = case lookup target (llvmTargets dflags) of
-            Just (LlvmTarget dl _ _) -> dl
-            Nothing -> error $ "Failed to lookup the datalayout for " ++ target ++ "; available targets: " ++ show (map fst $ llvmTargets dflags)
-      in     text ("target datalayout = \"" ++ layout ++ "\"")
+      in     text ("target datalayout = \"" ++ getDataLayout dflags target ++ "\"")
          $+$ text ("target triple = \"" ++ target ++ "\"")
 
+    getDataLayout :: DynFlags -> String -> String
+    getDataLayout dflags target =
+      case lookup target (llvmTargets $ llvmConfig dflags) of
+        Just (LlvmTarget {lDataLayout=dl}) -> dl
+        Nothing -> pprPanic "Failed to lookup LLVM data layout" $
+                   text "Target:" <+> text target $$
+                   hang (text "Available targets:") 4
+                        (vcat $ map (text . fst) $ llvmTargets $ llvmConfig dflags)
+
 llvmGroupLlvmGens :: RawCmmGroup -> LlvmM ()
 llvmGroupLlvmGens cmm = do
 
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 87128c2b6e..a71f4d991b 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -901,7 +901,7 @@ llvmOptions dflags =
     ++ [("", "-mattr=" ++ attrs) | not (null attrs) ]
 
   where target = platformMisc_llvmTarget $ platformMisc dflags
-        Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets dflags)
+        Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets $ llvmConfig dflags)
 
         -- Relocation models
         rmodel | gopt Opt_PIC dflags        = "pic"
@@ -1450,7 +1450,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
         -- we always (unless -optlo specified) run Opt since we rely on it to
         -- fix up some pretty big deficiencies in the code we generate
         optIdx = max 0 $ min 2 $ optLevel dflags  -- ensure we're in [0,2]
-        llvmOpts = case lookup optIdx $ llvmPasses dflags of
+        llvmOpts = case lookup optIdx $ llvmPasses $ llvmConfig dflags of
                     Just passes -> passes
                     Nothing -> panic ("runPhase LlvmOpt: llvm-passes file "
                                       ++ "is missing passes for level "
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 465dd2737b..146020887b 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -83,7 +83,7 @@ module DynFlags (
         unsafeFlags, unsafeFlagsForInfer,
 
         -- ** LLVM Targets
-        LlvmTarget(..), LlvmTargets, LlvmPasses, LlvmConfig,
+        LlvmTarget(..), LlvmConfig(..),
 
         -- ** System tool settings and locations
         Settings(..),
@@ -970,8 +970,9 @@ data DynFlags = DynFlags {
   integerLibrary        :: IntegerLibrary,
     -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden
     --   by GHC-API users. See Note [The integer library] in PrelNames
-  llvmTargets           :: LlvmTargets,
-  llvmPasses            :: LlvmPasses,
+  llvmConfig            :: LlvmConfig,
+    -- ^ N.B. It's important that this field is lazy since we load the LLVM
+    -- configuration lazily. See Note [LLVM Configuration] in SysTools.
   verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]
   optLevel              :: Int,         -- ^ Optimisation level
   debugLevel            :: Int,         -- ^ How much debug information to produce
@@ -1391,9 +1392,10 @@ data LlvmTarget = LlvmTarget
   , lAttributes :: [String]
   }
 
-type LlvmTargets = [(String, LlvmTarget)]
-type LlvmPasses = [(Int, String)]
-type LlvmConfig = (LlvmTargets, LlvmPasses)
+-- | See Note [LLVM Configuration] in SysTools.
+data LlvmConfig = LlvmConfig { llvmTargets :: [(String, LlvmTarget)]
+                             , llvmPasses  :: [(Int, String)]
+                             }
 
 -----------------------------------------------------------------------------
 -- Accessessors from 'DynFlags'
@@ -1924,7 +1926,7 @@ initDynFlags dflags = do
 -- | The normal 'DynFlags'. Note that they are not suitable for use in this form
 -- and must be fully initialized by 'GHC.runGhc' first.
 defaultDynFlags :: Settings -> LlvmConfig -> DynFlags
-defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
+defaultDynFlags mySettings llvmConfig =
 -- See Note [Updating flag description in the User's Guide]
      DynFlags {
         ghcMode                 = CompManager,
@@ -2035,8 +2037,8 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
         platformConstants = sPlatformConstants mySettings,
         rawSettings = sRawSettings mySettings,
 
-        llvmTargets             = myLlvmTargets,
-        llvmPasses              = myLlvmPasses,
+        -- See Note [LLVM configuration].
+        llvmConfig              = llvmConfig,
 
         -- ghc -M values
         depMakefile       = "Makefile",
@@ -5731,11 +5733,10 @@ makeDynFlagsConsistent dflags
 -- initialized.
 defaultGlobalDynFlags :: DynFlags
 defaultGlobalDynFlags =
-    (defaultDynFlags settings (llvmTargets, llvmPasses)) { verbosity = 2 }
+    (defaultDynFlags settings llvmConfig) { verbosity = 2 }
   where
     settings = panic "v_unsafeGlobalDynFlags: settings not initialised"
-    llvmTargets = panic "v_unsafeGlobalDynFlags: llvmTargets not initialised"
-    llvmPasses = panic "v_unsafeGlobalDynFlags: llvmPasses not initialised"
+    llvmConfig = panic "v_unsafeGlobalDynFlags: llvmConfig not initialised"
 
 #if STAGE < 2
 GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index f948f454a7..dc336e3914 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -505,7 +505,7 @@ initGhcMonad mb_top_dir
   = do { env <- liftIO $
                 do { top_dir <- findTopDir mb_top_dir
                    ; mySettings <- initSysTools top_dir
-                   ; myLlvmConfig <- initLlvmConfig top_dir
+                   ; myLlvmConfig <- lazyInitLlvmConfig top_dir
                    ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig)
                    ; checkBrokenTablesNextToCode dflags
                    ; setUnsafeGlobalDynFlags dflags
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index fa339bbb87..b3312b0dae 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -13,7 +13,7 @@
 module SysTools (
         -- * Initialisation
         initSysTools,
-        initLlvmConfig,
+        lazyInitLlvmConfig,
 
         -- * Interface to system tools
         module SysTools.Tasks,
@@ -52,6 +52,7 @@ import DynFlags
 import Control.Monad.Trans.Except (runExceptT)
 import System.FilePath
 import System.IO
+import System.IO.Unsafe (unsafeInterleaveIO)
 import SysTools.ExtraObj
 import SysTools.Info
 import SysTools.Tasks
@@ -110,13 +111,34 @@ stuff.
 ************************************************************************
 -}
 
-initLlvmConfig :: 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.
+--
+-- Since this information is only needed by the LLVM backend we load it lazily
+-- with unsafeInterleaveIO. Consequently it is important that we lazily pattern
+-- match on LlvmConfig until we actually need its contents.
+
+lazyInitLlvmConfig :: String
                -> IO LlvmConfig
-initLlvmConfig top_dir
-  = do
+lazyInitLlvmConfig top_dir
+  = unsafeInterleaveIO $ do    -- see Note [LLVM configuration]
       targets <- readAndParse "llvm-targets" mkLlvmTarget
       passes <- readAndParse "llvm-passes" id
-      return (targets, passes)
+      return $ LlvmConfig { llvmTargets = targets, llvmPasses = passes }
   where
     readAndParse name builder =
       do let llvmConfigFile = top_dir </> name
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index e70992f667..4432244dca 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -2775,9 +2775,7 @@ showDynFlags show_all dflags = do
                 is_on = test f dflags
                 quiet = not show_all && test f default_dflags == is_on
 
-        llvmConfig = (llvmTargets dflags, llvmPasses dflags)
-
-        default_dflags = defaultDynFlags (settings dflags) llvmConfig
+        default_dflags = defaultDynFlags (settings dflags) (llvmConfig dflags)
 
         (ghciFlags,others)  = partition (\f -> flagSpecFlag f `elem` flgs)
                                         DynFlags.fFlags
@@ -3229,10 +3227,8 @@ showLanguages' show_all dflags =
                 is_on = test f dflags
                 quiet = not show_all && test f default_dflags == is_on
 
-   llvmConfig = (llvmTargets dflags, llvmPasses dflags)
-
    default_dflags =
-       defaultDynFlags (settings dflags) llvmConfig `lang_set`
+       defaultDynFlags (settings dflags) (llvmConfig dflags) `lang_set`
          case language dflags of
            Nothing -> Just Haskell2010
            other   -> other
diff --git a/testsuite/tests/hiefile/should_run/PatTypes.hs b/testsuite/tests/hiefile/should_run/PatTypes.hs
index af5c42defa..7948c43473 100644
--- a/testsuite/tests/hiefile/should_run/PatTypes.hs
+++ b/testsuite/tests/hiefile/should_run/PatTypes.hs
@@ -40,7 +40,7 @@ makeNc = do
 dynFlagsForPrinting :: String -> IO DynFlags
 dynFlagsForPrinting libdir = do
   systemSettings <- initSysTools libdir
-  return $ defaultDynFlags systemSettings ([], [])
+  return $ defaultDynFlags systemSettings (LlvmConfig [] [])
 
 selectPoint :: HieFile -> (Int,Int) -> HieAST Int
 selectPoint hf (sl,sc) = case M.toList (getAsts $ hie_asts hf) of
diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh
index 450d21903c..e55f6eccd9 100755
--- a/utils/llvm-targets/gen-data-layout.sh
+++ b/utils/llvm-targets/gen-data-layout.sh
@@ -15,6 +15,9 @@
 #
 # Add missing targets to the list below to have them included in
 # llvm-targets file.
+#
+# See Note [LLVM Configuration] in SysTools for the whole story regarding LLVM
+# configuration data.
 
 # Target sets for which to generate the llvm-targets file
 TARGETS=(