Strictness analyser is to conservative about passing a boxed parameter
Given the following two modules:
Fold.hs
:
module Fold (Tree, fold') where
data Tree a = Leaf | Node a !(Tree a) !(Tree a)
-- Strict, pre-order fold.
fold' :: (a -> b -> a) -> a -> Tree b -> a
fold' f = go
where
go z Leaf = z
go z (Node a l r) = let z' = go z l
z'' = f z' a
in z' `seq` z'' `seq` go z'' r
{-# INLINE fold' #-}
FoldTest.hs
:
module FoldTest (sumTree) where
import Fold
sumTree :: Tree Int -> Int
sumTree = fold' (+) 0
I'd expect that the accumulator z
used in go
to be an unboxed
Int#
. However, it's boxed:
sumTree1 :: Int
sumTree1 = I# 0
sumTree_go :: Int -> Fold.Tree Int -> Int
sumTree_go =
\ (z :: Int) (ds_ddX :: Fold.Tree Int) ->
case ds_ddX of _ {
Fold.Leaf -> z;
Fold.Node a l r ->
case sumTree_go z l of _ { I# z' ->
case a of _ { I# a# ->
sumTree_go (I# (+# z' a#)) r
}
}
}
sumTree :: Fold.Tree Int -> Int
sumTree =
\ (eta1_B1 :: Fold.Tree Int) ->
sumTree_go sumTree1 eta1_B1
Given this definition of fold'
fold' :: (a -> b -> a) -> a -> Tree b -> a
fold' f = go
where
go z _ | z `seq` False = undefined
go z Leaf = z
go z (Node a l r) = go (f (go z l) a) r
{-# INLINE fold' #-}
I get the core I want. However, this version isn't explicit in that
the left branch (i.e. go z l
) should be evaluated before f
is
called on the result. In other words, I think my first definition is
the one that correctly expresses the evaluation order, yet it results
in worse core.
Trac metadata
Trac field | Value |
---|---|
Version | 6.12.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |