[Git][ghc/ghc][wip/toolchain-selection] 2 commits: Handle unspecified vs specified flags and commands better
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon May 15 22:30:01 UTC 2023
Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC
Commits:
1e4e0543 by Rodrigo Mesquita at 2023-05-15T23:02:23+01:00
Handle unspecified vs specified flags and commands better
- - - - -
2fff8d82 by Rodrigo Mesquita at 2023-05-15T23:29:53+01:00
ROMES: WIP 4
- - - - -
4 changed files:
- utils/ghc-toolchain/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
Changes:
=====================================
utils/ghc-toolchain/Main.hs
=====================================
@@ -70,7 +70,7 @@ emptyOpts = Opts
, optTablesNextToCode = Nothing
, optUseLibFFIForAdjustors = Nothing
, optLdOverride = Nothing -- See comment in Link on 'enableOverride'. Shouldn't we set the default here?
- , optVerbosity = 0
+ , optVerbosity = 1
, optKeepTemp = False
}
where
@@ -145,10 +145,18 @@ options =
progOpts :: String -> String -> Lens Opts ProgOpt -> [OptDescr (Opts -> Opts)]
progOpts progName description lens =
[ Option [] [progName] (ReqArg (set (lens % _poPath) . Just) metavar) ("Path of " ++ description)
- , Option [] [progName++"-opt"] (ReqArg (\x -> over (lens % _poFlags) (++[x])) "OPTS") ("Flags to pass to " ++ progName)
+ , Option [] [progName++"-opt"] (ReqArg (over (lens % _poFlags) . updatePoFlags) "OPTS") ("Flags to pass to " ++ progName)
]
where
metavar = map toUpper progName
+ updatePoFlags newOpts existingOpts
+ = case newOpts of
+ -- Empty list of flags is as if it was unspecified
+ "" -> existingOpts
+ -- Otherwise append specified flags to existing flags or make new
+ _ -> case existingOpts of
+ Nothing -> Just [newOpts]
+ Just eopts -> Just (eopts ++ [newOpts])
enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)]
enableDisable optName description lens =
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
=====================================
@@ -18,6 +18,7 @@ module GHC.Toolchain.Program
import Control.Monad
import Control.Monad.IO.Class
import Data.List (intercalate)
+import Data.Maybe
import System.Directory
import System.Exit
import System.Process hiding (env)
@@ -80,18 +81,22 @@ logExecute prog args =
-- | Program specifier from the command-line.
data ProgOpt = ProgOpt { poPath :: Maybe FilePath
- , poFlags :: [String]
+ , poFlags :: Maybe [String]
}
_poPath :: Lens ProgOpt (Maybe FilePath)
_poPath = Lens poPath (\x o -> o {poPath=x})
-_poFlags :: Lens ProgOpt [String]
+_poFlags :: Lens ProgOpt (Maybe [String])
_poFlags = Lens poFlags (\x o -> o {poFlags=x})
emptyProgOpt :: ProgOpt
-emptyProgOpt = ProgOpt Nothing []
+emptyProgOpt = ProgOpt Nothing Nothing
+-- | Tries to find the user specified program by path or tries to look for one
+-- in the given list of candidates.
+--
+-- If the 'ProgOpt' program flags are unspecified the program will have an empty list of flags.
findProgram :: String
-> ProgOpt -- ^ path provided by user
-> [FilePath] -- ^ candidate names
@@ -117,7 +122,7 @@ findProgram description userSpec candidates
]
toProgram <$> oneOf err (map find_it candidates') <|> throwE err
where
- toProgram path = Program { prgPath = path, prgFlags = poFlags userSpec }
+ toProgram path = Program { prgPath = path, prgFlags = fromMaybe [] (poFlags userSpec) }
find_it name = do
r <- liftIO $ findExecutable name
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
=====================================
@@ -3,9 +3,11 @@
module GHC.Toolchain.Tools.Cpp (Cpp(..), findCpp) where
import Control.Monad
+import System.FilePath
import GHC.Toolchain.Prelude
import GHC.Toolchain.Program
+import GHC.Toolchain.Utils (withTempDir)
import GHC.Toolchain.Tools.Cc
@@ -14,33 +16,38 @@ newtype Cpp = Cpp { cppProgram :: Program
deriving (Show, Read, Eq, Ord)
findCpp :: ProgOpt -> Cc -> M Cpp
-findCpp progOpt cc
- | Just _ <- poPath progOpt = checking "for C preprocessor" $ do
- -- If the user specified a linker don't second-guess them
- cppProgram <- findProgram "C preprocessor" progOpt []
- return Cpp{cppProgram}
- | otherwise = checking "for C preprocessor" $ do
- let rawCppProgram = over _prgFlags (["-E"]++) (ccProgram cc)
- hppArgs <- findHsCppArgs rawCppProgram
- let cppProgram = over _prgFlags (++hppArgs) rawCppProgram
- return Cpp{cppProgram}
+findCpp progOpt cc = checking "for C preprocessor" $ do
+ -- Use the specified CPP or try to find one (candidate is the c compiler)
+ foundCppProg <- findProgram "C preprocessor" progOpt [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 rawCppProgram = over _prgFlags (["-E"]++) foundCppProg
+ hppArgs <- findHsCppArgs rawCppProgram
+ let cppProgram = over _prgFlags (++hppArgs) rawCppProgram
+ return Cpp{cppProgram}
-- | Given a C preprocessor, figure out how it should be invoked to preprocess
-- Haskell source.
findHsCppArgs :: Program -> M [String]
-findHsCppArgs cpp =
- concat <$> sequence
- [ ["-traditional"] <$ checkFlag "-traditional"
- , tryFlag "-undef"
- , tryFlag "-Wno-invalid-pp-token"
- , tryFlag "-Wno-unicode"
- , tryFlag "-Wno-trigraphs"
- ]
- where
- -- Werror to ensure that unrecognized warnings result in an error
- checkFlag flag =
- checking ("for "++flag++" support") $ callProgram cpp ["-E", "-Werror", flag, "/dev/null"]
-
- tryFlag flag =
- ([flag] <$ checkFlag flag) <|> return []
+findHsCppArgs cpp = withTempDir $ \dir -> do
+ let tmp_h = dir </> "tmp.h"
+
+ -- Werror to ensure that unrecognized warnings result in an error
+ checkFlag flag =
+ checking ("for "++flag++" support") $ callProgram cpp ["-Werror", flag, tmp_h]
+
+ tryFlag flag =
+ ([flag] <$ checkFlag flag) <|> return []
+
+ writeFile tmp_h ""
+ concat <$> sequence
+ [ ["-traditional"] <$ checkFlag "-traditional"
+ , tryFlag "-undef"
+ , tryFlag "-Wno-invalid-pp-token"
+ , tryFlag "-Wno-unicode"
+ , tryFlag "-Wno-trigraphs"
+ ]
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
=====================================
@@ -27,21 +27,22 @@ data CcLink = CcLink { ccLinkProgram :: Program
findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink
findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do
- ccLinkProgram <- case poPath progOpt of
- Just _ ->
- -- If the user specified a linker don't second-guess them
- findProgram "C compiler for linking" progOpt []
- Nothing -> do
- -- If not then try to find a decent linker on our own
- rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc]
- findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink
- ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram
- ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram
- ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram
- ccLinkSupportsResponseFiles <- checkSupportsResponseFiles cc ccLinkProgram
- checkBfdCopyBug archOs cc readelf ccLinkProgram
- ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram
- return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles}
+ -- Use the specified linker or try to find one
+ rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc]
+ ccLinkProgram <- case poFlags progOpt of
+ Just _ ->
+ -- If the user specified linker flags don't second-guess them
+ pure rawCcLink
+ Nothing -> do
+ -- If not then try to find decent linker flags
+ findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink
+ ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram
+ ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram
+ ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram
+ ccLinkSupportsResponseFiles <- checkSupportsResponseFiles cc ccLinkProgram
+ checkBfdCopyBug archOs cc readelf ccLinkProgram
+ ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram
+ return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles}
-- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@
findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program
@@ -99,7 +100,7 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $
checkSupportsCompactUnwind :: Cc -> Program -> M Bool
checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $
withTempDir $ \dir -> do
- let test_o = dir </> "o"
+ let test_o = dir </> "test.o"
test2_o = dir </> "test2.o"
compileC cc test_o "int foo() { return 0; }"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5fd71a5b3192b3c54315739fc72800f98a7c5153...2fff8d824663f128ca31420b1fdcbf50e9af1df4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5fd71a5b3192b3c54315739fc72800f98a7c5153...2fff8d824663f128ca31420b1fdcbf50e9af1df4
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/20230515/33a633d9/attachment-0001.html>
More information about the ghc-commits
mailing list