Skip to content

Stupid exitification point left at the end

Consider this program (from #21948 (closed)); NB the -fno-full-laziness.

{-# OPTIONS_GHC -fno-full-laziness #-}
module Exit where

import GHC.Int( Int64 )

nf' :: (b -> ()) -> (a -> b) -> a -> (Int64 -> IO ())
nf' reduce f x = go
  where
    go n | n <= 0    = return ()
         | otherwise = let !y = f x
                       in reduce y `seq` go (n-1)
{-# NOINLINE nf' #-}

Compiling with HEAD (roughly 9.6) and -O2 I get this just before the exitification transformation:

$wnf'_s11d
  = \ (@b_s10X)
      (@a_s10Y)
      (reduce_s10Z [Dmd=LCS(A)] :: b_s10X -> ())
      (f_s110 [Dmd=LCS(L)] :: a_s10Y -> b_s10X)
      (x_s111 :: a_s10Y)
      (ww_s114 :: GHC.Prim.Int64#)
      (eta_s116 [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
      join {
        $j_s11f
          :: (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
             %1 -> GHC.Prim.State# GHC.Prim.RealWorld
        [LclId[JoinId(1)(Nothing)], Arity=1]
        $j_s11f (ww_s117 [OS=OneShot]
                   :: (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
          = case ww_s117 of { (# ww_s119, ww_s11a #) ->
            case ww_s11a of { () -> ww_s119 }
            } } in
      joinrec {
        $wgo_s10V [InlPrag=[2], Occ=LoopBreaker]
          :: GHC.Prim.Int64#
             -> GHC.Prim.State# GHC.Prim.RealWorld
             -> GHC.Prim.State# GHC.Prim.RealWorld
        [LclId[JoinId(2)(Just [])],
         Arity=2,
         Str=<L><L>,
         Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
                 WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 90 0}]
        $wgo_s10V (ww_s10R :: GHC.Prim.Int64#)
                  (eta_s10T [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld)
          = case GHC.Prim.leInt64# ww_s10R 0#64 of {
              __DEFAULT ->
                case f_s110 x_s111 of y_aNT { __DEFAULT ->
                case reduce_s10Z y_aNT of { () ->
                jump $wgo_s10V (GHC.Prim.subInt64# ww_s10R 1#64) eta_s10T
                }
                };
              1# -> jump $j_s11f (# eta_s10T, GHC.Tuple.() #)
            }; } in
      jump $wgo_s10V ww_s114 eta_s116

Why isn't that $j_s11f inlined? It woud be a great idea to do so! Answer: because it looks like an exit point: see Note [Do not inline exit join points] in GHC.Core.Opt.Exitify.

Then exitification creates a new exit point for the call

               jump $j_s11f (# eta_s10T, GHC.Tuple.() #)

and now $j_s11f can inline. So we end up with this:

T21948.$wnf'
  = \ (@b_s10X)
      (@a_s10Y)
      (reduce_s10Z :: b_s10X -> ())
      (f_s110 :: a_s10Y -> b_s10X)
      (x_s111 :: a_s10Y)
      (ww_s114 :: GHC.Prim.Int64#)
      (eta_s116 [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
      join {
        exit_X0 [Dmd=SCS(L)]
          :: GHC.Prim.State# GHC.Prim.RealWorld
             -> GHC.Prim.State# GHC.Prim.RealWorld
        [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>]
        exit_X0 (eta1_s10T [OS=OneShot]
                   :: GHC.Prim.State# GHC.Prim.RealWorld)
          = eta1_s10T } in
      joinrec {
        $wgo_s10V [InlPrag=[2], Occ=LoopBreaker, Dmd=SCS(C1(L))]
          :: GHC.Prim.Int64#
             -> GHC.Prim.State# GHC.Prim.RealWorld
             -> GHC.Prim.State# GHC.Prim.RealWorld
        [LclId[JoinId(2)(Nothing)], Arity=2, Str=<L><1L>, Unf=OtherCon []]
        $wgo_s10V (ww1_s10R :: GHC.Prim.Int64#)
                  (eta1_s10T [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld)
          = case GHC.Prim.leInt64# ww1_s10R 0#64 of {
              __DEFAULT ->
                case f_s110 x_s111 of y_aNT { __DEFAULT ->
                case reduce_s10Z y_aNT of { () ->
                jump $wgo_s10V (GHC.Prim.subInt64# ww1_s10R 1#64) eta1_s10T
                }
                };
              1# -> jump exit_X0 eta1_s10T
            }; } in
      jump $wgo_s10V ww_s114 eta_s116

That exit_X0 join point is pretty stupid. It doesn't even mention any free variables that might get inlined!

So

  • It's a bit silly not to inline $j_s11f in the first place.
  • It's a bit silly not to eventually inline exit_X0.
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information