[GHC] #7364: `foo !f = id . f` becomes non-strict with -O2

[GHC]

#7364: `foo !f = id . f` becomes non-strict with -O2
-----------------------------------------+----------------------------------
 Reporter:  shachaf                      |          Owner:                  
     Type:  bug                          |         Status:  new             
 Priority:  normal                       |      Component:  Compiler        
  Version:  7.6.1                        |       Keywords:                  
       Os:  Unknown/Multiple             |   Architecture:  Unknown/Multiple
  Failure:  Incorrect result at runtime  |       Testcase:                  
Blockedby:                               |       Blocking:                  
  Related:                               |  
-----------------------------------------+----------------------------------

Comment(by ezyang):

 Looks like a bug in the specializer.

 {{{
 ezyang at javelin:~/Dev/haskell$ ../ghc-build-master/inplace/bin/ghc-stage2
 strict.hs -fforce-recomp -O -ddump-spec
 [1 of 1] Compiling Main             ( strict.hs, strict.o )

 ==================== Specialise ====================
 Result size of Specialise = {terms: 19, types: 27, coercions: 10}

 a_sn2
   :: GHC.Prim.State# GHC.Prim.RealWorld
      -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
 [LclId,
  Arity=1,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
          ConLike=True, WorkFree=True, Expandable=True,
          Guidance=IF_ARGS [0] 91 60}]
 a_sn2 =
   \ (eta_B1 :: GHC.Prim.State# GHC.Prim.RealWorld) ->
     ((System.IO.print
         @ [GHC.Types.Char]
         (GHC.Show.$fShow[] @ GHC.Types.Char GHC.Show.$fShowChar)
         (GHC.Base.build
            @ GHC.Types.Char
            (\ (@ b_amP) -> GHC.CString.unpackFoldrCString# @ b_amP
 "ok"#)))
      `cast` (GHC.Types.NTCo:IO <()>
              :: GHC.Types.IO ()
                   ~#
                 (GHC.Prim.State# GHC.Prim.RealWorld
                  -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))))
       eta_B1

 Main.main :: GHC.Types.IO ()
 [LclIdX,
  Arity=1,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
          ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
 Main.main =
   a_sn2
   `cast` (Sym (GHC.Types.NTCo:IO <()>)
           :: (GHC.Prim.State# GHC.Prim.RealWorld
               -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
                ~#
              GHC.Types.IO ())

 a_sn4
   :: GHC.Prim.State# GHC.Prim.RealWorld
      -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
 [LclId,
  Arity=1,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
          ConLike=True, WorkFree=True, Expandable=True,
          Guidance=IF_ARGS [0] 21 60}]
 a_sn4 =
   \ (eta_Xb :: GHC.Prim.State# GHC.Prim.RealWorld) ->
     ((GHC.TopHandler.runMainIO @ () Main.main)
      `cast` (GHC.Types.NTCo:IO <()>
              :: GHC.Types.IO ()
                   ~#
                 (GHC.Prim.State# GHC.Prim.RealWorld
                  -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))))
       eta_Xb

 :Main.main :: GHC.Types.IO ()
 [LclIdX,
  Arity=1,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
          ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
 :Main.main =
   a_sn4
   `cast` (Sym (GHC.Types.NTCo:IO <()>)
           :: (GHC.Prim.State# GHC.Prim.RealWorld
               -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
                ~#
              GHC.Types.IO ())



 Linking strict ...

 }}}

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