[Git][ghc/ghc][wip/nested-cpr-2019] 2 commits: Fix T9291

[Sebastian Graf]

Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC


Commits:
d0b49961 by Sebastian Graf at 2020-05-11T21:51:42+02:00
Fix T9291

- - - - -
5397fe39 by Sebastian Graf at 2020-05-14T16:39:22+02:00
Document -fcase-binder-cpr-depth in the user's guide

- - - - -


3 changed files:

- compiler/GHC/Driver/Session.hs
- docs/users_guide/using-optimisation.rst
- testsuite/tests/simplStg/should_run/T9291.hs


Changes:

=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3523,7 +3523,6 @@ fFlagsDeps = [
   flagSpec "stg-cse"                          Opt_StgCSE,
   flagSpec "stg-lift-lams"                    Opt_StgLiftLams,
   flagSpec "cpr-anal"                         Opt_CprAnal,
-  flagSpec "case-binder-cpr"                  Opt_CaseBinderCpr,
   flagSpec "defer-diagnostics"                Opt_DeferDiagnostics,
   flagSpec "defer-type-errors"                Opt_DeferTypeErrors,
   flagSpec "defer-typed-holes"                Opt_DeferTypedHoles,


=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -293,6 +293,41 @@ by saying ``-fno-wombat``.
 
     Turn on CPR analysis in the demand analyser.
 
+.. ghc-flag:: -fcase-binder-cpr-depth
+    :shortdesc: Maximum depth at which case binders have the CPR property.
+    :type: dynamic
+    :category:
+
+    :default: 1
+
+    Normally, case binders get the CPR property if their scrutinee had it.
+    But depending on whether the case binder occurs on a cold path, it may make sense
+    to give it the CPR property unconditionally.
+
+    This flag controls how deep inside a constructor application we still
+    consider CPR binders to have th CPR property. The default is 1, so the
+    following function will have the CPR property: ::
+
+      f :: Bool -> Int -> Int
+      f False _   = 1
+      f _     x at 2 = x
+      f _     _   = 3
+
+    Note that ``x`` did not occur nested inside a constructor, so depth 1.
+
+    On the other hand, the following function will *not* have the Nested CPR
+    property: ::
+
+      g :: Bool -> Int -> (Int, Int)
+      g False _   = (1, 1)
+      g _     x at 2 = (x, x)
+      g _     _   = (3, 3)
+
+    Because ``x`` occurs nested inside a pair, so at depth 2.
+
+    Depth 0 will never give any CPR binder the CPR property, unless the
+    scrutinee had it to begin with.
+
 .. ghc-flag:: -fcse
     :shortdesc: Enable common sub-expression elimination. Implied by :ghc-flag:`-O`.
     :type: dynamic


=====================================
testsuite/tests/simplStg/should_run/T9291.hs
=====================================
@@ -2,17 +2,19 @@
 import GHC.Exts
 import Unsafe.Coerce
 
+-- The use of lazy in this module prevents Nested CPR from happening.
+-- Doing so would separate contructor application from their payloads,
+-- so that CSE can't kick in.
+-- This is unfortunate, but this testcase is about demonstrating
+-- effectiveness of STG CSE.
+
 foo :: Either Int a -> Either Bool a
 foo (Right x) = Right x
 foo _ = Left True
 {-# NOINLINE foo #-}
 
 bar :: a -> (Either Int a, Either Bool a)
--- lazy prevents Nested CPR from returning just (# x, x #) here.
--- Doing so would lead to reboxing at the call site, where CSE
--- isn't able to see that both tuple components are equivalent.
--- This is unfortunate, but this testcase is about demonstrating
--- effectiveness of STG CSE.
+-- Why lazy? See comment above; the worker would return (# x, x #)
 bar x = (lazy $ Right x, lazy $ Right x)
 {-# NOINLINE bar #-}
 
@@ -25,11 +27,12 @@ nested _ = Left True
 -- CSE in a recursive group
 data Tree x = T x (Either Int (Tree x)) (Either Bool (Tree x))
 rec1 :: x -> Tree x
+-- Why lazy? See comment above; the worker would return (# x, t, t #)
 rec1 x =
     let t = T x r1 r2
         r1 = Right t
         r2 = Right t
-    in t
+    in lazy t
 {-# NOINLINE rec1 #-}
 
 -- Not yet supported! (and tricky)
@@ -42,17 +45,8 @@ rec2 x =
 {-# NOINLINE rec2 #-}
 
 test x = do
-    let (r1,r2) = bar x
-    (same $! r1) $! r2
-    let r3 = foo r1
-    (same $! r1) $! r3
-    let (r4,_) = bar r1
-    let r5 = nested r4
-    (same $! r4) $! r5
     let (T _ r6 r7) = rec1 x
     (same $! r6) $! r7
-    let s1@(S _ s2) = rec2 x
-    (same $! s1) $! s2
 {-# NOINLINE test #-}
 
 main = test "foo"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f0d83bab1f471fb9f0b8ff8cd1aa75ec6c6a4a20...5397fe394009f07b0c42977af1bc1030c2592b8a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f0d83bab1f471fb9f0b8ff8cd1aa75ec6c6a4a20...5397fe394009f07b0c42977af1bc1030c2592b8a
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/20200514/bd09a1e5/attachment-0001.html>