[vector] #47: Fusion broken with ghc7-rc2

[vector]

#47: Fusion broken with ghc7-rc2
---------------------+------------------------------------------------------
Reporter:  choener   |       Owner:          
    Type:  defect    |      Status:  new     
Priority:  critical  |   Milestone:          
 Version:  0.7       |    Keywords:  ghc7-rc2
---------------------+------------------------------------------------------
 Hi,

 maybe it is too late but GHCi, version 7.0.0.20101028 (ghc7 rc2) seems to
 badly break fusion.

 Consider this program:
 {{{
 module Main where

 import qualified Data.Vector.Unboxed as VU



 mk :: Int -> VU.Vector Int
 mk k = {-# CORE "VUmk" #-} VU.enumFromN 1 k
 {-# INLINE mk #-}

 join1 :: Int -> VU.Vector Int
 join1 k = {-# CORE "VUjoin" #-} VU.zipWith (\k l -> k+l) (VU.map (\k ->
 k+1) $ mk k) (VU.map (\k -> k*5) $ mk k)
 {-# INLINE join1 #-}

 join2 :: Int -> VU.Vector Int
 join2 k = {-# CORE "VUjoin2" #-} VU.map (\k -> k+1) $ mk k
 {-# INLINE join2 #-}

 main = do
   print $ {-# CORE "VUsum1" #-} VU.sum $ join1 20
   print $ {-# CORE "VUsum2" #-} VU.sum $ join2 20
   print $ {-# CORE "VUsum3" #-} VU.sum $ VU.map (\k -> k+1) $ VU.enumFromN
 (1 :: Int) 20
 }}}

 where I wanted to see if 'join1' produces good code -- if yes then I could
 split some calculations up more easily.

 What ghc 6.12.3 produces is this:
 {{{
 main_$s$wfoldlM'_loop1 =
   \ (sc_s1Oe :: Int#)
     (sc1_s1Of :: Int#)
     (sc2_s1Og :: Int#) ->
     case ># sc_s1Oe 0 of _ {
       False -> sc2_s1Og;
       True ->
         main_$s$wfoldlM'_loop1
           (-# sc_s1Oe 1)
           (+# sc1_s1Of 1)
           (+# sc2_s1Og (+# sc1_s1Of 1))
     }

 main3 :: String
 GblId

 main3 =
   case __core_note "VUsum2"
        (case main_$s$wfoldlM'_loop1 20 1 0 of ww_s1MG { __DEFAULT ->
         I# ww_s1MG
         })
   of _ { I# ww_a1Iu ->
   $wshowSignedInt 0 ww_a1Iu ([] @ Char)
   }
 }}}

 So far, so good. Now comes rc2:

 {{{
 main3 =
   case __core_note "VUsum2"
        (case (__core_note "VUmk"
               (runSTRep
                  @ (Data.Vector.Unboxed.Base.Vector Int) main4))
              `cast` (trans
                        Data.Vector.Unboxed.Base.TFCo:R:VectorInt
                        Data.Vector.Unboxed.Base.NTCo:R:VectorInt
                      :: Data.Vector.Unboxed.Base.Vector Int
                           ~
                         Data.Vector.Primitive.Vector Int)
         of _ { Data.Vector.Primitive.Vector ipv_s2oo ipv1_s2op ipv2_s2oq
 ->
         letrec {
           $s$wfoldlM'_loop_s2Bw [Occ=LoopBreaker]
             :: Int# -> Int# -> Int#

           $s$wfoldlM'_loop_s2Bw =
             \ (sc_s2yG :: Int#) (sc1_s2yH :: Int#) ->
               case >=# sc_s2yG ipv1_s2op of _ {
                 False ->
                   $s$wfoldlM'_loop_s2Bw
                     (+# sc_s2yG 1)
                     (+#
                        sc1_s2yH
                        (+#
                           (indexIntArray# ipv2_s2oq (+# ipv_s2oo sc_s2yG))
                           1));
                 True -> sc1_s2yH
               }; } in
         case $s$wfoldlM'_loop_s2Bw 0 0 of ww_s2vB { __DEFAULT ->
         I# ww_s2vB
         }
         })
   of _ { I# ww_a2r6 ->
   $wshowSignedInt 0 ww_a2r6 ([] @ Char)
   }
 }}}

 This seems rather bad ;-)

 I'd like to hear that it's my fault and I should better learn how to use
 ghc.

-- 
Ticket URL: <http://trac.haskell.org/vector/ticket/47>
vector <http://trac.haskell.org/vector>
Package vector