diff --git a/utils/ghc-toolchain/src/GHC/Toolchain/Program.hs b/utils/ghc-toolchain/src/GHC/Toolchain/Program.hs index a9d727bcde0679c2da5dcdcdaa164078ced7d15d..e4aa7ca9df934f73c03ed0d1878e4031df3043bc 100644 --- a/utils/ghc-toolchain/src/GHC/Toolchain/Program.hs +++ b/utils/ghc-toolchain/src/GHC/Toolchain/Program.hs @@ -2,6 +2,7 @@ module GHC.Toolchain.Program ( Program(..) , _prgPath , _prgFlags + , addFlagIfNew -- * Running programs , runProgram , callProgram @@ -10,6 +11,7 @@ module GHC.Toolchain.Program -- * Finding 'Program's , ProgOpt(..) , emptyProgOpt + , programFromOpt , _poPath , _poFlags , findProgram @@ -46,6 +48,13 @@ _prgPath = Lens prgPath (\x o -> o {prgPath = x}) _prgFlags :: Lens Program [String] _prgFlags = Lens prgFlags (\x o -> o {prgFlags = x}) +-- | Prepends a flag to a program's flags if the flag is not in the existing flags. +addFlagIfNew :: String -> Program -> Program +addFlagIfNew flag prog@(Program path flags) + = if flag `elem` flags + then prog + else Program path (flags ++ [flag]) + runProgram :: Program -> [String] -> M ExitCode runProgram prog args = do logExecute prog args @@ -103,6 +112,14 @@ _poFlags = Lens poFlags (\x o -> o {poFlags=x}) emptyProgOpt :: ProgOpt emptyProgOpt = ProgOpt Nothing Nothing +-- | Make a @'Program'@ from user specified program options (@'ProgOpt'@), +-- defaulting to the given path and flags if unspecified in the @'ProgOpt'@. +programFromOpt :: ProgOpt + -> FilePath -- ^ Program path to default to + -> [String] -- ^ Program flags to default to + -> Program +programFromOpt userSpec path flags = Program { prgPath = fromMaybe path (poPath userSpec), prgFlags = fromMaybe flags (poFlags userSpec) } + -- | Tries to find the user specified program by path or tries to look for one -- in the given list of candidates. -- diff --git a/utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs b/utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs index ead8f3532fcaf57ff54628424992601438a473aa..392d7c10936f006b0a75e30bc1056c5285f93774 100644 --- a/utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs +++ b/utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs @@ -24,17 +24,14 @@ newtype HsCpp = HsCpp { hsCppProgram :: Program findHsCpp :: ProgOpt -> Cc -> M HsCpp findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do - -- Use the specified HS CPP or try to use the c compiler - foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [] <|> pure (Program (prgPath $ ccProgram cc) []) - case poFlags progOpt of - -- If the user specified HS CPP flags don't second-guess them - Just _ -> return HsCpp{hsCppProgram=foundHsCppProg} - -- Otherwise, configure the HS CPP flags for this CPP program - Nothing -> do - let rawHsCppProgram = over _prgFlags (["-E"]++) foundHsCppProg - hppArgs <- findHsCppArgs rawHsCppProgram - let hsCppProgram = over _prgFlags (++hppArgs) rawHsCppProgram - return HsCpp{hsCppProgram} + -- Use the specified Hs Cpp or try to use the c compiler + foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) + -- Always add the -E flag to the CPP, regardless of the user options + let rawHsCppProgram = addFlagIfNew "-E" foundHsCppProg + -- Always try to add the Haskell-specific CPP flags, regardless of the user options + hppArgs <- findHsCppArgs rawHsCppProgram + let hsCppProgram = over _prgFlags (++hppArgs) rawHsCppProgram + return HsCpp{hsCppProgram} -- | Given a C preprocessor, figure out how it should be invoked to preprocess -- Haskell source. @@ -85,12 +82,8 @@ findHsCppArgs cpp = withTempDir $ \dir -> do findCpp :: ProgOpt -> Cc -> M Cpp findCpp progOpt cc = checking "for C preprocessor" $ do -- Use the specified CPP or try to use the c compiler - foundCppProg <- findProgram "C preprocessor" progOpt [] <|> pure (Program (prgPath $ ccProgram cc) []) - case poFlags progOpt of - -- If the user specified CPP flags don't second-guess them - Just _ -> return Cpp{cppProgram=foundCppProg} - -- Otherwise, configure the CPP flags for this CPP program - Nothing -> do - let cppProgram = over _prgFlags (["-E"]++) foundCppProg - return Cpp{cppProgram} + foundCppProg <- findProgram "C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) + -- Always add the -E flag to the CPP, regardless of the user options + let cppProgram = addFlagIfNew "-E" foundCppProg + return Cpp{cppProgram} diff --git a/utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs b/utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs index ad7fb4c370da6417e0148791927649e5e706b9df..e3fd69256f86230691af49097fd4e466e3c1bf8f 100644 --- a/utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs +++ b/utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs @@ -47,7 +47,7 @@ findCcLink :: String -- ^ The llvm target to use if CcLink supports --target -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do -- Use the specified linker or try using the C compiler - rawCcLink <- findProgram "C compiler for linking" progOpt [] <|> pure (Program (prgPath $ ccProgram cc) []) + rawCcLink <- findProgram "C compiler for linking" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) ccLinkProgram <- case poFlags progOpt of Just _ -> -- If the user specified linker flags don't second-guess them