[GHC] #13692: Constructors and such should be able to move around seq# sometimes

[GHC]

#13692: Constructors and such should be able to move around seq# sometimes
-------------------------------------+-------------------------------------
           Reporter:  dfeuer         |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:  8.4.1
          Component:  Compiler       |           Version:  8.2.1-rc2
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  Runtime
  Unknown/Multiple                   |  performance bug
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 This code

 {{{#!hs
 module SeqCon where

 import Control.Exception (evaluate)

 blah :: Int -> IO Int
 blah x = (+2) <$> evaluate (x + 3)
 }}}

 compiled with `-O2 -ddump-prep -dsuppress-coercions` produces the
 following (and `-ddump-stg` doesn't change much of note):

 {{{
 SeqCon.blah1
   :: GHC.Types.Int
      -> GHC.Prim.State# GHC.Prim.RealWorld
      -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Types.Int #)
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
  Str=<L,1*U(U)><S,U>,
  Unf=OtherCon []]
 SeqCon.blah1
   = \ (x_s1cz [Occ=Once!] :: GHC.Types.Int)
       (s_s1cA [Occ=Once] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
       let {
         sat_s1cE [Occ=Once] :: GHC.Types.Int
         [LclId]
         sat_s1cE
           = case x_s1cz of { GHC.Types.I# x1_s1cC [Occ=Once] ->
             case GHC.Prim.+# x1_s1cC 3# of sat_s1cD { __DEFAULT ->
             GHC.Types.I# sat_s1cD
             }
             } } in
       case GHC.Prim.seq#
              @ GHC.Types.Int @ GHC.Prim.RealWorld sat_s1cE s_s1cA
       of
       { (# ipv_s1cG [Occ=Once], ipv1_s1cH [Occ=Once!] #) ->
       let {
         sat_s1cL [Occ=Once] :: GHC.Types.Int
         [LclId]
         sat_s1cL
           = case ipv1_s1cH of { GHC.Types.I# x1_s1cJ [Occ=Once] ->
             case GHC.Prim.+# x1_s1cJ 2# of sat_s1cK { __DEFAULT ->
             GHC.Types.I# sat_s1cK
             }
             } } in
       (# ipv_s1cG, sat_s1cL #)
       }

 -- RHS size: {terms: 5, types: 3, coercions: 5, joins: 0/0}
 SeqCon.blah :: GHC.Types.Int -> GHC.Types.IO GHC.Types.Int
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
  Str=<L,1*U(U)><S,U>,
  Unf=OtherCon []]
 SeqCon.blah
   = (\ (eta_B2 [Occ=Once] :: GHC.Types.Int)
        (eta_B1 [Occ=Once] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
        SeqCon.blah1 eta_B2 eta_B1)
     `cast` <Co:5>
 }}}

 This builds a closure to build an `Int` and passes it to `seq#`. That
 seems a bit wasteful, since we don't actually need the `Int` box. I think
 what we'd really like to end up with is something like

 {{{#!hs
 blah1 = \ (x :: Int) (s :: State# RealWorld) ->
   case seq# x s of { (# s', x' #) ->
   case x' of { I# x# -> (# s', I# (x# +# 5#) #) }}
 }}}

 Here's one vague idea: when we analyse `x+3` (the argument to `seq#`)
 under a strict demand, we see it is strict in `x`. So we can transform
 `seq# (x + 3) s` into

 {{{#!hs
 case seq# x s of
   (# s', x' #) -> seq# (x' + 3) s'
 }}}

 We know that `x'` is in WHNF, so we should (I think) be able to see that
 `x' + 3` isn't bottom, so we can use

 {{{#!hs
 case seq# x s of {(# s', x' #) ->
 case x' + 3 of {!res -> s', res}}
 }}}

 Side note: the redundant eta-expansion in `blah` is a bit surprising.
 `blah1` already has arity 2, so I'd have expected `blah` to just coerce it
 directly.

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