diff options
| -rw-r--r-- | compiler/GHC/Core/Opt/SpecConstr.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap/Utils.hs | 12 | ||||
| -rw-r--r-- | compiler/GHC/Core/Rules.hs | 2 | ||||
| -rw-r--r-- | docs/users_guide/using-optimisation.rst | 7 | ||||
| -rw-r--r-- | testsuite/tests/stranal/should_compile/T18122.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/stranal/should_compile/T18122.stderr | 83 | ||||
| -rw-r--r-- | testsuite/tests/stranal/should_compile/all.T | 3 |
7 files changed, 108 insertions, 11 deletions
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs index d2c431765b..5b5a63a43a 100644 --- a/compiler/GHC/Core/Opt/SpecConstr.hs +++ b/compiler/GHC/Core/Opt/SpecConstr.hs @@ -1947,7 +1947,7 @@ callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls -- Remove ones that have too many worker variables small_pats = filterOut too_big non_dups - too_big (vars,_) = not (isWorkerSmallEnough (sc_dflags env) vars) + too_big (vars,args) = not (isWorkerSmallEnough (sc_dflags env) (valArgCount args) vars) -- We are about to construct w/w pair in 'spec_one'. -- Omit specialisation leading to high arity workers. -- See Note [Limit w/w arity] in GHC.Core.Opt.WorkWrap.Utils @@ -2101,12 +2101,12 @@ argToPat _env _in_scope _val_env arg@(Type {}) _arg_occ argToPat env in_scope val_env (Tick _ arg) arg_occ = argToPat env in_scope val_env arg arg_occ - -- Note [Notes in call patterns] + -- Note [Tick annotations in call patterns] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Ignore Notes. In particular, we want to ignore any InlineMe notes -- Perhaps we should not ignore profiling notes, but I'm going to -- ride roughshod over them all for now. - --- See Note [Notes in RULE matching] in GHC.Core.Rules + --- See Note [Tick annotations in RULE matching] in GHC.Core.Rules argToPat env in_scope val_env (Let _ arg) arg_occ = argToPat env in_scope val_env arg arg_occ diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs index 5ea719ac5b..44ab7f1946 100644 --- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs +++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs @@ -162,7 +162,7 @@ mkWwBodies dflags fam_envs rhs_fvs fun_id demands cpr_info wrapper_body = wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var worker_body = mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args - ; if isWorkerSmallEnough dflags work_args + ; if isWorkerSmallEnough dflags (length demands) work_args && not (too_many_args_for_join_point wrap_args) && ((useful1 && not only_one_void_argument) || useful2) then return (Just (worker_args_dmds, length work_call_args, @@ -203,10 +203,13 @@ mkWwBodies dflags fam_envs rhs_fvs fun_id demands cpr_info = False -- See Note [Limit w/w arity] -isWorkerSmallEnough :: DynFlags -> [Var] -> Bool -isWorkerSmallEnough dflags vars = count isId vars <= maxWorkerArgs dflags +isWorkerSmallEnough :: DynFlags -> Int -> [Var] -> Bool +isWorkerSmallEnough dflags old_n_args vars + = count isId vars <= max old_n_args (maxWorkerArgs dflags) -- We count only Free variables (isId) to skip Type, Kind -- variables which have no runtime representation. + -- Also if the function took 82 arguments before (old_n_args), it's fine if + -- it takes <= 82 arguments afterwards. {- Note [Always do CPR w/w] @@ -227,7 +230,8 @@ Guard against high worker arity as it generates a lot of stack traffic. A simplified example is #11565#comment:6 Current strategy is very simple: don't perform w/w transformation at all -if the result produces a wrapper with arity higher than -fmax-worker-args=. +if the result produces a wrapper with arity higher than -fmax-worker-args +and the number arguments before w/w. It is a bit all or nothing, consider diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs index 55a099efbd..abf9614cb6 100644 --- a/compiler/GHC/Core/Rules.hs +++ b/compiler/GHC/Core/Rules.hs @@ -1034,7 +1034,7 @@ ways in which these may be introduced (e.g. #18162, #17619). Such ticks are ignored by the matcher. See Note [Simplifying rules] in GHC.Core.Opt.Simplify.Utils for details. -cf Note [Notes in call patterns] in GHC.Core.Opt.SpecConstr +cf Note [Tick annotations in call patterns] in GHC.Core.Opt.SpecConstr Note [Matching lets] ~~~~~~~~~~~~~~~~~~~~ diff --git a/docs/users_guide/using-optimisation.rst b/docs/users_guide/using-optimisation.rst index 8ec19cb147..25e46fb5ef 100644 --- a/docs/users_guide/using-optimisation.rst +++ b/docs/users_guide/using-optimisation.rst @@ -655,14 +655,15 @@ by saying ``-fno-wombat``. Sets the maximal number of iterations for the simplifier. .. ghc-flag:: -fmax-worker-args=⟨n⟩ - :shortdesc: *default: 10.* If a worker has that many arguments, none will - be unpacked anymore. + :shortdesc: *default: 10.* Maximum number of value arguments for a worker. :type: dynamic :category: :default: 10 - If a worker has that many arguments, none will be unpacked anymore. + A function will not be split into worker and wrapper if the number of + value arguments of the resulting worker exceeds both that of the original + function and this setting. .. ghc-flag:: -fno-opt-coercion :shortdesc: Turn off the coercion optimiser diff --git a/testsuite/tests/stranal/should_compile/T18122.hs b/testsuite/tests/stranal/should_compile/T18122.hs new file mode 100644 index 0000000000..fee63f9bfe --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T18122.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -fforce-recomp -O2 -fmax-worker-args=1 #-} +module Lib where + +foo :: (Int, Int) -> Int -> Int +foo (x, y) z = x+z +{-# NOINLINE foo #-} diff --git a/testsuite/tests/stranal/should_compile/T18122.stderr b/testsuite/tests/stranal/should_compile/T18122.stderr new file mode 100644 index 0000000000..ff18350279 --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T18122.stderr @@ -0,0 +1,83 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 35, types: 27, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Lib.$trModule4 :: GHC.Prim.Addr# +[GblId, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Lib.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Lib.$trModule3 :: GHC.Types.TrName +[GblId, + Cpr=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Lib.$trModule3 = GHC.Types.TrNameS Lib.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Lib.$trModule2 :: GHC.Prim.Addr# +[GblId, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Lib.$trModule2 = "Lib"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Lib.$trModule1 :: GHC.Types.TrName +[GblId, + Cpr=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Lib.$trModule1 = GHC.Types.TrNameS Lib.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +Lib.$trModule :: GHC.Types.Module +[GblId, + Cpr=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Lib.$trModule = GHC.Types.Module Lib.$trModule3 Lib.$trModule1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Lib.$wfoo [InlPrag=NOINLINE] + :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# +[GblId, Arity=2, Str=<L,U><L,U>, Unf=OtherCon []] +Lib.$wfoo = (GHC.Prim.+#) + +-- RHS size: {terms: 18, types: 14, coercions: 0, joins: 0/0} +foo [InlPrag=NOUSERINLINE[0]] :: (Int, Int) -> Int -> Int +[GblId, + Arity=2, + Str=<S(SL),1*U(1*U(U),A)><S,1*U(U)>, + Cpr=m1, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (w_sHs [Occ=Once!] :: (Int, Int)) + (w1_sHt [Occ=Once!] :: Int) -> + case w_sHs of { (ww1_sHw [Occ=Once!], _ [Occ=Dead]) -> + case ww1_sHw of { GHC.Types.I# ww4_sHz [Occ=Once] -> + case w1_sHt of { GHC.Types.I# ww6_sHF [Occ=Once] -> + case Lib.$wfoo ww4_sHz ww6_sHF of ww7_sHJ [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww7_sHJ + } + } + } + }}] +foo + = \ (w_sHs :: (Int, Int)) (w1_sHt :: Int) -> + case w_sHs of { (ww1_sHw, ww2_sHB) -> + case ww1_sHw of { GHC.Types.I# ww4_sHz -> + case w1_sHt of { GHC.Types.I# ww6_sHF -> + case Lib.$wfoo ww4_sHz ww6_sHF of ww7_sHJ { __DEFAULT -> + GHC.Types.I# ww7_sHJ + } + } + } + } + + + diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index e807e4f9d8..bb3fcd2952 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -52,3 +52,6 @@ test('T17852', [ grep_errmsg(r'\\$wf ::') ], compile, ['-ddump-worker-wrapper - test('T16029', normal, makefile_test, []) test('T10069', [ grep_errmsg(r'(wc1).*Int#$') ], compile, ['-dppr-cols=200 -ddump-simpl']) test('T13380b', [ grep_errmsg('bigDeadAction') ], compile, ['-dppr-cols=200 -ddump-simpl']) + +# We just want to find the worker of foo in there: +test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) |