[GHC] #4267: Missing unboxing in pre-order fold over binary tree

[GHC]

#4267: Missing unboxing in pre-order fold over binary tree
---------------------------------+------------------------------------------
    Reporter:  tibbe             |       Owner:              
        Type:  bug               |      Status:  new         
    Priority:  normal            |   Component:  Compiler    
     Version:  6.12.1            |    Keywords:              
    Testcase:                    |   Blockedby:              
          Os:  Unknown/Multiple  |    Blocking:              
Architecture:  Unknown/Multiple  |     Failure:  None/Unknown
---------------------------------+------------------------------------------
 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.

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/4267>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs