[Git][ghc/ghc][wip/toolchain-selection] 5 commits: tweak

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Mon May 29 16:14:12 UTC 2023



Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC


Commits:
5a4a6476 by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00
tweak

- - - - -
4a60c532 by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00
Get rid of MonadCatch instances and dependencies

- - - - -
e4d7017a by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00
ghc-toolchain: Check Cc supports extra-via-c-flags

- - - - -
f4c084d1 by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00
Consider empty programs as non-specified programs

- - - - -
e3592361 by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00
Cpp and HsCpp cleanup

- - - - -


12 changed files:

- configure.ac
- distrib/configure.ac.in
- hadrian/cfg/system.config.in
- m4/fp_cpp_cmd_with_args.m4
- − m4/fp_gcc_supports_via_c_flags.m4
- m4/fp_hs_cpp_cmd_with_args.m4
- utils/ghc-toolchain/Main.hs
- utils/ghc-toolchain/ghc-toolchain.cabal
- utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs


Changes:

=====================================
configure.ac
=====================================
@@ -450,10 +450,6 @@ AC_USE_SYSTEM_EXTENSIONS
 
 # --with-hs-cpp/--with-hs-cpp-flags
 FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs)
-AC_SUBST([HaskellCPPCmd])
-AC_SUBST([HaskellCPPArgs])
-
-dnl ROMES:TODO: Are we setting C99 flags in ghc toolchain for every target?
 
 dnl ROMES:TODO: Feels out of date; integrate into ghc-toolchain
 # CPP, CPPFLAGS
@@ -461,11 +457,9 @@ dnl ROMES:TODO: Feels out of date; integrate into ghc-toolchain
 dnl ROMES:TODO: This comment will generate a merge conflict, but we'll get rid of this all before that can happen
 dnl Note that we must do this after setting the C99 flags, or otherwise we
 dnl might end up trying to configure the C99 flags using -E as a CPPFLAG
-FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0])
-FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1])
-FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2])
-AC_SUBST([CPPCmd_STAGE0])
-AC_SUBST([CPPCmd])
+FP_CPP_CMD_WITH_ARGS([CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0])
+FP_CPP_CMD_WITH_ARGS([CPPCmd],[CONF_CPP_OPTS_STAGE1])
+FP_CPP_CMD_WITH_ARGS([CPPCmd],[CONF_CPP_OPTS_STAGE2])
 
 dnl ROMES:TODO: Are we setting the C99 flags in ghc-toolchain already?
 FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS])
@@ -588,10 +582,6 @@ dnl --------------------------------------------------------------
 dnl ** does #! work?
 AC_SYS_INTERPRETER()
 
-dnl ROMES:TODO: Make this check in ghc-toolchain
-dnl ** Check support for the extra flags passed by GHC when compiling via C
-# FP_GCC_SUPPORTS_VIA_C_FLAGS
-
 dnl ** Used to determine how to compile ghc-prim's atomics.c, used by
 dnl    unregisterised, Sparc, and PPC backends. Also determines whether
 dnl    linking to libatomic is required for atomic operations, e.g. on
@@ -614,8 +604,6 @@ dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLA
 FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0])
 FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1])
 FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2])
-AC_SUBST([CPPCmd_STAGE0])
-AC_SUBST([CPPCmd])
 
 dnl Identify C++ standard library flavour and location
 FP_FIND_CXX_STD_LIB


=====================================
distrib/configure.ac.in
=====================================
@@ -108,8 +108,6 @@ AC_PROG_CXX([g++ clang++ c++])
 
 # --with-hs-cpp/--with-hs-cpp-flags
 FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs)
-AC_SUBST([HaskellCPPCmd])
-AC_SUBST([HaskellCPPArgs])
 
 FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS])
 dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0])
@@ -143,9 +141,6 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion])
 OptCmd="$OPT"
 AC_SUBST([OptCmd])
 
-# ROMES:TODO: Move this to ghc-toolchain
-FP_GCC_SUPPORTS_VIA_C_FLAGS
-
 FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS])
 FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0])
 FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1])
@@ -190,11 +185,9 @@ FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CON
 # --with-cpp/-with-cpp-flags
 dnl Note that we must do this after setting and using the C99 CPPFLAGS, or
 dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG
-FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0])
-FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1])
-FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2])
-AC_SUBST([CPPCmd_STAGE0])
-AC_SUBST([CPPCmd])
+FP_CPP_CMD_WITH_ARGS([CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0])
+FP_CPP_CMD_WITH_ARGS([CPPCmd],[CONF_CPP_OPTS_STAGE1])
+FP_CPP_CMD_WITH_ARGS([CPPCmd],[CONF_CPP_OPTS_STAGE2])
 
 dnl TargetWordSize for settings file
 AC_CHECK_SIZEOF(void *, 4)


=====================================
hadrian/cfg/system.config.in
=====================================
@@ -9,15 +9,12 @@ alex           = @AlexCmd@
 autoreconf     = @AutoreconfCmd@
 cc             = @CC@
 happy          = @HappyCmd@
-cpp            = @CPPCmd@
-hs-cpp         = @HaskellCPPCmd@
 make           = @MakeCmd@
 system-merge-objects = @LD_STAGE0@
 objdump        = @ObjdumpCmd@
 sphinx-build   = @SPHINXBUILD@
 system-ar      = @AR_STAGE0@
 system-cc      = @CC_STAGE0@
-system-cpp     = @CPPCmd_STAGE0@
 system-ghc     = @WithGhc@
 system-ghc-pkg = @GhcPkgCmd@
 tar            = @TarCmd@
@@ -39,7 +36,6 @@ python         = @PythonCmd@
 system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@
 system-ar-supports-dash-l = @ArSupportsDashL_STAGE0@
 cc-llvm-backend           = @CcLlvmBackend@
-hs-cpp-args               = @HaskellCPPArgs@
 
 # Build options:
 #===============
@@ -92,8 +88,6 @@ project-git-commit-id  = @ProjectGitCommitId@
 # might become redundant.
 # See Note [tooldir: How GHC finds mingw on Windows]
 
-gcc-extra-via-c-opts = @GccExtraViaCOpts@
-
 # ROMES:TODO: Drop almost every of these from settings.
 settings-c-compiler-command = @SettingsCCompilerCommand@
 settings-cxx-compiler-command = @SettingsCxxCompilerCommand@


=====================================
m4/fp_cpp_cmd_with_args.m4
=====================================
@@ -1,10 +1,9 @@
 # FP_CPP_CMD_WITH_ARGS()
 # ----------------------
-# sets CPP command and its arguments
+# Sets CPP command and its arguments from args --with-cpp and --with-cpp-flags
 #
-# $1 = CC (unmodified)
-# $2 = the variable to set to CPP command
-# $3 = the variable to set to CPP command arguments
+# $1 = the variable to set to CPP command
+# $2 = the variable to set to CPP command arguments
 #
 # The reason for using the non-standard --with-cpp and --with-cpp-flags instead
 # of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E",
@@ -21,17 +20,9 @@ AC_ARG_WITH(cpp,
     then
         AC_MSG_WARN([Request to use $withval will be ignored])
     else
-        CPP_CMD="$withval"
+        $1="$withval"
     fi
-],
-[
-    # We can't use the CPP var here, since CPP_CMD is expected to be a single
-    # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E".
-    # So we use CC with -E by default
-    CPP_CMD="$1"
-    CPP_ARGS="-E"
-]
-)
+],[])
 
 AC_ARG_WITH(cpp-flags,
 [AS_HELP_STRING([--with-cpp-flags=ARG],
@@ -41,19 +32,9 @@ AC_ARG_WITH(cpp-flags,
   then
       AC_MSG_WARN([Request to use $withval will be ignored])
   else
-      # Use whatever flags were manually set, ignoring previously configured
-      # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified)
-      CPP_ARGS="$CPP_ARGS $withval"
+      $2="$withval"
   fi
-],
-[
-  # Augment CPP_ARGS with whatever flags were previously configured and passed
-  # as an argument.
-  CPP_ARGS="$CPP_ARGS $$3"
-])
-
-$2="$CPP_CMD"
-$3="$CPP_ARGS"
+],[])
 
 ])
 


=====================================
m4/fp_gcc_supports_via_c_flags.m4 deleted
=====================================
@@ -1,17 +0,0 @@
-# FP_GCC_SUPPORTS_VIA_C_FLAGS
-# ---------------------------
-# Make sure GCC supports the flags passed by GHC when compiling via C
-AC_DEFUN([FP_GCC_SUPPORTS_VIA_C_FLAGS],
-[
-   AC_REQUIRE([AC_PROG_CC])
-   AC_MSG_CHECKING([whether CC supports flags passed by GHC when compiling via C])
-   echo 'int main() { return 0; }' > conftest.c
-   if $CC -fwrapv -fno-builtin -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then
-       AC_MSG_RESULT([yes])
-   else
-       AC_MSG_RESULT([no])
-       AC_MSG_ERROR([gcc must support the flags -fwrapv and -fno-builtin])
-   fi
-   rm -f conftest.c conftest.o conftest
-])
-


