Commit f64f06be authored by Michael Sloan's avatar Michael Sloan Committed by Krzysztof Gogolewski

Avoid redundant invocation of 'findTopDir'

Summary:
While working on [D904](https://phabricator.haskell.org/D4904), I noticed that
'findTopDir' was being invoked three times.  This isn't a big problem, because
it is usually very cheap.  On windows, it does require some involved logic,
though, so to me it would make sense to only run it once.

Reviewers: bgamari, monoidal

Reviewed By: monoidal

Subscribers: rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4987
parent 99f45e2a
...@@ -326,6 +326,7 @@ import HscTypes ...@@ -326,6 +326,7 @@ import HscTypes
import CmdLineParser import CmdLineParser
import DynFlags hiding (WarnReason(..)) import DynFlags hiding (WarnReason(..))
import SysTools import SysTools
import SysTools.BaseDir
import Annotations import Annotations
import Module import Module
import Panic import Panic
...@@ -494,8 +495,9 @@ withCleanupSession ghc = ghc `gfinally` cleanup ...@@ -494,8 +495,9 @@ withCleanupSession ghc = ghc `gfinally` cleanup
initGhcMonad :: GhcMonad m => Maybe FilePath -> m () initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
initGhcMonad mb_top_dir initGhcMonad mb_top_dir
= do { env <- liftIO $ = do { env <- liftIO $
do { mySettings <- initSysTools mb_top_dir do { top_dir <- findTopDir mb_top_dir
; myLlvmConfig <- initLlvmConfig mb_top_dir ; mySettings <- initSysTools top_dir
; myLlvmConfig <- initLlvmConfig top_dir
; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig) ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig)
; checkBrokenTablesNextToCode dflags ; checkBrokenTablesNextToCode dflags
; setUnsafeGlobalDynFlags dflags ; setUnsafeGlobalDynFlags dflags
......
...@@ -110,17 +110,16 @@ stuff. ...@@ -110,17 +110,16 @@ stuff.
************************************************************************ ************************************************************************
-} -}
initLlvmConfig :: Maybe String initLlvmConfig :: String
-> IO LlvmConfig -> IO LlvmConfig
initLlvmConfig mbMinusB initLlvmConfig top_dir
= do = do
targets <- readAndParse "llvm-targets" mkLlvmTarget targets <- readAndParse "llvm-targets" mkLlvmTarget
passes <- readAndParse "llvm-passes" id passes <- readAndParse "llvm-passes" id
return (targets, passes) return (targets, passes)
where where
readAndParse name builder = readAndParse name builder =
do top_dir <- findTopDir mbMinusB do let llvmConfigFile = top_dir </> name
let llvmConfigFile = top_dir </> name
llvmConfigStr <- readFile llvmConfigFile llvmConfigStr <- readFile llvmConfigFile
case maybeReadFuzzy llvmConfigStr of case maybeReadFuzzy llvmConfigStr of
Just s -> return (fmap builder <$> s) Just s -> return (fmap builder <$> s)
...@@ -130,14 +129,13 @@ initLlvmConfig mbMinusB ...@@ -130,14 +129,13 @@ initLlvmConfig mbMinusB
mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs) mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs)
initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix) initSysTools :: String -- TopDir path
-> IO Settings -- Set all the mutable variables above, holding -> IO Settings -- Set all the mutable variables above, holding
-- (a) the system programs -- (a) the system programs
-- (b) the package-config file -- (b) the package-config file
-- (c) the GHC usage message -- (c) the GHC usage message
initSysTools mbMinusB initSysTools top_dir
= do top_dir <- findTopDir mbMinusB = do -- see Note [topdir: How GHC finds its files]
-- see Note [topdir: How GHC finds its files]
-- NB: top_dir is assumed to be in standard Unix -- NB: top_dir is assumed to be in standard Unix
-- format, '/' separated -- format, '/' separated
mtool_dir <- findToolDir top_dir mtool_dir <- findToolDir top_dir
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment