[GHC] #15226: GHC doesn't know that seq# produces something in WHNF

[GHC]

#15226: GHC doesn't know that seq# produces something in WHNF
-------------------------------------+-------------------------------------
        Reporter:  dfeuer            |                Owner:  (none)
            Type:  bug               |               Status:  merge
        Priority:  normal            |            Milestone:  8.6.1
       Component:  Compiler          |              Version:  8.4.3
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  Runtime           |            Test Case:
  performance bug                    |  perf/should_run/T15226, 15226a
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):  Phab:D4796
       Wiki Page:                    |
-------------------------------------+-------------------------------------
Changes (by simonpj):

 * testcase:   => perf/should_run/T15226, 15226a


Comment:

 I believe this is a follow-up patch
 {{{
 commit 502026fc0a35460c7f04b26a11320723a7bbfdff
 Author: David Feuer <david.feuer at gmail.com>
 Date:   Mon Jun 11 10:32:23 2018 -0400

     Make seq# evaluatedness look through casts

     In d964b05, I forgot to look through casts to find the `seq#`
     identifier. Fix that.

     Reviewers: bgamari

     Reviewed By: bgamari

     Subscribers: rwbarton, thomie, carter

     Differential Revision: https://phabricator.haskell.org/D4804


 >---------------------------------------------------------------

 502026fc0a35460c7f04b26a11320723a7bbfdff
  compiler/coreSyn/CoreSyn.hs                               | 3 ++-
  testsuite/tests/perf/should_run/{T15226.hs => T15226a.hs} | 5 ++++-
  testsuite/tests/perf/should_run/all.T                     | 9 +++++++++
  3 files changed, 15 insertions(+), 2 deletions(-)

 diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
 index 4dd70b0..50e40d1 100644
 --- a/compiler/coreSyn/CoreSyn.hs
 +++ b/compiler/coreSyn/CoreSyn.hs
 @@ -2046,10 +2046,11 @@ collectArgs expr
      go e         as = (e, as)

  -- | Attempt to remove the last N arguments of a function call.
 --- Strip off any ticks encountered along the way and any ticks
 +-- Strip off any ticks or coercions encountered along the way and any
  -- at the end.
  stripNArgs :: Word -> Expr a -> Maybe (Expr a)  stripNArgs !n (Tick _ e)
 = stripNArgs n e
 +stripNArgs n (Cast f _) = stripNArgs n f
  stripNArgs 0 e = Just e
  stripNArgs n (App f _) = stripNArgs (n - 1) f  stripNArgs _ _ = Nothing
 diff --git a/testsuite/tests/perf/should_run/T15226.hs
 b/testsuite/tests/perf/should_run/T15226a.hs
 similarity index 89%
 copy from testsuite/tests/perf/should_run/T15226.hs
 copy to testsuite/tests/perf/should_run/T15226a.hs
 index 4c09114..6e9a1db 100644
 --- a/testsuite/tests/perf/should_run/T15226.hs
 +++ b/testsuite/tests/perf/should_run/T15226a.hs
 @@ -3,6 +3,7 @@ import Control.Exception (evaluate)

  -- Just in case Prelude.repeat changes for some reason.
  import Prelude hiding (repeat)
 +import Data.Coerce

  -- We want to be sure that the compiler *doesn't* know that
  -- all the elements of the list are in WHNF, because if it @@ -12,11
 +13,13 @@ repeat a = res
    where res = a : res
  {-# NOINLINE repeat #-}  -- Belt *and* suspenders

 +newtype Foo = Foo Int
 +
  silly :: [Int] -> IO ()
  silly = foldr go (pure ())
    where
      go x r = do
 -      x' <- evaluate x
 +      x' <- (coerce (evaluate :: Foo -> IO Foo) :: Int -> IO Int) x
        evaluate (x' + 3)  -- GHC should know that x' has been evaluated,
                           -- so this calculation will be erased entirely.
                           -- Otherwise, we'll create a thunk to pass to
 diff --git a/testsuite/tests/perf/should_run/all.T
 b/testsuite/tests/perf/should_run/all.T
 index b248dd5..0e7996ef 100644
 --- a/testsuite/tests/perf/should_run/all.T
 +++ b/testsuite/tests/perf/should_run/all.T
 @@ -584,3 +584,12 @@ test('T15226',
       only_ways(['normal'])],
      compile_and_run,
      ['-O'])
 +
 +test('T15226a',
 +    [stats_num_field('bytes allocated',
 +                    [ (wordsize(64), 41040, 5) ]),
 +                    # 2018-06-06   41040  Look through casts for seq#
 +                    # initial  400041040
 +     only_ways(['normal'])],
 +    compile_and_run,
 +    ['-O'])
 }}}

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15226#comment:17>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler