[Git][ghc/ghc][wip/backports-9.8] 10 commits: hadrian: Generate HSC2HS_EXTRAS variable in bindist installation
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Mon Sep 23 18:43:53 UTC 2024
Ben Gamari pushed to branch wip/backports-9.8 at Glasgow Haskell Compiler / GHC
Commits:
2eca9c7a by Ben Gamari at 2024-02-22T18:31:44+05:30
hadrian: Generate HSC2HS_EXTRAS variable in bindist installation
We must generate the hsc2hs wrapper at bindist installation time since
it must contain `--lflag` and `--cflag` arguments which depend upon the
installation path.
The solution here is to substitute these variables in the configure
script (see mk/hsc2hs.in). This is then copied over a dummy wrapper in
the install rules.
Fixes #24050.
(cherry picked from commit efcbad2dfd242d0bc2c91da5390fe8456a536cc3)
- - - - -
d5246e19 by Matthew Pickering at 2024-02-22T18:31:58+05:30
ci: Show --info for installed compiler
(cherry picked from commit c540559cf188625bec668fa6cd94d4f94413d730)
- - - - -
f3225ed4 by Zubin Duggal at 2024-02-22T23:42:18+05:30
Accept change in MultiLayerModulesTH_Make
This test is flaky on darwin
Metric Decrease:
MultiLayerModulesTH_Make
- - - - -
1c08e245 by Ben Gamari at 2024-02-23T12:31:12+05:30
testsuite: Ignore stderr in T8089
Otherwise spurious "Killed: 9" messages to stderr may cause the test to fail.
Fixes #24361.
(cherry picked from commit e693a4e8589bad35588c51fccc87f4388e7d5874)
- - - - -
9cb7e73a by Sebastian Graf at 2024-05-06T15:11:25+02:00
exprIsTrivial: Factor out shared implementation
The duplication between `exprIsTrivial` and `getIdFromTrivialExpr_maybe` has
been bugging me for a long time.
This patch introduces an inlinable worker function `trivial_expr_fold` acting
as the single, shared decision procedure of triviality. It "returns" a
Church-encoded `Maybe (Maybe Id)`, so when it is inlined, it fuses to similar
code as before.
(Better code, even, in the case of `getIdFromTrivialExpr` which presently
allocates a `Just` constructor that cancels away after this patch.)
- - - - -
78a25354 by Sebastian Graf at 2024-05-07T09:25:04+02:00
Some cherry-picked bits of 59202c8 to fix #24718
As noted in f3225ed4b3f3c4, the test below is flaky on Darwin.
Metric Decrease:
MultiLayerModulesTH_Make
- - - - -
5e5ba257 by Ben Gamari at 2024-09-23T14:33:41-04:00
Bump process submodule to 1.6.24.0
- - - - -
8d7a027a by Ben Gamari at 2024-09-23T14:36:47-04:00
Bump stm submodule to v2.5.3.1
- - - - -
2755511d by Andrew Lelechenko at 2024-09-23T14:42:39-04:00
Bump submodule array to 0.5.8.0
(cherry picked from commit 80769bc9f56541601796366485283a697c52a18b)
- - - - -
52e82b4d by Andrew Lelechenko at 2024-09-23T14:43:06-04:00
Bump submodule deepseq to 1.5.1.0
(cherry picked from commit 8e462f4d4bdf2a6c34c249e7be8084565600d300)
- - - - -
15 changed files:
- .gitlab/ci.sh
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/Unit/Types.hs
- distrib/configure.ac.in
- hadrian/bindist/Makefile
- hadrian/src/Rules/BinaryDist.hs
- libraries/array
- libraries/base/tests/all.T
- libraries/deepseq
- libraries/process
- libraries/stm
- + mk/hsc2hs.in
- + testsuite/tests/core-to-stg/T24718.hs
- testsuite/tests/core-to-stg/all.T
Changes:
=====================================
.gitlab/ci.sh
=====================================
@@ -575,6 +575,8 @@ function install_bindist() {
--prefix="$instdir" \
"${args[@]+"${args[@]}"}"
make_install_destdir "$TOP"/destdir "$instdir"
+ # And check the `--info` of the installed compiler, sometimes useful in CI log.
+ "$instdir"/bin/ghc --info
;;
esac
popd
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -23,9 +23,9 @@ module GHC.Core.Utils (
-- * Properties of expressions
exprType, coreAltType, coreAltsType, mkLamType, mkLamTypes,
mkFunctionType,
- exprIsDupable, exprIsTrivial, getIdFromTrivialExpr,
- getIdFromTrivialExpr_maybe,
- exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
+ exprIsTrivial, getIdFromTrivialExpr, getIdFromTrivialExpr_maybe,
+ trivial_expr_fold,
+ exprIsDupable, exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprOkForSpecEval,
exprIsWorkFree, exprIsConLike,
isCheapApp, isExpandableApp, isSaturatedConApp,
@@ -1046,20 +1046,37 @@ and that confuses the code generator (#11155). So best to kill
it off at source.
-}
+{-# INLINE trivial_expr_fold #-}
+trivial_expr_fold :: (Id -> r) -> (Literal -> r) -> r -> r -> CoreExpr -> r
+-- ^ The worker function for Note [exprIsTrivial] and Note [getIdFromTrivialExpr]
+-- This is meant to have the code of both functions in one place and make it
+-- easy to derive custom predicates.
+--
+-- (trivial_expr_fold k_id k_triv k_not_triv e)
+-- * returns (k_id x) if `e` is a variable `x` (with trivial wrapping)
+-- * returns (k_lit x) if `e` is a trivial literal `l` (with trivial wrapping)
+-- * returns k_triv if `e` is a literal, type, or coercion (with trivial wrapping)
+-- * returns k_not_triv otherwise
+--
+-- where "trivial wrapping" is
+-- * Type application or abstraction
+-- * Ticks other than `tickishIsCode`
+-- * `case e of {}` an empty case
+trivial_expr_fold k_id k_lit k_triv k_not_triv = go
+ where
+ go (Var v) = k_id v -- See Note [Variables are trivial]
+ go (Lit l) | litIsTrivial l = k_lit l
+ go (Type _) = k_triv
+ go (Coercion _) = k_triv
+ go (App f t) | not (isRuntimeArg t) = go f
+ go (Lam b e) | not (isRuntimeVar b) = go e
+ go (Tick t e) | not (tickishIsCode t) = go e -- See Note [Tick trivial]
+ go (Cast e _) = go e
+ go (Case e _ _ []) = go e -- See Note [Empty case is trivial]
+ go _ = k_not_triv
+
exprIsTrivial :: CoreExpr -> Bool
--- If you modify this function, you may also
--- need to modify getIdFromTrivialExpr
-exprIsTrivial (Var _) = True -- See Note [Variables are trivial]
-exprIsTrivial (Type _) = True
-exprIsTrivial (Coercion _) = True
-exprIsTrivial (Lit lit) = litIsTrivial lit
-exprIsTrivial (App e arg) = not (isRuntimeArg arg) && exprIsTrivial e
-exprIsTrivial (Lam b e) = not (isRuntimeVar b) && exprIsTrivial e
-exprIsTrivial (Tick t e) = not (tickishIsCode t) && exprIsTrivial e
- -- See Note [Tick trivial]
-exprIsTrivial (Cast e _) = exprIsTrivial e
-exprIsTrivial (Case e _ _ []) = exprIsTrivial e -- See Note [Empty case is trivial]
-exprIsTrivial _ = False
+exprIsTrivial e = trivial_expr_fold (const True) (const True) True False e
{-
Note [getIdFromTrivialExpr]
@@ -1079,24 +1096,13 @@ T12076lit for an example where this matters.
-}
getIdFromTrivialExpr :: HasDebugCallStack => CoreExpr -> Id
-getIdFromTrivialExpr e
- = fromMaybe (pprPanic "getIdFromTrivialExpr" (ppr e))
- (getIdFromTrivialExpr_maybe e)
-
-getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
-- See Note [getIdFromTrivialExpr]
--- Th equations for this should line up with those for exprIsTrivial
-getIdFromTrivialExpr_maybe e
- = go e
+getIdFromTrivialExpr e = trivial_expr_fold id (const panic) panic panic e
where
- go (App f t) | not (isRuntimeArg t) = go f
- go (Tick t e) | not (tickishIsCode t) = go e
- go (Cast e _) = go e
- go (Lam b e) | not (isRuntimeVar b) = go e
- go (Case e _ _ []) = go e
- go (Var v) = Just v
- go _ = Nothing
+ panic = pprPanic "getIdFromTrivialExpr" (ppr e)
+getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
+getIdFromTrivialExpr_maybe e = trivial_expr_fold Just (const Nothing) Nothing Nothing e
{- *********************************************************************
* *
=====================================
compiler/GHC/CoreToStg.hs
=====================================
@@ -19,8 +19,7 @@ module GHC.CoreToStg ( CoreToStgOpts (..), coreToStg ) where
import GHC.Prelude
import GHC.Core
-import GHC.Core.Utils ( exprType, findDefault, isJoinBind
- , exprIsTickedString_maybe )
+import GHC.Core.Utils
import GHC.Core.Opt.Arity ( manifestArity )
import GHC.Core.Type
import GHC.Core.TyCon
@@ -49,7 +48,7 @@ import GHC.Unit.Module
import GHC.Data.FastString
import GHC.Platform ( Platform )
import GHC.Platform.Ways
-import GHC.Builtin.PrimOps ( PrimCall(..), primOpWrapperId )
+import GHC.Builtin.PrimOps
import GHC.Utils.Outputable
import GHC.Utils.Monad
@@ -574,6 +573,19 @@ coreToStgApp f args ticks = do
-- This is the guy that turns applications into A-normal form
-- ---------------------------------------------------------------------------
+getStgArgFromTrivialArg :: HasDebugCallStack => CoreArg -> StgArg
+-- A (non-erased) trivial CoreArg corresponds to an atomic StgArg.
+-- CoreArgs may not immediately look trivial, e.g., `case e of {}` or
+-- `case unsafeequalityProof of UnsafeRefl -> e` might intervene.
+-- Good thing we can just call `trivial_expr_fold` here.
+getStgArgFromTrivialArg e
+ | Just s <- exprIsTickedString_maybe e -- This case is just for backport to GHC 9.8,
+ = StgLitArg (LitString s) -- where we used to treat strings as valid StgArgs
+ | otherwise
+ = trivial_expr_fold StgVarArg StgLitArg panic panic e
+ where
+ panic = pprPanic "getStgArgFromTrivialArg" (ppr e)
+
coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [StgTickish])
coreToStgArgs []
= return ([], [])
@@ -586,42 +598,29 @@ coreToStgArgs (Coercion _ : args) -- Coercion argument; See Note [Coercion token
= do { (args', ts) <- coreToStgArgs args
; return (StgVarArg coercionTokenId : args', ts) }
-coreToStgArgs (Tick t e : args)
- = assert (not (tickishIsCode t)) $
- do { (args', ts) <- coreToStgArgs (e : args)
- ; let !t' = coreToStgTick (exprType e) t
- ; return (args', t':ts) }
-
coreToStgArgs (arg : args) = do -- Non-type argument
(stg_args, ticks) <- coreToStgArgs args
- arg' <- coreToStgExpr arg
- let
- (aticks, arg'') = stripStgTicksTop tickishFloatable arg'
- stg_arg = case arg'' of
- StgApp v [] -> StgVarArg v
- StgConApp con _ [] _ -> StgVarArg (dataConWorkId con)
- StgOpApp (StgPrimOp op) [] _ -> StgVarArg (primOpWrapperId op)
- StgLit lit -> StgLitArg lit
- _ -> pprPanic "coreToStgArgs" (ppr arg $$ pprStgExpr panicStgPprOpts arg' $$ pprStgExpr panicStgPprOpts arg'')
-
- -- WARNING: what if we have an argument like (v `cast` co)
- -- where 'co' changes the representation type?
- -- (This really only happens if co is unsafe.)
- -- Then all the getArgAmode stuff in CgBindery will set the
- -- cg_rep of the CgIdInfo based on the type of v, rather
- -- than the type of 'co'.
- -- This matters particularly when the function is a primop
- -- or foreign call.
- -- Wanted: a better solution than this hacky warning
-
+ -- We know that `arg` must be trivial, but it may contain Ticks.
+ -- Example from test case `decodeMyStack`:
+ -- $ @... ((src<decodeMyStack.hs:18:26-28> Data.Tuple.snd) @Int @[..])
+ -- Note that unfortunately the Tick is not at the top.
+ -- So we'll traverse the expression twice:
+ -- * Once with `stripTicksT` (which collects *all* ticks from the expression)
+ -- * and another time with `getStgArgFromTrivialArg`.
+ -- Since the argument is trivial, the only place the Tick can occur is
+ -- somehow wrapping a variable (give or take type args, as above).
platform <- getPlatform
- let
- arg_rep = typePrimRep (exprType arg)
- stg_arg_rep = typePrimRep (stgArgType stg_arg)
+ let arg_ty = exprType arg
+ ticks' = map (coreToStgTick arg_ty) (stripTicksT (not . tickishIsCode) arg)
+ arg' = getStgArgFromTrivialArg arg
+ arg_rep = typePrimRep arg_ty
+ stg_arg_rep = typePrimRep (stgArgType arg')
bad_args = not (primRepsCompatible platform arg_rep stg_arg_rep)
- warnPprTrace bad_args "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" (ppr arg) $
- return (stg_arg : stg_args, ticks ++ aticks)
+ massertPpr (length ticks' <= 1) (text "More than one Tick in trivial arg:" <+> ppr arg)
+ warnPprTrace bad_args "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" (ppr arg) (return ())
+
+ return (arg' : stg_args, ticks' ++ ticks)
coreToStgTick :: Type -- type of the ticked expression
-> CoreTickish
=====================================
compiler/GHC/Unit/Types.hs
=====================================
@@ -101,9 +101,9 @@ import GHC.Utils.Fingerprint
import GHC.Utils.Misc
import GHC.Settings.Config (cProjectUnitId)
-import Control.DeepSeq
+import Control.DeepSeq (NFData(..))
import Data.Data
-import Data.List (sortBy )
+import Data.List (sortBy)
import Data.Function
import Data.Bifunctor
import qualified Data.ByteString as BS
=====================================
distrib/configure.ac.in
=====================================
@@ -298,6 +298,7 @@ AC_SUBST(UseLibdw)
FP_SETTINGS
AC_CONFIG_FILES([config.mk])
+AC_CONFIG_FILES([mk/hsc2hs])
AC_OUTPUT
# We get caught by
=====================================
hadrian/bindist/Makefile
=====================================
@@ -222,13 +222,19 @@ install_man:
fi
export SHELL
-install_wrappers: install_bin_libdir
+.PHONY: install_wrappers
+install_wrappers: install_bin_libdir install_hsc2hs_wrapper
@echo "Installing wrapper scripts"
$(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)"
for p in `cd wrappers; $(FIND) . ! -type d`; do \
mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \
done
+.PHONY: install_hsc2hs_wrapper
+install_hsc2hs_wrapper:
+ @echo Copying hsc2hs wrapper
+ cp mk/hsc2hs wrappers/hsc2hs-ghc-$(ProjectVersion)
+
PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g")
update_package_db: install_bin install_lib
@echo "Installing C++ standard library virtual package"
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -361,6 +361,7 @@ bindistInstallFiles =
, "mk" -/- "project.mk"
, "mk" -/- "relpath.sh"
, "mk" -/- "system-cxx-std-lib-1.0.conf.in"
+ , "mk" -/- "hsc2hs.in"
, "mk" -/- "install_script.sh"
, "README", "INSTALL" ]
@@ -425,17 +426,8 @@ haddockWrapper = pure $ "exec \"$executablename\" -B\"$libdir\" -l\"$libdir\" ${
commonWrapper :: Action String
commonWrapper = pure $ "exec \"$executablename\" ${1+\"$@\"}\n"
--- echo 'HSC2HS_EXTRA="$(addprefix --cflag=,$(CONF_CC_OPTS_STAGE1)) $(addprefix --lflag=,$(CONF_GCC_LINKER_OPTS_STAGE1))"' >> "$(WRAPPER)"
hsc2hsWrapper :: Action String
-hsc2hsWrapper = do
- ccArgs <- map ("--cflag=" <>) <$> settingList (ConfCcArgs Stage1)
- ldFlags <- map ("--lflag=" <>) <$> settingList (ConfGccLinkerArgs Stage1)
- wrapper <- drop 4 . lines <$> liftIO (readFile "utils/hsc2hs/hsc2hs.wrapper")
- return $ unlines
- ( "HSC2HS_EXTRA=\"" <> unwords (ccArgs ++ ldFlags) <> "\""
- : "tflag=\"--template=$libdir/template-hsc.h\""
- : "Iflag=\"-I$includedir/\""
- : wrapper )
+hsc2hsWrapper = return "Copied from mk/hsc2hs"
runGhcWrapper :: Action String
runGhcWrapper = pure $ "exec \"$executablename\" -f \"$exedir/ghc\" ${1+\"$@\"}\n"
=====================================
libraries/array
=====================================
@@ -1 +1 @@
-Subproject commit 0daca5dfa33d6c522e9fb8e94a2b66a5ed658c20
+Subproject commit c9cb2c1e8762aa83b6e77af82c87a55e03e990e4
=====================================
libraries/base/tests/all.T
=====================================
@@ -232,8 +232,12 @@ test('T9681', normal, compile_fail, [''])
# Probably something like 1s is already enough, but I don't know enough to
# make an educated guess how long it needs to be guaranteed to reach the C
# call."
+#
+# We ignore stderr since the test itself may print "Killed: 9" (see #24361);
+# all we care about is that the test timed out, for which the
+# exit_code check is sufficient.
test('T8089',
- [exit_code(99), run_timeout_multiplier(0.01)],
+ [exit_code(99), ignore_stderr, run_timeout_multiplier(0.01)],
compile_and_run, [''])
test('T8684', expect_broken(8684), compile_and_run, [''])
test('hWaitForInput-accurate-stdin', [js_broken(22349), expect_broken_for(16535, threaded_ways), req_process], compile_and_run, [''])
=====================================
libraries/deepseq
=====================================
@@ -1 +1 @@
-Subproject commit 045cee4801ce6a66e9992bff648d951d8e5fcd68
+Subproject commit 7ce6e2d3760b23336fd5f9a36f50df6571606947
=====================================
libraries/process
=====================================
@@ -1 +1 @@
-Subproject commit 3466b14dacddc4628427c4d787482899dd0b17cd
+Subproject commit 7a55e3fa1bc80f82fedea3b2b2467a0af3a81242
=====================================
libraries/stm
=====================================
@@ -1 +1 @@
-Subproject commit a1e91f4ea010be61a9c8a94d6a200bfb4dc6d049
+Subproject commit ff8f8ceeceb14ac59accd53dd82a5d32c7e08626
=====================================
mk/hsc2hs.in
=====================================
@@ -0,0 +1,41 @@
+HSC2HS_C="@SettingsCCompilerFlags@"
+
+HSC2HS_L="@SettingsCCompilerLinkFlags@"
+
+tflag="--template=$libdir/template-hsc.h"
+Iflag="-I$includedir/include/"
+
+for f in ${HSC2HS_C}; do
+ cflags="${cflags} --cflag=$f"
+done
+
+for f in ${HSC2HS_L}; do
+ lflags="${lflags} --lflag=$f"
+done
+
+HSC2HS_EXTRA="$cflags $lflags"
+
+read_response() {
+ response_file=$1
+ if [ -f "$response_file" ]; then
+ while read -r arg; do
+ case "$arg" in
+ -t*) tflag=;;
+ --template=*) tflag=;;
+ @*) read_response "${arg#"@"}" ;;
+ --) break;;
+ esac
+ done < "$response_file"
+ fi
+}
+
+for arg do
+ case "$arg" in
+ -t*) tflag=;;
+ --template=*) tflag=;;
+ @*) read_response "${arg#"@"}" ;;
+ --) break;;
+ esac
+done
+
+exec "$executablename" ${tflag:+"$tflag"} $HSC2HS_EXTRA ${1+"$@"} "$Iflag"
=====================================
testsuite/tests/core-to-stg/T24718.hs
=====================================
@@ -0,0 +1,12 @@
+module T24718 where
+
+import GHC.Exts ( Any )
+import Unsafe.Coerce ( unsafeCoerce )
+
+data T = MkT (Any -> Any)
+
+g :: () -> ()
+g x = x
+
+f :: T
+f = unsafeCoerce MkT g
=====================================
testsuite/tests/core-to-stg/all.T
=====================================
@@ -2,3 +2,4 @@
test('T19700', normal, compile, ['-O'])
test('T23914', normal, compile, ['-O'])
+test('T24718', normal, compile, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f15dd7bdbed3fc251e39ca1908552ce1490d0d81...52e82b4d710ad7987cae219eab1dec113a457b53
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f15dd7bdbed3fc251e39ca1908552ce1490d0d81...52e82b4d710ad7987cae219eab1dec113a457b53
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/20240923/8b4be29b/attachment-0001.html>
More information about the ghc-commits
mailing list