=====================================
m4/fp_hs_cpp_cmd_with_args.m4
=====================================
@@ -1,6 +1,6 @@
 # FP_HSCPP_CMD_WITH_ARGS()
 # ----------------------
-# sets HS CPP command and its arguments
+# sets HS CPP command and its arguments from args --with-hs-cpp and --with-hs-cpp-flags
 #
 # $1 = the variable to set to HS CPP command
 # $2 = the variable to set to HS CPP command arguments
@@ -16,26 +16,18 @@ AC_ARG_WITH(hs-cpp,
     else
         $1=$withval
     fi
-],
-[
-    # We can't use $CPP here, since $1 is expected to be a single
-    # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E".
-    $1=$CC
-]
-)
+],[])
 AC_ARG_WITH(hs-cpp-flags,
-  [AS_HELP_STRING([--with-hs-cpp-flags=ARG],
-      [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])],
-  [
-      if test "$HostOS" = "mingw32"
-      then
-          AC_MSG_WARN([Request to use $withval will be ignored])
-      else
-          $2=$withval
-      fi
-  ],
-[ $2="" ]
-)
+[AS_HELP_STRING([--with-hs-cpp-flags=ARG],
+  [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])],
+[
+  if test "$HostOS" = "mingw32"
+  then
+      AC_MSG_WARN([Request to use $withval will be ignored])
+  else
+      $2=$withval
+  fi
+],[])
 
 ])
 


=====================================
utils/ghc-toolchain/Main.hs
=====================================
@@ -148,19 +148,21 @@ options =
   where
     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] (ReqArg (set (lens % _poPath) . progPath) metavar) ("Path of " ++ description)
         , 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])
+
+        progPath "" = Nothing
+        progPath p  = Just p
+
+        -- Empty list of flags is as if it was unspecified
+        updatePoFlags "" existingOpts      = existingOpts
+        -- Otherwise append specified flags to existing flags or make new
+        updatePoFlags newOpts Nothing      = Just [newOpts]
+        updatePoFlags newOpts (Just eopts) = Just (eopts ++ [newOpts])
+
 
     enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)]
     enableDisable optName description lens =
@@ -195,7 +197,7 @@ main = do
       [] -> do
           let env = Env { verbosity = optVerbosity opts
                         , targetPrefix = case optTargetPrefix opts of
-                                           Just prefix -> Just $ prefix
+                                           Just prefix -> Just prefix
                                            Nothing -> Just $ optTriple opts ++ "-"
                         , keepTemp = optKeepTemp opts
                         , logContexts = []
@@ -323,7 +325,7 @@ mkTarget opts = do
     tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc
     tgtSupportsIdentDirective <- checkIdentDirective cc
     tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc
-    tgtLlvmTarget <- pure $ optTriple opts
+    let tgtLlvmTarget = optTriple opts
 
     -- code generator configuration
     tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts)


=====================================
utils/ghc-toolchain/ghc-toolchain.cabal
=====================================
@@ -33,10 +33,10 @@ library
     default-extensions: NoImplicitPrelude
     build-depends:    base,
                       directory,
-                      exceptions,
                       filepath,
                       process,
                       transformers,
+                      async,
                       ghc-boot
     hs-source-dirs:   src
     default-language: Haskell2010
@@ -47,7 +47,6 @@ executable ghc-toolchain
     default-extensions: NoImplicitPrelude
     build-depends:    base,
                       directory,
-                      exceptions,
                       filepath,
                       process,
                       transformers,


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
=====================================
@@ -6,6 +6,7 @@ module GHC.Toolchain.Monad
     , M
     , runM
     , getEnv
+    , makeM
     , throwE
     , ifCrossCompiling
 
@@ -27,7 +28,6 @@ import qualified Prelude
 
 import Control.Applicative
 import Control.Monad
-import qualified Control.Monad.Catch as MC
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
 import qualified Control.Monad.Trans.Reader as Reader
@@ -43,9 +43,7 @@ data Env = Env { verbosity    :: Int
                }
 
 newtype M a = M (Except.ExceptT [Error] (Reader.ReaderT Env IO) a)
-    deriving (Functor, Applicative, Monad, MonadIO, Alternative,
-              -- TODO: Eliminate these instances (ROMES: why?)
-              MC.MonadThrow, MC.MonadCatch, MC.MonadMask)
+    deriving (Functor, Applicative, Monad, MonadIO, Alternative)
 
 runM :: Env -> M a -> IO (Either [Error] a)
 runM env (M k) =
