GitLab

I was investigating some poor performance in Data.Binary.Builder from the binary package. I boiled it down to GHC not turning a loop, expressed in CPS, into tail recursive function.

Here's the test code:

-- Simplification of a problem spotted in Data.Binary.Builder
module Repro (test) where

-- A builder that carries around one 'Int' worth of state.
newtype Builder = Builder { runBuilder ::  (Int -> Int) -> Int -> Int }

empty = Builder id
append (Builder f) (Builder g) = Builder (f . g)
add i = Builder $ \ k n -> k (n + i)
run b = runBuilder b id 0    

loop :: [Int] -> Builder
loop [] = empty
loop (x:xs) = add 1 `append` loop xs
    
test :: Int
test = run (loop [1..100])

Here's the (cleaned up) core:

test4 :: [Int] -> (Int -> Int) -> Int -> Int
test4 =
  \ (ys :: [Int])
    (k :: Int -> Int) ->
    case ys of _ {
      [] -> k;
      : x xs ->
        let {
          k2 :: Int -> Int
          k2 = test4 xs k } in
        \ (n_abz :: Int) ->
          k2
            (case n_abz of _ { I# x# ->
             I# (+# x# 1)
             })
    }

test3 :: [Int]
test3 = eftInt 1 100

test2 :: Int -> Int
test2 = test4 test3 (id @ Int)

test1 :: Int
test1 = I# 0

test :: Int
test = test2 test1

Note how test4 allocates a continuation it uses to call itself. Perhaps it could instead SAT the original continuation.

Trac metadata

Trac field	Value
Version	7.0.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture