[Git][ghc/ghc][wip/T22317] Simplifier: Consider `seq` as a `BoringCtxt` (#22317)

Sebastian Graf (@sgraf812) gitlab at gitlab.haskell.org
Tue Nov 15 20:36:48 UTC 2022



Sebastian Graf pushed to branch wip/T22317 at Glasgow Haskell Compiler / GHC


Commits:
57e13cf3 by Sebastian Graf at 2022-11-15T21:36:18+01:00
Simplifier: Consider `seq` as a `BoringCtxt` (#22317)

See `Note [Seq is boring]` for the rationale.

Fixes #22317.

- - - - -


5 changed files:

- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Unfold.hs
- + testsuite/tests/simplCore/should_compile/T22317.hs
- + testsuite/tests/simplCore/should_compile/T22317.stderr
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -740,8 +740,8 @@ Note [Interesting call context]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We want to avoid inlining an expression where there can't possibly be
 any gain, such as in an argument position.  Hence, if the continuation
-is interesting (eg. a case scrutinee, application etc.) then we
-inline, otherwise we don't.
+is interesting (eg. a case scrutinee that isn't just a seq, application etc.)
+then we inline, otherwise we don't.
 
 Previously some_benefit used to return True only if the variable was
 applied to some value arguments.  This didn't work:
@@ -781,6 +781,39 @@ expression into the branches of any case in f's unfolding.  So, to
 reduce unnecessary code expansion, we just make the context look boring.
 This made a small compile-time perf improvement in perf/compiler/T6048,
 and it looks plausible to me.
+
+Note [Seq is boring]
+~~~~~~~~~~~~~~~~~~~~
+Consider T22317
+
+  data T = T (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
+
+  m :: Maybe a -> Maybe a -> Maybe a
+  m = \ (@a_az7) (ds_dAn :: Maybe a_az7) (ds_dAo :: Maybe a_az7) ->
+      case ds_dAn of {
+        Nothing -> ds_dAo;
+        Just v1_awh ->
+          case ds_dAo of wild_X2 {
+            Nothing -> GHC.Maybe.Just @a_az7 v1_awh;
+            Just ipv_sAC -> ds_dAo
+          }
+      }
+  {-# INLINE m #-}
+
+  f :: T -> T -> T
+  f = \ (ds_dAv :: T) (ds_dAw :: T) ->
+        case ds_dAv of { T a1_awj b1_awk c1_awl d1_awm ->
+        case ds_dAw of { T a2_awn b2_awo c2_awp d2_awq ->
+        case m @Bool a1_awj a2_awn of a_X3 { __DEFAULT ->
+        case m @Bool b1_awk b2_awo of b_X4 { __DEFAULT ->
+        case m @Bool c1_awl c2_awp of c_X6 { __DEFAULT ->
+        case m @Bool d1_awm d2_awq of d_X8 { __DEFAULT ->
+        Lib.T a_X3 b_X4 c_X6 d_X8 }}}}}}
+
+Here we gain absolutely nothing by inlining `m`, just a bunch of join points
+from `m`'s definition and and case-of-case, bloating up the code.
+Hence even though case-of-case would fire here, we refrain from inlining `m`.
+We do so by regarding a seq context as a `BoringCtxt` (not `CaseCxt`).
 -}
 
 lazyArgContext :: ArgInfo -> CallCtxt
@@ -811,10 +844,11 @@ interestingCallContext :: SimplEnv -> SimplCont -> CallCtxt
 interestingCallContext env cont
   = interesting cont
   where
-    interesting (Select {})
-       | seCaseCase env = CaseCtxt
-       | otherwise      = BoringCtxt
-       -- See Note [No case of case is boring]
+    interesting (Select {sc_alts=alts})
+      | not (seCaseCase env)      = BoringCtxt -- See Note [No case of case is boring]
+      | [Alt DEFAULT _ _] <- alts = BoringCtxt -- See Note [Seq is boring]
+      | otherwise                 = CaseCtxt
+
 
     interesting (ApplyToVal {}) = ValAppCtxt
         -- Can happen if we have (f Int |> co) y


=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -1347,8 +1347,11 @@ call is at least CONLIKE.  At least for the cases where we use ArgCtxt
 for the RHS of a 'let', we only profit from the inlining if we get a
 CONLIKE thing (modulo lets).
 
-Note [Lone variables]   See also Note [Interaction of exprIsWorkFree and lone variables]
-~~~~~~~~~~~~~~~~~~~~~   which appears below
+Note [Lone variables]
+~~~~~~~~~~~~~~~~~~~~~
+See also Note [Interaction of exprIsWorkFree and lone variables]
+which appears below
+
 The "lone-variable" case is important.  I spent ages messing about
 with unsatisfactory variants, but this is nice.  The idea is that if a
 variable appears all alone


=====================================
testsuite/tests/simplCore/should_compile/T22317.hs
=====================================
@@ -0,0 +1,20 @@
+{-# LANGUAGE BangPatterns #-}
+
+module T22317 where
+
+data T = T (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
+
+
+m :: Maybe a -> Maybe a -> Maybe a
+m (Just v1) Nothing = Just v1
+m _         mb      = mb
+{-# INLINE m #-}
+
+f :: T -> T -> T
+f (T a1 b1 c1 d1) (T a2 b2 c2 d2)
+  = let j1 !a = let j2 !b = let j3 !c = let j4 !d = T a b c d
+                                        in j4 (m d1 d2)
+                            in j3 (m c1 c2)
+                in j2 (m b1 b2)
+    in j1 (m a1 a2)
+{-# OPAQUE f #-}


=====================================
testsuite/tests/simplCore/should_compile/T22317.stderr
=====================================
@@ -0,0 +1,256 @@
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -449,3 +449,5 @@ test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeab
 # One module, T21851_2.hs, has OPTIONS_GHC -ddump-simpl
 # Expecting to see $s$wwombat
 test('T21851_2', [grep_errmsg(r'wwombat') ], multimod_compile, ['T21851_2', '-O -dno-typeable-binds -dsuppress-uniques'])
+# Should not inline m, so there shouldn't be a single YES
+test('T22317', [grep_errmsg(r'ANSWER = YES') ], compile, ['-O -dinline-check m -ddebug-output'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57e13cf3930733205396b7e69ea8be56ea82381c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57e13cf3930733205396b7e69ea8be56ea82381c
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/20221115/e1233f94/attachment-0001.html>


More information about the ghc-commits mailing list