Opened 12 months ago

Closed 6 months ago

#9038 closed bug (worksforme)

Foreign calls don't make their arguments look strict

Reported by: tibbe Owned by:
Priority: normal Milestone:
Component: Compiler Version: 7.8.2
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: None/Unknown Test Case:
Blocked By: Blocking:
Related Tickets: 1592 Differential Revisions:

Description

Here's a function that takes a Double which is always passed to a foreign import expecting a Double#. Since the value is always unpacked, I'd expect add3 to be strict in the Double argument and thereby avoid some allocation.

add3
  :: Distribution
     -> Double
     -> Int64
     -> State# RealWorld
     -> (# State# RealWorld, () #)
add3 =
  \ (distrib_a1uw :: Distribution)
    (val_a1ux :: Double)
    (n_a1uy :: Int64)
    (eta_X22 :: State# RealWorld) ->
    case myThreadId# eta_X22 of _ { (# ipv_i229, ipv1_i22a #) ->
    case threadStatus# ipv1_i22a ipv_i229
    of _ { (# ipv2_i22e, _, ipv4_i22g, _ #) ->
    case modInt# ipv4_i22g 8 of ww1_i1NM { __DEFAULT ->
    case distrib_a1uw
         `cast` (<NTCo:Distribution> :: Distribution ~# Array Stripe)
    of _ { Array ds2_i22q ->
    case indexArray# ds2_i22q ww1_i1NM of _ { (# ipv6_i1Nz #) ->
    case ipv6_i1Nz
    of _ { Stripe ipv7_s22v ipv8_s22w ipv9_s22x ipv10_s22y ->
    case {__pkg_ccall main hs_lock Addr#
                          -> State# RealWorld -> (# State# RealWorld #)}_i20J
           ipv9_s22x ipv2_i22e
    of _ { (# ds4_i20P #) ->
    case touch# ipv10_s22y ds4_i20P of s'_i20R { __DEFAULT ->
    case val_a1ux of _ { D# ds6_d1D8 ->
    case n_a1uy of _ { I64# ds8_d1Da ->
    case {__pkg_ccall main hs_distrib_add_n Addr#
                                   -> Double# -> Int# -> State# RealWorld -> (# State# RealWorld #)}_d1Dd
           ipv7_s22v ds6_d1D8 ds8_d1Da s'_i20R
    of _ { (# ds9_d1Db #) ->
    case {__pkg_ccall main hs_unlock Addr#
                            -> State# RealWorld -> (# State# RealWorld #)}_i20m
           ipv9_s22x ds9_d1Db
    of _ { (# ds10_i20s #) ->
    case touch# ipv10_s22y ds10_i20s of s'1_i20u { __DEFAULT ->
    case touch# ipv8_s22w s'1_i20u of s'2_i1YT { __DEFAULT ->
    (# s'2_i1YT, () #)
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }

Change History (11)

comment:1 Changed 12 months ago by tibbe

#1592 looks related and I think I understanding the reasoning (the earlier hs_lock call might exit the program and hence the argument won't be used). I'm fine with this behavior but it'd be nice if I was able to tell the compiler that the function is strict. Adding bang patterns on the arguments has no effect at all.

comment:2 Changed 12 months ago by tibbe

I tried to add a call to evaluate val the very first thing in the function, which resulted in an extra seq# call in the core, but it didn't make the function strict.

Last edited 12 months ago by tibbe (previous) (diff)

comment:3 Changed 12 months ago by simonpj

Can you give the actual example (as simple as possible) so I can reproduce what you are seeing?

Just because the caller of a function always uses it in a certain way doesn't necessarily affect the code of the function itself. But I may be misunderstanding; let's just see the code.

Simon

Last edited 12 months ago by simonpj (previous) (diff)

comment:4 Changed 12 months ago by tibbe

Here's a trivially simple example:

Test.hs:

{-# LANGUAGE BangPatterns #-}
module Test ( 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 ()

Compile with:

ghc -c -O2 -ddump-simpl Test.hs

Here's the core:

f1 :: Int -> State# RealWorld -> (# State# RealWorld, () #)
f1 =
  \ (val_aeK :: Int) (eta_B1 :: State# RealWorld) ->
    case val_aeK of _ { I# ipv_sfl ->
    case {__pkg_ccall main function1 State# RealWorld
                            -> (# State# RealWorld #)}_df8
           eta_B1
    of _ { (# ds_df6 #) ->
    case {__pkg_ccall main function2 Int#
                            -> State# RealWorld -> (# State# RealWorld #)}_df4
           ipv_sfl ds_df6
    of _ { (# ds1_df2 #) ->
    (# ds1_df2, () #)
    }
    }
    }

f :: Int -> IO ()
f = f1 `cast` ...

Adding the bang pattern has one effect: the argument gets unboxed earlier. It doesn't make the function take an unboxed argument however (i.e. there's no worker-wrapper).

comment:5 Changed 12 months ago by simonpj

Are you sure? I get this:

simonpj@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@cam-05-unx:~/tmp$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.8.2


simonpj@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

comment:6 Changed 6 months ago by rwbarton

  • Status changed from new to infoneeded

tibbe's and Simon's cores look identical to me modulo suppressions and alpha-renaming. The only thing that sounds potentially wrong to me here is the behavior of tibbe's original function with evaluate val, but it's hard to tell without the actual function and Core output.

comment:7 Changed 6 months ago by tibbe

I might have been mistaken. I read the core for add3 above and assumed that since add3 isn't worker-wrappered the argument wouldn't be unboxed. I tried calling add3 (which is really the System.Metrics.Distribution.add function in the ekg-core package) function in this little test program

module Test where

import System.Metrics.Distribution

test :: Distribution -> IO ()
test distrib = add distrib 1.0

and things seem to be unboxed correctly.

Here's the demand signature for add3:

add3
  :: Distribution
     -> Double
     -> Int64
     -> State# RealWorld
     -> (# State# RealWorld, () #)
[GblId,
 Arity=4,
 Caf=NoCafRefs,
 Str=DmdType <L,1*U(U)><L,1*U(U)><L,1*U(U)><L,U>,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=4, Value=True,
         ConLike=True, WorkFree=True, Expandable=True,
         Guidance=IF_ARGS [0 20 20 0] 156 30}]

How do I read the DmdType <L,1*U(U)><L,1*U(U)><L,1*U(U)><L,U> line?

comment:8 Changed 6 months ago by simonpj

The notation is <stricness, usage>. SO <L, anything> means a lazy arg. So add3 takes its argument boxed.

What I'm missing is a (preferably small) test case in which something isn't unboxed that should be. The one you gave me in comment:4 appears to be fine. Do you have in mind another one that isn't?

I suppose I could install ekg etc, if that is necessary.

Simon

comment:9 Changed 6 months ago by tibbe

I assume that <L, 1*U(U)> is still unboxed, as even though it's marked as "lazy" it's an unboxed type. If so, I don't think there's an issue.

comment:10 Changed 6 months ago by simonpj

Oh yes, arguments of unboxed type are, well, unboxed.

Simon

comment:11 Changed 6 months ago by tibbe

  • Resolution set to worksforme
  • Status changed from infoneeded to closed
Note: See TracTickets for help on using tickets.