[Git][ghc/ghc][wip/andreask/inline_cast] Expand the `inline` rule to look through casts/ticks.
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Tue May 14 12:15:33 UTC 2024
Andreas Klebinger pushed to branch wip/andreask/inline_cast at Glasgow Haskell Compiler / GHC
Commits:
7377f52c by Andreas Klebinger at 2024-05-14T14:15:13+02:00
Expand the `inline` rule to look through casts/ticks.
Fixes #24808
- - - - -
4 changed files:
- compiler/GHC/Core/Opt/ConstantFold.hs
- + testsuite/tests/simplCore/should_compile/T24808.hs
- + testsuite/tests/simplCore/should_compile/T24808.stderr
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
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
=====================================
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))
=====================================
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))
+
+
+
=====================================
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'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7377f52cdc1926597beb1c0d4d88ac324566d8ab
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7377f52cdc1926597beb1c0d4d88ac324566d8ab
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/20240514/a00595c9/attachment-0001.html>
More information about the ghc-commits
mailing list