[GHC] #10120: Unnecessary code duplication from case analysis

[GHC]

#10120: Unnecessary code duplication from case analysis
-------------------------------------+-------------------------------------
        Reporter:  bgamari           |                   Owner:
            Type:  bug               |                  Status:  new
        Priority:  normal            |               Milestone:
       Component:  Compiler          |                 Version:  7.10.1-rc2
      Resolution:                    |                Keywords:
Operating System:  Unknown/Multiple  |            Architecture:
 Type of failure:  Runtime           |  Unknown/Multiple
  performance bug                    |               Test Case:
      Blocked By:                    |                Blocking:
 Related Tickets:                    |  Differential Revisions:
-------------------------------------+-------------------------------------

Comment (by bgamari):

 nomeata,

 This is my toy example,

 {{{#!hs
 predicate c =
        c == '-' || c == '_' || c == '.' || c == '~' || c == ':'
     || c == '@' || c == '&' || c == '=' || c == '+' || c == '$'
     || c == ','

 f x | predicate x = print x
 f x = return ()
 {-# NOINLINE f #-}

 main = f 'a'
 }}}

 This was derived from https://github.com/aristidb/http-
 types/blob/4c9fc3d136b2bc18fe126adc3902dd7e7685ae62/Network/HTTP/Types/URI.hs
 (in particular `urlEncodeBuilder`'s check of `unreservedPI'`. Here GHC
 doesn't inline the bodies but it does create a unique body for each branch
 of the case,

 {{{#!hs
 case ipv1_ijS6 of wild3_X1h {
     __DEFAULT -> ...
     __word 36 -> lvl_rkUl `cast` ...;
     __word 38 -> lvl1_rkUm `cast` ...;
     __word 43 -> lvl2_rkUn `cast` ...;
     __word 44 -> lvl3_rkUo `cast` ...;
     __word 45 -> lvl4_rkUp `cast` ...;
     __word 46 -> lvl5_rkUq `cast` ...;
     __word 58 -> lvl6_rkUr `cast` ...;
     __word 61 -> lvl7_rkUs `cast` ...;
     __word 64 -> lvl8_rkUt `cast` ...;
     __word 95 -> lvl9_rkUu `cast` ...;
     __word 126 -> lvl10_rkUv `cast` ...
 }
 }}}

 Where each of the branches looks like this,

 {{{#!hs
 lvl2_rkUn
   :: forall r_ij1U.
      Data.ByteString.Builder.Internal.BuildStep r_ij1U
      -> Data.ByteString.Builder.Internal.BufferRange
      -> GHC.Prim.State# GHC.Prim.RealWorld
      -> (# GHC.Prim.State# GHC.Prim.RealWorld,
            Data.ByteString.Builder.Internal.BuildSignal r_ij1U #)
 lvl2_rkUn =
   \ (@ r_ij1U)
     (eta_ij1V :: Data.ByteString.Builder.Internal.BuildStep r_ij1U)
     (eta1_ij1W :: Data.ByteString.Builder.Internal.BufferRange)
     (eta2_ij1X :: GHC.Prim.State# GHC.Prim.RealWorld) ->
     case eta1_ij1W
     of _
     { Data.ByteString.Builder.Internal.BufferRange dt_ij27 dt1_ij28 ->
     case GHC.Prim.tagToEnum#
            (GHC.Prim.<# (GHC.Prim.minusAddr# dt1_ij28 dt_ij27) 1)
     of _ {
       False ->
         case GHC.Prim.writeWord8OffAddr# dt_ij27 0 (__word 43) eta2_ij1X
         of s2_ij40 { __DEFAULT ->
         ((eta_ij1V
             (Data.ByteString.Builder.Internal.BufferRange
                (GHC.Prim.plusAddr# dt_ij27 1) dt1_ij28))
          `cast` ...)
           s2_ij40
         };
       True ->
         (# eta2_ij1X,
            Data.ByteString.Builder.Internal.BufferFull
              1
              dt_ij27
              ((\ (ds_ij2P :: Data.ByteString.Builder.Internal.BufferRange)
                  (eta3_ij2Q :: GHC.Prim.State# GHC.Prim.RealWorld) ->
                  case ds_ij2P
                  of _
                  { Data.ByteString.Builder.Internal.BufferRange dt3_ij2T
 dt4_ij2U ->
                  case GHC.Prim.writeWord8OffAddr# dt3_ij2T 0 (__word 43)
 eta3_ij2Q
                  of s2_ij40 { __DEFAULT ->
                  ((eta_ij1V
                      (Data.ByteString.Builder.Internal.BufferRange
                         (GHC.Prim.plusAddr# dt3_ij2T 1) dt4_ij2U))
                   `cast` ...)
                    s2_ij40
                  }
                  })
               `cast` ...) #)
     }
     }
 }}}

 differing only in the `(__word 43)` terms.

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