## 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 |