[Git][ghc/ghc][wip/angerman/fix-hadrian-cross-macos] fallback

[Moritz Angermann]

Moritz Angermann pushed to branch wip/angerman/fix-hadrian-cross-macos at Glasgow Haskell Compiler / GHC


Commits:
b7c394e8 by Moritz Angermann at 2020-06-19T22:17:56+08:00
fallback

- - - - -


2 changed files:

- hadrian/cfg/system.config.in
- hadrian/src/Oracles/Flag.hs


Changes:

=====================================
hadrian/cfg/system.config.in
=====================================
@@ -34,9 +34,8 @@ python         = @PythonCmd@
 #============================
 
 ar-supports-at-file-stage0 = @ArSupportsAtFile_STAGE0@
-ar-supports-at-file-stage1 = @ArSupportsAtFile@
-ar-supports-at-file-stage2 = @ArSupportsAtFile@
-ar-supports-at-file-stage3 = @ArSupportsAtFile@
+ar-supports-at-file = @ArSupportsAtFile@
+
 cc-llvm-backend     = @CcLlvmBackend@
 hs-cpp-args         = @HaskellCPPArgs@
 


=====================================
hadrian/src/Oracles/Flag.hs
=====================================
@@ -50,11 +50,16 @@ flag f = do
             UseSystemFfi         -> "use-system-ffi"
             BootstrapThreadedRts -> "bootstrap-threaded-rts"
 
-    let key = case f of
-            Global fn   -> configName fn
-            Staged s fn -> configName fn ++ "-" ++ stageString s
+    (key, value) <- case f of
+            Global fn   -> let key = configName fn in (key,) <$> lookupValueOrError configFile key
+            Staged s fn -> do
+                let key = configName fn
+                    stagedKey = key ++ "-" ++ stageString s
+                    msg = "Key " ++ quote stagedKey ++ " or " ++ quote key ++ " not found in file " ++ quote configFile
+                mStagedVal <- fmap (stagedKey,) <$> lookupValue configFile stagedKey
+                mGlobalVal <- fmap (key,) <$> lookupValue configFile key
+                return $ fromMaybe (error msg) (mStagedVal <|> mGlobalVal)
 
-    value <- lookupValueOrError configFile key
     when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag "
         ++ quote (key ++ " = " ++ value) ++ " cannot be parsed."
     return $ value == "YES"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7c394e84df489d874e8f2bb1575021fc951f8eb

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7c394e84df489d874e8f2bb1575021fc951f8eb
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200619/12784e95/attachment-0001.html>