@@ -54,6 +52,9 @@ runM env (M k) =
 getEnv :: M Env
 getEnv = M $ lift Reader.ask
 
+makeM :: IO (Either [Error] a) -> M a
+makeM io = M (Except.ExceptT (Reader.ReaderT (\env -> io)))
+
 data Error = Error { errorMessage :: String
                    , errorLogContexts :: [String]
                    }


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
=====================================
@@ -11,6 +11,8 @@ module GHC.Toolchain.Tools.Cc
     , addPlatformDepCcFlags
     ) where
 
+import Control.Monad
+import Data.List (isInfixOf) -- Wouldn't it be better to use bytestring?
 import System.FilePath
 
 import GHC.Platform.ArchOS
@@ -32,6 +34,7 @@ findCc progOpt = checking "for C compiler" $ do
     cc <- ignoreUnusedArgs $ Cc {ccProgram}
     checkCcWorks cc
     checkC99Support cc
+    checkCcSupportsExtraViaCFlags cc
     return cc
 
 checkCcWorks :: Cc -> M ()
@@ -63,6 +66,21 @@ checkC99Support cc = checking "for C99 support" $ withTempDir $ \dir -> do
         , "#endif"
         ]
 
+checkCcSupportsExtraViaCFlags :: Cc -> M ()
+checkCcSupportsExtraViaCFlags cc = checking "whether cc supports extra via-c flags" $ withTempDir $ \dir -> do
+  let test_o = dir </> "test.o"
+      test_c = test_o -<.> "c"
+  writeFile test_c "int main() { return 0; }"
+  (code, out, err) <- readProgram (ccProgram cc)
+                                  [ "-fwrapv", "-fno-builtin"
+                                  , "-Werror", "-x", "c"
+                                  , "-o", test_o, test_c]
+  when (not (isSuccess code)
+        || "unrecognized" `isInfixOf` out
+        || "unrecognized" `isInfixOf` err
+        ) $
+    throwE "Your C compiler must support the -fwrapv and -fno-builtin flags"
+
 -- | Preprocess the given program.
 preprocess
     :: Cc


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
=====================================
@@ -61,7 +61,7 @@ findHsCppArgs cpp = withTempDir $ \dir -> do
 
 findCpp :: ProgOpt -> Cc -> M Cpp
 findCpp progOpt cc = checking "for C preprocessor" $ do
-  -- Use the specified HS CPP or try to find one (candidate is the c compiler)
+  -- 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
@@ -70,3 +70,4 @@ findCpp progOpt cc = checking "for C preprocessor" $ do
     Nothing -> do
       let cppProgram = over _prgFlags (["-E"]++) foundCppProg
       return Cpp{cppProgram}
+


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs
=====================================
@@ -9,8 +9,8 @@ module GHC.Toolchain.Utils
     , isSuccess
     ) where
 
+import Control.Exception
 import Control.Monad
-import Control.Monad.Catch
 import Control.Monad.IO.Class
 import System.Directory
 import System.FilePath
@@ -19,30 +19,28 @@ import System.Exit
 
 import GHC.Toolchain.Prelude
 
-createTempDirectory
-    :: forall m. (MonadIO m, MonadCatch m)
-    => m FilePath
+createTempDirectory :: IO FilePath
 createTempDirectory = do
-    root <- liftIO $ getTemporaryDirectory
+    root <- getTemporaryDirectory
     go root 0
   where
-    go :: FilePath -> Int -> m FilePath
+    go :: FilePath -> Int -> IO FilePath
     go root n = do
         let path = root </> "tmp"++show n
-        res <- try $ liftIO $ createDirectory path
+        res <- try $ createDirectory path
         case res of
           Right () -> return path
           Left err
             | isAlreadyExistsError err -> go root (n+1)
-            | otherwise -> throwM err
+            | otherwise -> throwIO err
 
 withTempDir :: (FilePath -> M a) -> M a
 withTempDir f = do
     env <- getEnv
     let close dir
           | keepTemp env = return ()
-          | otherwise    = liftIO $ removeDirectoryRecursive dir
-    bracket createTempDirectory close f
+          | otherwise    = removeDirectoryRecursive dir
+    makeM (bracket createTempDirectory close (runM env . f))
 
 expectJust :: String -> Maybe a -> M a
 expectJust err Nothing = throwE err



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b6171256ba95491f5cfd328a55a7fbfc8a37060...e3592361d5c710f987e90193b6f9e639716667e6

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b6171256ba95491f5cfd328a55a7fbfc8a37060...e3592361d5c710f987e90193b6f9e639716667e6
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/20230529/9968b905/attachment-0001.html>


More information about the ghc-commits mailing list