[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Add performance regression test for '-fwrite-simplified-core'
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Apr 23 14:51:26 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
593f4e04 by Fendor at 2024-04-23T10:19:14-04:00
Add performance regression test for '-fwrite-simplified-core'
- - - - -
1ba39b05 by Fendor at 2024-04-23T10:19:14-04:00
Typecheck corebindings lazily during bytecode generation
This delays typechecking the corebindings until the bytecode generation
happens.
We also avoid allocating a thunk that is retained by `unsafeInterleaveIO`.
In general, we shouldn't retain values of the hydrated `Type`, as not evaluating
the bytecode object keeps it alive.
It is better if we retain the unhydrated `IfaceType`.
See Note [Hydrating Modules]
- - - - -
e916fc92 by Alan Zimmerman at 2024-04-23T10:19:50-04:00
EPA: Keep comments in a CaseAlt match
The comments now live in the surrounding location, not inside the
Match. Make sure we keep them.
Closes #24707
- - - - -
f4894722 by Cheng Shao at 2024-04-23T10:51:07-04:00
driver: force merge objects when building dynamic objects
This patch forces the driver to always merge objects when building
dynamic objects even when ar -L is supported. It is an oversight of
!8887: original rationale of that patch is favoring the relatively
cheap ar -L operation over object merging when ar -L is supported,
which makes sense but only if we are building static objects! Omitting
check for whether we are building dynamic objects will result in
broken .so files with undefined reference errors at executable link
time when building GHC with llvm-ar. Fixes #22210.
- - - - -
c6b0e030 by Julian Ospald at 2024-04-23T10:51:12-04:00
Allow non-absolute values for bootstrap GHC variable
Fixes #24682
- - - - -
d1b92a39 by Matthew Pickering at 2024-04-23T10:51:13-04:00
Don't depend on registerPackage function in Cabal
More recent versions of Cabal modify the behaviour of libAbiHash which
breaks our usage of registerPackage.
It is simpler to inline the part of registerPackage that we need and
avoid any additional dependency and complication using the higher-level
function introduces.
- - - - -
12 changed files:
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Parser.y
- configure.ac
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- testsuite/tests/perf/compiler/Makefile
- + testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithCore.script
- testsuite/tests/perf/compiler/all.T
- + testsuite/tests/perf/compiler/genMultiLayerModulesCore
- + testsuite/tests/printer/CaseAltComments.hs
- testsuite/tests/printer/Makefile
- testsuite/tests/printer/all.T
Changes:
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -990,16 +990,16 @@ initWholeCoreBindings hsc_env mod_iface details (LM utc_time this_mod uls) = LM
types_var <- newIORef (md_types details)
let kv = knotVarsFromModuleEnv (mkModuleEnv [(this_mod, types_var)])
let hsc_env' = hscUpdateHPT act hsc_env { hsc_type_env_vars = kv }
- core_binds <- initIfaceCheck (text "l") hsc_env' $ typecheckWholeCoreBindings types_var fi
- -- MP: The NoStubs here is only from (I think) the TH `qAddForeignFilePath` feature but it's a bit unclear what to do
- -- with these files, do we have to read and serialise the foreign file? I will leave it for now until someone
- -- reports a bug.
- let cgi_guts = CgInteractiveGuts this_mod core_binds (typeEnvTyCons (md_types details)) NoStubs Nothing []
-- The bytecode generation itself is lazy because otherwise even when doing
-- recompilation checking the bytecode will be generated (which slows things down a lot)
-- the laziness is OK because generateByteCode just depends on things already loaded
-- in the interface file.
LoadedBCOs <$> (unsafeInterleaveIO $ do
+ core_binds <- initIfaceCheck (text "l") hsc_env' $ typecheckWholeCoreBindings types_var fi
+ -- MP: The NoStubs here is only from (I think) the TH `qAddForeignFilePath` feature but it's a bit unclear what to do
+ -- with these files, do we have to read and serialise the foreign file? I will leave it for now until someone
+ -- reports a bug.
+ let cgi_guts = CgInteractiveGuts this_mod core_binds (typeEnvTyCons (md_types details)) NoStubs Nothing []
trace_if (hsc_logger hsc_env) (text "Generating ByteCode for" <+> (ppr this_mod))
generateByteCode hsc_env cgi_guts (wcb_mod_location fi))
go ul = return ul
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -1040,13 +1040,22 @@ this is accomplished with the `ld -r` command. We rely on this for two ends:
The command used for object linking is set using the -pgmlm and -optlm
command-line options.
-Sadly, the LLD linker that we use on Windows does not support the `-r` flag
-needed to support object merging (see #21068). For this reason on Windows we do
-not support GHCi objects. To deal with foreign stubs we build a static archive
-of all of a module's object files instead merging them. Consequently, we can
-end up producing `.o` files which are in fact static archives. However,
-toolchains generally don't have a problem with this as they use file headers,
-not the filename, to determine the nature of inputs.
+However, `ld -r` is broken in some cases:
+
+ * The LLD linker that we use on Windows does not support the `-r`
+ flag needed to support object merging (see #21068). For this reason
+ on Windows we do not support GHCi objects.
+ * `wasm-ld -r` is prohibitively slow, especially when handling large
+ input objects (e.g. profiled objects).
+
+In these cases, we bundle a module's own object file with its foreign
+stub's object file, instead of merging them. Consequently, we can end
+up producing `.o` files which are in fact static archives. This can
+only work if `ar -L` is supported, so the archive `.o` files can be
+properly added to the final static library. We must also take care not
+to produce archive `.dyn_o` when building dynamic objects, otherwise
+we end up with broken `.so` files when GHC is built with `llvm-ar`
+(#22210).
Note that this has somewhat non-obvious consequences when producing
initializers and finalizers. See Note [Initializers and finalizers in Cmm]
@@ -1072,7 +1081,7 @@ via gcc.
-- | See Note [Object merging].
joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO ()
joinObjectFiles hsc_env o_files output_fn
- | can_merge_objs && not dashLSupported = do
+ | can_merge_objs && (not dashLSupported || is_dyn) = do
let toolSettings' = toolSettings dflags
ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'
ld_r args = GHC.SysTools.runMergeObjects (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) (
@@ -1100,6 +1109,7 @@ joinObjectFiles hsc_env o_files output_fn
withAtomicRename output_fn $ \tmp_ar ->
liftIO $ runAr logger dflags Nothing $ map Option $ ["qc" ++ dashL, tmp_ar] ++ o_files
where
+ is_dyn = ways dflags `hasWay` WayDyn
dashLSupported = sArSupportsDashL (settings dflags)
dashL = if dashLSupported then "L" else ""
can_merge_objs = isJust (pgm_lm (hsc_dflags hsc_env))
=====================================
compiler/GHC/Parser.y
=====================================
@@ -3342,7 +3342,7 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs
alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }
: PATS alt_rhs { $2 >>= \ $2 ->
- acsA (sLLAsl $1 $> ()) (\loc cs -> L (locA loc)
+ amsA' (sLLAsl $1 $>
(Match { m_ext = []
, m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing
, m_pats = $1
=====================================
configure.ac
=====================================
@@ -97,11 +97,11 @@ dnl use either is considered a Feature.
dnl ** What command to use to compile compiler sources ?
dnl --------------------------------------------------------------
-AC_ARG_VAR(GHC,[Use as the full path to GHC. [default=autodetect]])
-AC_PATH_PROG([GHC], [ghc])
+AC_ARG_VAR(GHC,[Use as the bootstrap GHC. [default=autodetect]])
+AC_CHECK_PROG([GHC], [ghc], [ghc])
AC_ARG_WITH([ghc],
- AS_HELP_STRING([--with-ghc=PATH], [Use PATH as the full path to ghc (obsolete, use GHC=PATH instead) [default=autodetect]]),
- AC_MSG_ERROR([--with-ghc=$withval is obsolete (use './configure GHC=$withval' or 'GHC=$withval ./configure' instead)]))
+ AS_HELP_STRING([--with-ghc=PATH], [Use PATH as the bootstrap ghc (obsolete, use GHC=PATH instead) [default=autodetect]]),
+ AC_MSG_ERROR([--with-ghc=$withval is obsolete (use './configure GHC=$withval' instead)]))
AC_SUBST(WithGhc,$GHC)
AC_ARG_ENABLE(bootstrap-with-devel-snapshot,
=====================================
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
=====================================
@@ -31,6 +31,7 @@ import qualified Distribution.PackageDescription.Parsec as C
import qualified Distribution.Simple.Compiler as C
import qualified Distribution.Simple.Program.Db as C
import qualified Distribution.Simple as C
+import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.Program.Builtin as C
import qualified Distribution.Simple.Utils as C
import qualified Distribution.Simple.Program.Types as C
@@ -363,12 +364,11 @@ registerPackage rs context = do
need [setupConfig] -- This triggers 'configurePackage'
pd <- packageDescription <$> readContextData context
db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context))
- dist_dir <- Context.buildPath context
pid <- pkgUnitId (stage context) (package context)
-- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
-- from the local build info @lbi at .
lbi <- liftIO $ C.getPersistBuildConfig cPath
- liftIO $ register db_path pid dist_dir pd lbi
+ liftIO $ register db_path pid pd lbi
-- Then after the register, which just writes the .conf file, do the recache step.
buildWithResources rs $
target context (GhcPkg Recache (stage context)) [] []
@@ -377,25 +377,23 @@ registerPackage rs context = do
-- into a different package database to the one it was configured against.
register :: FilePath
-> String -- ^ Package Identifier
- -> FilePath
-> C.PackageDescription
-> LocalBuildInfo
-> IO ()
-register pkg_db pid build_dir pd lbi
+register pkg_db pid pd lbi
= withLibLBI pd lbi $ \lib clbi -> do
- absPackageDBs <- C.absolutePackageDBPaths packageDbs
- installedPkgInfo <- C.generateRegistrationInfo
- C.silent pd lib lbi clbi False reloc build_dir
- (C.registrationPackageDB absPackageDBs)
-
+ when reloc $ error "register does not support reloc"
+ installedPkgInfo <- generateRegistrationInfo pd lbi lib clbi
writeRegistrationFile installedPkgInfo
where
regFile = pkg_db </> pid <.> "conf"
reloc = relocatable lbi
- -- Using a specific package db here is why we have to copy the function from Cabal.
- packageDbs = [C.SpecificPackageDB pkg_db]
+
+ generateRegistrationInfo pkg lbi lib clbi = do
+ abi_hash <- C.mkAbiHash <$> GHC.libAbiHash C.silent pkg lbi lib clbi
+ return (C.absoluteInstalledPackageInfo pkg abi_hash lib lbi clbi)
writeRegistrationFile installedPkgInfo = do
writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo)
=====================================
testsuite/tests/perf/compiler/Makefile
=====================================
@@ -17,6 +17,12 @@ MultiModulesRecomp:
./genMultiLayerModules
'$(TEST_HC)' $(TEST_HC_OPTS) -v0 MultiLayerModules.hs
+# -e "" exits the ghci session immediately and merely makes sure, we generated interface files
+# containing core expressions, aka `mi_extra_decls` are populated.
+MultiModulesRecompDefsWithCore:
+ ./genMultiLayerModulesCore
+ '$(TEST_HC)' --interactive $(TEST_HC_OPTS) -e "" -fwrite-if-simplified-core MultiLayerModules
+
MultiComponentModulesRecomp:
'$(PYTHON)' genMultiComp.py
TEST_HC='$(TEST_HC)' TEST_HC_OPTS='$(TEST_HC_OPTS)' ./run
=====================================
testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithCore.script
=====================================
@@ -0,0 +1 @@
+:m + MultiLayerModules
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -405,6 +405,20 @@ test('MultiLayerModulesDefsGhci',
ghci_script,
['MultiLayerModulesDefsGhci.script'])
+test('MultiLayerModulesDefsGhciWithCore',
+ [ collect_compiler_residency(15),
+ pre_cmd('$MAKE -s --no-print-directory MultiModulesRecompDefsWithCore'),
+ extra_files(['genMultiLayerModulesCore', 'MultiLayerModulesDefsGhciWithCore.script']),
+ compile_timeout_multiplier(5),
+ # this is _a lot_
+ # but this test has been failing every now and then,
+ # especially on i386. Let's just give it some room
+ # to complete successfully reliably everywhere.
+ extra_run_opts('-fwrite-if-simplified-core MultiLayerModules')
+ ],
+ ghci_script,
+ ['MultiLayerModulesDefsGhciWithCore.script'])
+
test('MultiLayerModulesDefsGhciReload',
[ collect_compiler_residency(15),
pre_cmd('./genMultiLayerModulesDefs'),
=====================================
testsuite/tests/perf/compiler/genMultiLayerModulesCore
=====================================
@@ -0,0 +1,28 @@
+#!/usr/bin/env bash
+# Generate $WIDTH modules with one type each $FIELDS type variables.
+# The type has $CONSTRS constructors with each $FIELDS fields.
+# All types derive 'Generic' to generate a large amount of Types.
+# MultiLayerModules.hs imports all the modules
+WIDTH=10
+FIELDS=10
+CONSTRS=15
+FIELD_VARS=$(for field in $(seq -w 1 $FIELDS); do echo -n "a${field} "; done)
+for i in $(seq -w 1 $WIDTH); do
+ echo "module DummyLevel$i where" > DummyLevel$i.hs;
+ echo "import GHC.Generics" >> DummyLevel$i.hs;
+ echo "data Type_${i} ${FIELD_VARS}" >> DummyLevel$i.hs;
+ for constr in $(seq -w 1 $CONSTRS); do
+ if [ $constr -eq 1 ]; then
+ echo -n " = Constr_${i}_${constr} " >> DummyLevel$i.hs;
+ else
+ echo -n " | Constr_${i}_${constr} " >> DummyLevel$i.hs;
+ fi
+ echo ${FIELD_VARS} >> DummyLevel$i.hs;
+ done
+ echo " deriving (Show, Eq, Ord, Generic)" >> DummyLevel$i.hs;
+done
+
+echo "module MultiLayerModules where" > MultiLayerModules.hs
+for j in $(seq -w 1 $WIDTH); do
+ echo "import DummyLevel$j" >> MultiLayerModules.hs;
+done
=====================================
testsuite/tests/printer/CaseAltComments.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternGuards #-}
+module CaseAltComments where
+
+nfCom = case expr of
+ x :*: y -- comment
+ | x' <= y' -> x' :*: y'
+ _ -> blah
=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -826,3 +826,8 @@ Test24533:
PprLetIn:
$(CHECK_PPR) $(LIBDIR) PprLetIn.hs
$(CHECK_EXACT) $(LIBDIR) PprLetIn.hs
+
+.PHONY: CaseAltComments
+CaseAltComments:
+ $(CHECK_PPR) $(LIBDIR) CaseAltComments.hs
+ $(CHECK_EXACT) $(LIBDIR) CaseAltComments.hs
=====================================
testsuite/tests/printer/all.T
=====================================
@@ -198,3 +198,4 @@ test('ListTuplePuns', extra_files(['ListTuplePuns.hs']), ghci_script, ['ListTupl
test('AnnotationNoListTuplePuns', [ignore_stderr, req_ppr_deps], makefile_test, ['AnnotationNoListTuplePuns'])
test('Test24533', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24533'])
test('PprLetIn', [ignore_stderr, req_ppr_deps], makefile_test, ['PprLetIn'])
+test('CaseAltComments', [ignore_stderr, req_ppr_deps], makefile_test, ['CaseAltComments'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7648fd9cd93b0f686452f0b5e3c7900447893ec5...d1b92a396fd4201d34d0d7dbe74c3d5dd86ff1fa
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7648fd9cd93b0f686452f0b5e3c7900447893ec5...d1b92a396fd4201d34d0d7dbe74c3d5dd86ff1fa
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/20240423/95cd75c3/attachment-0001.html>
More information about the ghc-commits
mailing list