[commit: ghc] wip/T11295-part1: need to actually make the llvm-passes file now (d7cb5bb)

[git at git.haskell.org]

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

On branch  : wip/T11295-part1
Link       : http://ghc.haskell.org/trac/ghc/changeset/d7cb5bb351e7cc2e75de518705ec73afc54263d0/ghc

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

commit d7cb5bb351e7cc2e75de518705ec73afc54263d0
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Mon May 14 21:36:07 2018 -0500

    need to actually make the llvm-passes file now


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

d7cb5bb351e7cc2e75de518705ec73afc54263d0
 compiler/main/DynFlags.hs | 13 +++++++++----
 compiler/main/GHC.hs      |  4 ++--
 compiler/main/SysTools.hs | 26 ++++++++++++++++----------
 3 files changed, 27 insertions(+), 16 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 25e99ee..7fb9703 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -79,7 +79,7 @@ module DynFlags (
         unsafeFlags, unsafeFlagsForInfer,
 
         -- ** LLVM Targets
-        LlvmTarget(..), LlvmTargets,
+        LlvmTarget(..), LlvmTargets, LlvmPasses, LlvmConfig,
 
         -- ** System tool settings and locations
         Settings(..),
@@ -828,6 +828,7 @@ data DynFlags = DynFlags {
   hscTarget             :: HscTarget,
   settings              :: Settings,
   llvmTargets           :: LlvmTargets,
+  llvmPasses            :: LlvmPasses,
   verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]
   optLevel              :: Int,         -- ^ Optimisation level
   debugLevel            :: Int,         -- ^ How much debug information to produce
@@ -1144,6 +1145,8 @@ data LlvmTarget = LlvmTarget
   }
 
 type LlvmTargets = [(String, LlvmTarget)]
+type LlvmPasses = [(Int, String)]
+type LlvmConfig = (LlvmTargets, LlvmPasses)
 
 data Settings = Settings {
   sTargetPlatform        :: Platform,       -- Filled in by SysTools
@@ -1720,8 +1723,8 @@ 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 -> LlvmTargets -> DynFlags
-defaultDynFlags mySettings myLlvmTargets =
+defaultDynFlags :: Settings -> LlvmConfig -> DynFlags
+defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
 -- See Note [Updating flag description in the User's Guide]
      DynFlags {
         ghcMode                 = CompManager,
@@ -1816,6 +1819,7 @@ defaultDynFlags mySettings myLlvmTargets =
         splitInfo               = Nothing,
         settings                = mySettings,
         llvmTargets             = myLlvmTargets,
+        llvmPasses              = myLlvmPasses,
 
         -- ghc -M values
         depMakefile       = "Makefile",
@@ -5464,10 +5468,11 @@ makeDynFlagsConsistent dflags
 -- initialized.
 defaultGlobalDynFlags :: DynFlags
 defaultGlobalDynFlags =
-    (defaultDynFlags settings llvmTargets) { verbosity = 2 }
+    (defaultDynFlags settings (llvmTargets, llvmPasses)) { verbosity = 2 }
   where
     settings = panic "v_unsafeGlobalDynFlags: settings not initialised"
     llvmTargets = panic "v_unsafeGlobalDynFlags: llvmTargets not initialised"
+    llvmPasses = panic "v_unsafeGlobalDynFlags: llvmPasses not initialised"
 
 #if STAGE < 2
 GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 5f1eba5..49e6c21 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -492,8 +492,8 @@ initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
 initGhcMonad mb_top_dir
   = do { env <- liftIO $
                 do { mySettings <- initSysTools mb_top_dir
-                   ; myLlvmTargets <- initLlvmTargets mb_top_dir
-                   ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmTargets)
+                   ; myLlvmConfig <- initLlvmConfig mb_top_dir
+                   ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig)
                    ; checkBrokenTablesNextToCode dflags
                    ; setUnsafeGlobalDynFlags dflags
                       -- c.f. DynFlags.parseDynamicFlagsFull, which
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index 619e0b6..8d7d1ea 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -13,7 +13,7 @@
 module SysTools (
         -- * Initialisation
         initSysTools,
-        initLlvmTargets,
+        initLlvmConfig,
 
         -- * Interface to system tools
         module SysTools.Tasks,
@@ -110,16 +110,22 @@ stuff.
 ************************************************************************
 -}
 
-initLlvmTargets :: Maybe String
-                -> IO LlvmTargets
-initLlvmTargets mbMinusB
-  = do top_dir <- findTopDir mbMinusB
-       let llvmTargetsFile = top_dir </> "llvm-targets"
-       llvmTargetsStr <- readFile llvmTargetsFile
-       case maybeReadFuzzy llvmTargetsStr of
-         Just s -> return (fmap mkLlvmTarget <$> s)
-         Nothing -> pgmError ("Can't parse " ++ show llvmTargetsFile)
+initLlvmConfig :: Maybe String
+                -> IO LlvmConfig
+initLlvmConfig mbMinusB
+  = do
+      tgts <- readAndParse "llvm-targets" mkLlvmTarget
+      passes <- readAndParse "llvm-passes" id
+      return (tgts, passes)
   where
+    readAndParse name bldr =
+      do top_dir <- findTopDir mbMinusB
+         let llvmConfigFile = top_dir </> name
+         llvmConfigStr <- readFile llvmConfigFile
+         case maybeReadFuzzy llvmConfigStr of
+           Just s -> return (fmap bldr <$> s)
+           Nothing -> pgmError ("Can't parse " ++ show llvmConfigFile)
+
     mkLlvmTarget :: (String, String, String) -> LlvmTarget
     mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs)