[GHC] #7088: Float-in bug

[GHC]

#7088: Float-in bug
---------------------------------+------------------------------------------
    Reporter:  simonpj           |       Owner:                  
        Type:  bug               |      Status:  new             
    Priority:  normal            |   Milestone:                  
   Component:  Compiler          |     Version:  7.4.2           
    Keywords:                    |          Os:  Unknown/Multiple
Architecture:  Unknown/Multiple  |     Failure:  None/Unknown    
  Difficulty:  Unknown           |    Testcase:                  
   Blockedby:                    |    Blocking:                  
     Related:                    |  
---------------------------------+------------------------------------------
 Consider
 {{{
   let   m = e
        foo = \(s:State) (x:Int). body
   in ...(foo s x)...
 }}}
 Then `loatIn.noFloatIntoRhs` will say `False`, because the top-level
 lambda is oneshot
 But the attempt to float into the lambda-group will fail, leaving
 {{{
   foo = let m = e in \s x. body
 }}}
 That changes foo’s arity, which is bad.

 Moreover, m might have been marked “demanded” in the original program, by
 the clever strictness analyser.  Then the Simplifier will not float the
 m-binding back out of ‘foo’, because it thinks that might make it lazier.

 So then the Simplifier leaves the m-binding in foo’s RHS, and then eta-
 expands it, giving
 {{{
    foo = \s. let m = e in \x. body
 }}}
 which is very bad:
 {{{
 *** Core Lint errors : in result of Simplifier ***
 {-# LINE 11 "Float.hs #-}: Warning:
     [RHS of f_snv :: GHC.Prim.State# GHC.Prim.RealWorld
                      -> GHC.Types.Int
                      -> (# GHC.Types.Int, GHC.Prim.State#
 GHC.Prim.RealWorld #)]
     Demand type has  2  arguments, rhs has  1 arguments,  f_snv
     Binder's strictness signature: DmdType LL
 *** Offending Program ***
 }}}

 It's hard to trigger this bug but Geoff managed to, and this code does it:
 {{{
 {-# LANGUAGE MagicHash, UnboxedTuples #-}

 module Float where

 import GHC.Prim

 foo vs
   = let w = if length (reverse vs) > 10 then Just (length vs) else Nothing

         f :: State# RealWorld -> Int -> (# Int, State# RealWorld #)
         f s x | Just 0 <- w = case f s (x+1) of
                         (# r, s' #) -> (# r, s' #)
               | otherwise = (# x, s #)

     in f realWorld# 1
 }}}

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