[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add performance regression test for '-fwrite-simplified-core'
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Apr 23 11:29:18 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
c10aa9c2 by Fendor at 2024-04-23T07:29:08-04:00
Add performance regression test for '-fwrite-simplified-core'
- - - - -
3ef14446 by Fendor at 2024-04-23T07:29:08-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]
- - - - -
7648fd9c by Alan Zimmerman at 2024-04-23T07:29:09-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
- - - - -
9 changed files:
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Parser.y
- 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/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
=====================================
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/3ebc50577413429b7f6facade9a5885d932bacfa...7648fd9cd93b0f686452f0b5e3c7900447893ec5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ebc50577413429b7f6facade9a5885d932bacfa...7648fd9cd93b0f686452f0b5e3c7900447893ec5
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/e943902a/attachment-0001.html>
More information about the ghc-commits
mailing list