[commit: ghc] wip/nfs-locking: Move systemBuilderPath to GHC (8fc676e)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 01:23:56 UTC 2017


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

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/8fc676e400d02448dea520c0977d64c140b1a560/ghc

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

commit 8fc676e400d02448dea520c0977d64c140b1a560
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Wed Aug 16 15:24:08 2017 +0100

    Move systemBuilderPath to GHC


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

8fc676e400d02448dea520c0977d64c140b1a560
 src/GHC.hs      | 42 +++++++++++++++++++++++++++++++++++++++++-
 src/Settings.hs | 39 ---------------------------------------
 2 files changed, 41 insertions(+), 40 deletions(-)

diff --git a/src/GHC.hs b/src/GHC.hs
index 1141030..2210889 100644
--- a/src/GHC.hs
+++ b/src/GHC.hs
@@ -18,9 +18,12 @@ module GHC (
     rtsContext, rtsBuildPath, rtsConfIn,
 
     -- * Miscellaneous
-    ghcSplitPath, stripCmdPath, inplaceInstallPath, buildDll0
+    systemBuilderPath, ghcSplitPath, stripCmdPath, inplaceInstallPath, buildDll0
     ) where
 
+import Hadrian.Oracles.KeyValue
+import Hadrian.Oracles.Path
+
 import Base
 import Context
 import Oracles.Setting
@@ -118,6 +121,43 @@ builderProvenance = \case
   where
     context s p = Just $ vanillaContext s p
 
+-- | Determine the location of a system 'Builder'.
+systemBuilderPath :: Builder -> Action FilePath
+systemBuilderPath builder = case builder of
+    Alex            -> fromKey "alex"
+    Ar Stage0       -> fromKey "system-ar"
+    Ar _            -> fromKey "ar"
+    Cc  _  Stage0   -> fromKey "system-cc"
+    Cc  _  _        -> fromKey "cc"
+    -- We can't ask configure for the path to configure!
+    Configure _     -> return "sh configure"
+    Ghc _  Stage0   -> fromKey "system-ghc"
+    GhcPkg _ Stage0 -> fromKey "system-ghc-pkg"
+    Happy           -> fromKey "happy"
+    HsColour        -> fromKey "hscolour"
+    HsCpp           -> fromKey "hs-cpp"
+    Ld              -> fromKey "ld"
+    Make _          -> fromKey "make"
+    Nm              -> fromKey "nm"
+    Objdump         -> fromKey "objdump"
+    Patch           -> fromKey "patch"
+    Perl            -> fromKey "perl"
+    Ranlib          -> fromKey "ranlib"
+    Tar             -> fromKey "tar"
+    _               -> error $ "No entry for " ++ show builder ++ inCfg
+  where
+    inCfg = " in " ++ quote configFile ++ " file."
+    fromKey key = do
+        let unpack = fromMaybe . error $ "Cannot find path to builder "
+                ++ quote key ++ inCfg ++ " Did you skip configure?"
+        path <- unpack <$> lookupValue configFile key
+        if null path
+        then do
+            unless (isOptional builder) . error $ "Non optional builder "
+                ++ quote key ++ " is not specified" ++ inCfg
+            return "" -- TODO: Use a safe interface.
+        else fixAbsolutePathOnWindows =<< lookupInPath path
+
 -- | Given a 'Context', compute the name of the program that is built in it
 -- assuming that the corresponding package's type is 'Program'. For example, GHC
 -- built in 'Stage0' is called @ghc-stage1 at . If the given package is a
diff --git a/src/Settings.hs b/src/Settings.hs
index f25265b..fdce8a7 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -5,9 +5,6 @@ module Settings (
     programContext, integerLibraryName, destDir, stage1Only, buildDll0
     ) where
 
-import Hadrian.Oracles.KeyValue
-import Hadrian.Oracles.Path
-
 import Context
 import CommandLine
 import Expression
@@ -68,42 +65,6 @@ knownPackages = sort $ defaultKnownPackages ++ userKnownPackages
 findKnownPackage :: PackageName -> Maybe Package
 findKnownPackage name = find (\pkg -> pkgName pkg == name) knownPackages
 
--- | Determine the location of a system 'Builder'.
-systemBuilderPath :: Builder -> Action FilePath
-systemBuilderPath builder = case builder of
-    Alex            -> fromKey "alex"
-    Ar Stage0       -> fromKey "system-ar"
-    Ar _            -> fromKey "ar"
-    Cc  _  Stage0   -> fromKey "system-cc"
-    Cc  _  _        -> fromKey "cc"
-    -- We can't ask configure for the path to configure!
-    Configure _     -> return "sh configure"
-    Ghc _  Stage0   -> fromKey "system-ghc"
-    GhcPkg _ Stage0 -> fromKey "system-ghc-pkg"
-    Happy           -> fromKey "happy"
-    HsColour        -> fromKey "hscolour"
-    HsCpp           -> fromKey "hs-cpp"
-    Ld              -> fromKey "ld"
-    Make _          -> fromKey "make"
-    Nm              -> fromKey "nm"
-    Objdump         -> fromKey "objdump"
-    Patch           -> fromKey "patch"
-    Perl            -> fromKey "perl"
-    Ranlib          -> fromKey "ranlib"
-    Tar             -> fromKey "tar"
-    _               -> error $ "No system.config entry for " ++ show builder
-  where
-    fromKey key = do
-        let unpack = fromMaybe . error $ "Cannot find path to builder "
-                ++ quote key ++ " in system.config file. Did you skip configure?"
-        path <- unpack <$> lookupValue configFile key
-        if null path
-        then do
-            unless (isOptional builder) . error $ "Non optional builder "
-                ++ quote key ++ " is not specified in system.config file."
-            return "" -- TODO: Use a safe interface.
-        else fixAbsolutePathOnWindows =<< lookupInPath path
-
 -- | Determine the location of a 'Builder'.
 builderPath :: Builder -> Action FilePath
 builderPath builder = case builderProvenance builder of



More information about the ghc-commits mailing list