[Git][ghc/ghc][master] Expand the `inline` rule to look through casts/ticks.

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed May 15 11:32:41 UTC 2024



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


Commits:
a593f284 by Andreas Klebinger at 2024-05-15T07:32:10-04: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/a593f28426ca508a72b49d0112ef934ce9f453fd

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a593f28426ca508a72b49d0112ef934ce9f453fd
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/20240515/620f38c0/attachment-0001.html>


More information about the ghc-commits mailing list