Simple-io-core.hs

Rec {
$wa1_r3xr
  :: Int#
     -> Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int #)
$wa1_r3xr =
  \ (ww_s3w0 :: Int#)
    (ww1_s3w4 :: Int#)
    (ww2_s3w8 :: Int#)
    (w_s3vX :: State# RealWorld) ->
    case tagToEnum# (># ww2_s3w8 0) of _ {
      False -> (# w_s3vX, I# ww_s3w0 #);
      True ->
        $wa1_r3xr
          (+# ww_s3w0 ww1_s3w4) (-# ww1_s3w4 1) (-# ww2_s3w8 1) w_s3vX
    }
end Rec }

Rec {
$wa
  :: Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int #)
$wa =
  \ (ww_s3wg :: Int#)
    (ww1_s3wk :: Int#)
    (w_s3wd :: State# RealWorld) ->
    case tagToEnum# (># ww1_s3wk 0) of _ {
      False -> (# w_s3wd, I# ww_s3wg #);
      True ->
        case $wa1_r3xr 0 ww1_s3wk 3 w_s3wd
        of _ { (# ipv_a1fM, ipv1_a1fN #) ->
        case ipv1_a1fN of _ { I# y_a1ev ->
        $wa (+# ww_s3wg y_a1ev) (-# ww1_s3wk 1) ipv_a1fM
        }
        }
    }
end Rec }

main1 :: State# RealWorld -> (# State# RealWorld, () #)
main1 =
  \ (s_a1fJ :: State# RealWorld) ->
    case $wa 0 100000000 s_a1fJ of _ { (# ipv_a1fM, ipv1_a1fN #) ->
    hPutStr2 stdout ($fShowInt_$cshow ipv1_a1fN) True ipv_a1fM
    }

main :: IO ()
main = main1 `cast` ...

main2 :: State# RealWorld -> (# State# RealWorld, () #)
main2 = runMainIO1 (main1 `cast` ...)

main :: IO ()
main = main2 `cast` ...

Simple-io.hs

{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}

module Main (main) where

main :: IO ()
main = do
  a <- l1 0 100000000
  print a

l1 :: Int -> Int -> IO Int
l1 !a !n = do
  case n>0 of
   True  -> do m <- l2 0 n 3
               l1 (a+m) (n-1)
   False -> return a

l2 :: Int -> Int -> Int -> IO Int
l2 !a !n !m = do
  case m>0 of
   True  -> l2 (a+n) (n-1) (m-1)
   False -> return a

Simple-pure-core.hs

Rec {
$wl2_r3wB :: Int# -> Int# -> Int# -> Int#
$wl2_r3wB =
  \ (ww_s3va :: Int#) (ww1_s3ve :: Int#) (ww2_s3vi :: Int#) ->
    case tagToEnum# (># ww2_s3vi 0) of _ {
      False -> ww_s3va;
      True ->
        $wl2_r3wB (+# ww_s3va ww1_s3ve) (-# ww1_s3ve 1) (-# ww2_s3vi 1)
    }
end Rec }

Rec {
$wl1 :: Int# -> Int# -> Int#
$wl1 =
  \ (ww_s3vs :: Int#) (ww1_s3vw :: Int#) ->
    case tagToEnum# (># ww1_s3vw 0) of _ {
      False -> ww_s3vs;
      True ->
	case $wl2_r3wB 0 ww1_s3vw 3 of ww2_s3vm { __DEFAULT ->
	$wl1 (+# ww_s3vs ww2_s3vm) (-# ww1_s3vw 1)
	}
    }
end Rec }

main2 :: String
main2 =
  case $wl1 0 100000000 of ww_s3vA { __DEFAULT ->
  case $wshowSignedInt 0 ww_s3vA ([])
  of _ { (# ww5_a3tM, ww6_a3tN #) ->
  : ww5_a3tM ww6_a3tN
  }
  }

main1 :: State# RealWorld -> (# State# RealWorld, () #)
main1 =
  \ (eta_a1eq :: State# RealWorld) ->
    hPutStr2 stdout main2 True eta_a1eq

main :: IO ()
main = main1 `cast` ...

main3 :: State# RealWorld -> (# State# RealWorld, () #)
main3 = runMainIO1 (main1 `cast` ...)

main :: IO ()
main = main3 `cast` ...

Simple-pure.hs

{-# LANGUAGE BangPatterns #-}

module Main (main) where

main :: IO ()
main = do
  let a = l1 0 100000000
  print a

l1 :: Int -> Int -> Int
l1 !a !n =
  case n>0 of
   True  -> let m = l2 0 n 3
            in l1 (a+m) (n-1)
   False -> a

l2 :: Int -> Int -> Int -> Int
l2 !a !n !m =
  case m>0 of
   True  -> l2 (a+n) (n-1) (m-1)
   False -> a

Notice how the l2 worker ($wl2_r3wB) in the pure version has unboxed arguments and an unboxed return value (simple-pure-core.hs:2)

$wl2_r3wB :: Int# -> Int# -> Int# -> Int#

while the l2 worker ($wa1_r3xr) in the IO version only has unboxed arguments. The return value is now a boxed Int (packaged up in an unboxed tuple with a State# Realworld token) (simple-io-core.hs:2-4).

$wa1_r3xr
  :: Int#
     -> Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int #)

Following the computation (l1 worker calls l2 worker) we see there is no way the Int should be boxed: the l2 worker is only boxing it at the return point (simple-io-core.hs:11)

$wa1_r3xr
  :: Int#
     -> Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int #)
...
      False -> (# w_s3vX, I# ww_s3w0 #);

to have it immediately unboxed by the l1 worker at the call site (simple-io-core.hs:28-30)

$wa
  :: Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int #)
...
        case $wa1_r3xr 0 ww1_s3wk 3 w_s3wd
        of _ { (# ipv_a1fM, ipv1_a1fN #) ->
        case ipv1_a1fN of _ { I# y_a1ev ->