From a593f28426ca508a72b49d0112ef934ce9f453fd Mon Sep 17 00:00:00 2001
From: Andreas Klebinger <klebinger.andreas@gmx.at>
Date: Mon, 13 May 2024 19:52:13 +0200
Subject: [PATCH] Expand the `inline` rule to look through casts/ticks.
Fixes #24808
---
compiler/GHC/Core/Opt/ConstantFold.hs | 20 ++-
.../tests/simplCore/should_compile/T24808.hs | 27 ++++
.../simplCore/should_compile/T24808.stderr | 151 ++++++++++++++++++
.../tests/simplCore/should_compile/all.T | 1 +
4 files changed, 194 insertions(+), 5 deletions(-)
create mode 100644 testsuite/tests/simplCore/should_compile/T24808.hs
create mode 100644 testsuite/tests/simplCore/should_compile/T24808.stderr
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index b295a70b0a67..834b2936237c 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -2602,6 +2602,10 @@ The moving parts are simple:
inline f_ty (f a b c) = <f's unfolding> a b c
(if f has an unfolding, EVEN if it's a loop breaker)
+ Additionally the rule looks through ticks/casts as well (#24808):
+ inline f_ty (f a b c |> co) = <f's unfolding> a b c |> co
+ inline f_ty <tick> ( f a b c ) = <tick> <f's unfolding> a b c
+
It's important to allow the argument to 'inline' to have args itself
(a) because its more forgiving to allow the programmer to write
either inline f a b c
@@ -2614,11 +2618,17 @@ The moving parts are simple:
-}
match_inline :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)
-match_inline (Type _ : e : _)
- | (Var f, args1) <- collectArgs e,
- Just unf <- maybeUnfoldingTemplate (realIdUnfolding f)
- -- Ignore the IdUnfoldingFun here!
- = Just (mkApps unf args1)
+match_inline (Type _ : e : _) = go e
+ -- Maybe Monad ahead:
+ where
+ go (Var f) = -- Ignore the IdUnfoldingFun here!
+ (maybeUnfoldingTemplate (realIdUnfolding f))
+ go (App f a) = do { f' <- go f; pure $ App f' a }
+ -- inline (f |> co)
+ go (Cast e co) = do { app <- go e; pure (Cast app co) }
+ -- inline (<tick> f)
+ go (Tick t e) = do { app <- go e; pure (Tick t app) }
+ go _ = Nothing
match_inline _ = Nothing
diff --git a/testsuite/tests/simplCore/should_compile/T24808.hs b/testsuite/tests/simplCore/should_compile/T24808.hs
new file mode 100644
index 000000000000..95903331f6a5
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T24808.hs
@@ -0,0 +1,27 @@
+{-# OPTIONS_GHC -O -fno-cse -dno-typeable-binds -dsuppress-uniques #-}
+-- -fno-cse avoids things being un-inlined via cse.
+
+-- Tests that we inline through casts when using `inline`.
+-- The test works by grepping for myFunction, seeing how often it occurs in rhss
+
+module T24808 where
+
+import GHC.Exts (inline)
+import Data.Coerce
+
+-- A type we can coerce
+newtype MyMaybe = MyMaybe { getMaybe :: (Maybe Int) }
+
+myFunction :: MyMaybe -> MyMaybe
+myFunction (MyMaybe m) = case m of
+ Nothing -> MyMaybe Nothing
+ -- Make it largeish
+ Just n -> MyMaybe $ Just $ succ . succ . succ . succ . succ . succ . succ . succ . succ . succ $ n
+
+-- Inlines as expected
+bar :: MyMaybe -> MyMaybe
+bar = inline myFunction
+
+-- Doesn't inline - but I think it should.
+foo :: MyMaybe -> Maybe Int
+foo = (inline (coerce myFunction))
diff --git a/testsuite/tests/simplCore/should_compile/T24808.stderr b/testsuite/tests/simplCore/should_compile/T24808.stderr
new file mode 100644
index 000000000000..2217141b239d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T24808.stderr
@@ -0,0 +1,151 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 121, types: 42, coercions: 23, joins: 0/0}
+
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+T24808.getMaybe1 :: MyMaybe -> MyMaybe
+[GblId,
+ Arity=1,
+ Str=<1L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
+T24808.getMaybe1 = \ (ds_dFC :: MyMaybe) -> ds_dFC
+
+-- RHS size: {terms: 1, types: 0, coercions: 4, joins: 0/0}
+getMaybe :: MyMaybe -> Maybe Int
+[GblId[[RecSel]],
+ Arity=1,
+ Str=<1L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
+getMaybe
+ = T24808.getMaybe1
+ `cast` (<MyMaybe>_R %<Many>_N ->_R T24808.N:MyMaybe[0]
+ :: (MyMaybe -> MyMaybe) ~R# (MyMaybe -> Maybe Int))
+
+-- RHS size: {terms: 37, types: 9, coercions: 5, joins: 0/0}
+myFunction :: MyMaybe -> MyMaybe
+[GblId,
+ Arity=1,
+ Str=<1L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [30] 161 20}]
+myFunction
+ = \ (ds_dFw :: MyMaybe) ->
+ case ds_dFw `cast` (T24808.N:MyMaybe[0] :: MyMaybe ~R# Maybe Int)
+ of {
+ Nothing ->
+ (GHC.Internal.Maybe.Nothing @Int)
+ `cast` (Sym (T24808.N:MyMaybe[0]) :: Maybe Int ~R# MyMaybe);
+ Just n_axK ->
+ (GHC.Internal.Maybe.Just
+ @Int
+ (case n_axK of { GHC.Types.I# x1_aFS ->
+ case x1_aFS of wild2_aFU {
+ __DEFAULT -> GHC.Types.I# (GHC.Prim.+# 10# wild2_aFU);
+ 9223372036854775798# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775799# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775800# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775801# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775802# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775803# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775804# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775805# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775806# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775807# -> GHC.Internal.Enum.$fEnumInt2
+ }
+ }))
+ `cast` (Sym (T24808.N:MyMaybe[0]) :: Maybe Int ~R# MyMaybe)
+ }
+
+-- RHS size: {terms: 37, types: 9, coercions: 5, joins: 0/0}
+bar :: MyMaybe -> MyMaybe
+[GblId,
+ Arity=1,
+ Str=<1L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [30] 161 20}]
+bar
+ = \ (ds_dFw :: MyMaybe) ->
+ case ds_dFw `cast` (T24808.N:MyMaybe[0] :: MyMaybe ~R# Maybe Int)
+ of {
+ Nothing ->
+ (GHC.Internal.Maybe.Nothing @Int)
+ `cast` (Sym (T24808.N:MyMaybe[0]) :: Maybe Int ~R# MyMaybe);
+ Just n_axK ->
+ (GHC.Internal.Maybe.Just
+ @Int
+ (case n_axK of { GHC.Types.I# x1_aFS ->
+ case x1_aFS of wild2_aFU {
+ __DEFAULT -> GHC.Types.I# (GHC.Prim.+# 10# wild2_aFU);
+ 9223372036854775798# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775799# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775800# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775801# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775802# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775803# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775804# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775805# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775806# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775807# -> GHC.Internal.Enum.$fEnumInt2
+ }
+ }))
+ `cast` (Sym (T24808.N:MyMaybe[0]) :: Maybe Int ~R# MyMaybe)
+ }
+
+-- RHS size: {terms: 37, types: 9, coercions: 5, joins: 0/0}
+T24808.foo1 :: MyMaybe -> MyMaybe
+[GblId,
+ Arity=1,
+ Str=<1L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [30] 161 20}]
+T24808.foo1
+ = \ (ds_dFw :: MyMaybe) ->
+ case ds_dFw `cast` (T24808.N:MyMaybe[0] :: MyMaybe ~R# Maybe Int)
+ of {
+ Nothing ->
+ (GHC.Internal.Maybe.Nothing @Int)
+ `cast` (Sym (T24808.N:MyMaybe[0]) :: Maybe Int ~R# MyMaybe);
+ Just n_axK ->
+ (GHC.Internal.Maybe.Just
+ @Int
+ (case n_axK of { GHC.Types.I# x1_aFS ->
+ case x1_aFS of wild2_aFU {
+ __DEFAULT -> GHC.Types.I# (GHC.Prim.+# 10# wild2_aFU);
+ 9223372036854775798# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775799# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775800# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775801# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775802# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775803# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775804# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775805# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775806# -> GHC.Internal.Enum.$fEnumInt2;
+ 9223372036854775807# -> GHC.Internal.Enum.$fEnumInt2
+ }
+ }))
+ `cast` (Sym (T24808.N:MyMaybe[0]) :: Maybe Int ~R# MyMaybe)
+ }
+
+-- RHS size: {terms: 1, types: 0, coercions: 4, joins: 0/0}
+foo :: MyMaybe -> Maybe Int
+[GblId,
+ Arity=1,
+ Str=<1L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
+foo
+ = T24808.foo1
+ `cast` (<MyMaybe>_R %<Many>_N ->_R T24808.N:MyMaybe[0]
+ :: (MyMaybe -> MyMaybe) ~R# (MyMaybe -> Maybe Int))
+
+
+
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index a5704f7ef20e..de489736db8c 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -521,3 +521,4 @@ test('T24551', normal, compile, ['-O -dcore-lint'])
test('T24726', normal, compile, ['-dcore-lint -dsuppress-uniques'])
test('T24768', normal, compile, ['-O'])
test('T24770', [ grep_errmsg(r'Dead') ], compile, ['-O'])
+test('T24808', [ grep_errmsg(r'myFunction') ], compile, ['-O -ddump-simpl'])
--
GitLab