[GHC] #9038: Foreign calls don't make their arguments look strict

[GHC]

#9038: Foreign calls don't make their arguments look strict
-------------------------------------+------------------------------------
        Reporter:  tibbe             |            Owner:
            Type:  bug               |           Status:  new
        Priority:  normal            |        Milestone:
       Component:  Compiler          |          Version:  7.8.2
      Resolution:                    |         Keywords:
Operating System:  Unknown/Multiple  |     Architecture:  Unknown/Multiple
 Type of failure:  None/Unknown      |       Difficulty:  Unknown
       Test Case:                    |       Blocked By:
        Blocking:                    |  Related Tickets:  1592
-------------------------------------+------------------------------------

Comment (by simonpj):

 Are you sure?  I get this:
 {{{
 simonpj at cam-05-unx:~/tmp$ ghc -c -O -ddump-simpl T9038.hs

 ==================== Tidy Core ====================
 Result size of Tidy Core = {terms: 20, types: 28, coercions: 5}

 T9038.f1
   :: GHC.Types.Int
      -> GHC.Prim.State# GHC.Prim.RealWorld
      -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
  Str=DmdType <S(S),1*U(U)><S,U>,
  Unf=Unf{Src=InlineStable, TopLvl=True, Arity=2, Value=True,
          ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False)
          Tmpl= \ (val_arX [Occ=Once!] :: GHC.Types.Int)
                  (eta_B1 [Occ=Once] :: GHC.Prim.State# GHC.Prim.RealWorld)
 ->
                  case val_arX of _ [Occ=Dead] { GHC.Types.I# ipv_sKN
 [Occ=Once] ->
                  case {__pkg_ccall main function1 GHC.Prim.State#
 GHC.Prim.RealWorld
                             -> (# GHC.Prim.State# GHC.Prim.RealWorld
 #)}_dKB
                         eta_B1
                  of _ [Occ=Dead] { (# ds_dKz [Occ=Once] #) ->
                  case {__pkg_ccall main function2 GHC.Prim.Int#
                             -> GHC.Prim.State# GHC.Prim.RealWorld
                             -> (# GHC.Prim.State# GHC.Prim.RealWorld
 #)}_dKx
                         ipv_sKN ds_dKz
                  of _ [Occ=Dead] { (# ds1_dKv [Occ=Once] #) ->
                  (# ds1_dKv, GHC.Tuple.() #)
                  }
                  }
                  }}]
 T9038.f1 =
   \ (val_arX :: GHC.Types.Int)
     (eta_B1 :: GHC.Prim.State# GHC.Prim.RealWorld) ->
     case val_arX of _ [Occ=Dead] { GHC.Types.I# ipv_sKN ->
     case {__pkg_ccall main function1 GHC.Prim.State# GHC.Prim.RealWorld
                             -> (# GHC.Prim.State# GHC.Prim.RealWorld
 #)}_dKB
            eta_B1
     of _ [Occ=Dead] { (# ds_dKz #) ->
     case {__pkg_ccall main function2 GHC.Prim.Int#
                             -> GHC.Prim.State# GHC.Prim.RealWorld
                             -> (# GHC.Prim.State# GHC.Prim.RealWorld
 #)}_dKx
            ipv_sKN ds_dKz
     of _ [Occ=Dead] { (# ds1_dKv #) ->
     (# ds1_dKv, GHC.Tuple.() #)
     }
     }
     }

 T9038.f :: GHC.Types.Int -> GHC.Types.IO ()
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
  Str=DmdType <S(S),1*U(U)><S,U>,
  Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=True,
          ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)
          Tmpl= T9038.f1
                `cast` (<GHC.Types.Int>_R -> Sym (GHC.Types.NTCo:IO[0]
 <()>_R)
                        :: (GHC.Types.Int
                            -> GHC.Prim.State# GHC.Prim.RealWorld
                            -> (# GHC.Prim.State# GHC.Prim.RealWorld, ()
 #))
                             ~#
                           (GHC.Types.Int -> GHC.Types.IO ()))}]
 T9038.f =
   T9038.f1
   `cast` (<GHC.Types.Int>_R -> Sym (GHC.Types.NTCo:IO[0] <()>_R)
           :: (GHC.Types.Int
               -> GHC.Prim.State# GHC.Prim.RealWorld
               -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
                ~#
              (GHC.Types.Int -> GHC.Types.IO ()))



 simonpj at cam-05-unx:~/tmp$ ghc --version
 The Glorious Glasgow Haskell Compilation System, version 7.8.2


 simonpj at cam-05-unx:~/tmp$ cat T9038.hs
 {-# LANGUAGE BangPatterns #-}
 module T9038 ( f ) where

 f :: Int -> IO ()
 f !val = do
      cFunction1
      cFunction2 val

 foreign import ccall unsafe "function1" cFunction1 :: IO ()
 foreign import ccall unsafe "function2" cFunction2 :: Int -> IO ()
 }}}
 So GHC has decided that the function is small enough to inline bodily
 (rather than do w/w). But the inlining is there all right, and the
 strictness info.  I'm puzzled about why you get different results with GHC
 7.8.2.

 Simon

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