[Git][ghc/ghc][master] Make WorkWrap.Lib.isWorkerSmallEnough aware of the old arity

Marge Bot gitlab at gitlab.haskell.org
Tue May 26 07:04:15 UTC 2020



 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
6604906c by Sebastian Graf at 2020-05-26T03:04:04-04:00
Make WorkWrap.Lib.isWorkerSmallEnough aware of the old arity

We should allow a wrapper with up to 82 parameters when the original
function had 82 parameters to begin with.

I verified that this made no difference on NoFib, but then again
it doesn't use huge records...

Fixes #18122.

- - - - -


7 changed files:

- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Rules.hs
- docs/users_guide/using-optimisation.rst
- + testsuite/tests/stranal/should_compile/T18122.hs
- + testsuite/tests/stranal/should_compile/T18122.stderr
- testsuite/tests/stranal/should_compile/all.T


Changes:

=====================================
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


=====================================
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
 


=====================================
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]
 ~~~~~~~~~~~~~~~~~~~~


=====================================
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


=====================================
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 #-}


=====================================
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
+      }
+      }
+      }
+      }
+
+
+


=====================================
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'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6604906c8cfa37f5780a6d5c40506b751b1740db

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6604906c8cfa37f5780a6d5c40506b751b1740db
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/20200526/45fa9fcb/attachment-0001.html>


More information about the ghc-commits mailing list