[GHC] #11707: Don't desugar large lists with build

[GHC]

#11707: Don't desugar large lists with build
-------------------------------------+-------------------------------------
        Reporter:  bgamari           |                Owner:
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  7.10.3
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  Runtime           |  Unknown/Multiple
  performance bug                    |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by bgamari):

 It turns out that getting fusion to fire as it does in `T9961` is actually
 quite tricky. For instance, while `listArray` fuses (producing a large
 string of `writeArray#`s) in this case,

 {{{#!hs
 arr = listArray (0,10) [ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1 ]
 }}}

 It does not in this case,
 {{{#!hs
 arr = listArray (0,10) [ 1,1,1,1,1,1,1,1,1,1 ]
 }}}

 I then realized that only the prefix of negated elements will be unrolled.
 For instance,
 {{{#!hs
 arr = listArray (0,10) [ -1,-1,-1,1,1,1,1,1,1,1 ]
 }}}
 will fuse the first three elements into the construction loop, which will
 look something like this,
 {{{#!hs
 case newArray# ww3_aZu (arrEleBottom) s1#_aXo
 of _ { (# ipv_aXz, ipv1_aXA #) ->
 case ww3_aZu of wild3_aXC {
   __DEFAULT ->
     case writeArray# ipv1_aXA 0 arr11 ipv_aXz of s4#_aXH { __DEFAULT ->
     case -# wild3_aXC 1 of wild_XZ {
       __DEFAULT ->
         case writeArray# ipv1_aXA 1 arr11 s4#_aXH
         of s4#1_XYH { __DEFAULT ->
         case wild_XZ of wild1_X14 {
           __DEFAULT ->
             letrec {
               go_aYj :: [Integer] -> GHC.Prim.Int# -> GHC.Prim.State# s ->
 GHC.Prim.State# s
               go_aYj = \ ds_aYk eta_B2 eta1_B1 ->
                   case ds_aYk of _ {
                     [] -> eta1_B1;
                     : y_aYp ys_aYq ->
                       case writeArray# ipv1_aXA eta_B2 y_aYp eta1_B1
                       of s4#2_XYg { __DEFAULT ->
                       case tagToEnum# (==# eta_B2 wild1_X14) of _ {
                         False -> go_aYj ys_aYq (+# eta_B2 1) s4#2_XYg;
                         True -> s4#2_XYg
                       }
                       }
                   }; } in {- ... -}
 }}}
 where `arr11 = __integer -1`.

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11707#comment:2>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler