[GHC] #12915: cmmImplementSwitchPlans creates duplicate blocks

[GHC]

#12915: cmmImplementSwitchPlans creates duplicate blocks
-------------------------------------+-------------------------------------
        Reporter:  alexbiehl         |                Owner:
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.0.1
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by alexbiehl):

 Ah, it is not `cmmImplementSwitchPlans` directly! After `cmmSwitchPlans`
 it is still

 {{{
   cfzc:
       _sfh3::P64 = R1;
       _cfB7::I64 = %MO_UU_Conv_W32_W64(I32[I64[_sfh3::P64 - 1] - 4]);
       if (_cfB7::I64 < 5) goto ufBe; else goto ufBg;
   ufBe:
       if (_cfB7::I64 < 4) goto ufBf; else goto cfAV;
   ufBf:
       if (_cfB7::I64 != 2) goto cfAC; else goto cfAR;
   cfAR:
       _sfh4::I64 = I64[_sfh3::P64 + 7];
       _sfgp::I64 = 1;
       goto sfgo;
   cfAV:
       _sfh5::I64 = I64[_sfh3::P64 + 7];
       _sfgp::I64 = 1;
       goto sfgo;
   ufBg:
       if (_cfB7::I64 != 6) goto cfAC; else goto cfAZ;
   cfAZ:
       _sfh6::I64 = I64[_sfh3::P64 + 7];
       _sfgp::I64 = 1;
       goto sfgo;
   sfgo:
 }}}

 `_sfh4`, `_sfh5`, `_sfh6` are dead. The sinking pass eliminates those and
 we end up with duplicate blocks! This code is part of an inner loop which
 just counts the occurrence of certain constructors. Here is the core for
 the mentioned loop:

 {{{#!hs
     letrec {
       $sloop
         :: State# RealWorld
            -> Int# -> (# State# RealWorld, Either Error Int #)
       $sloop =
         \ (sc :: State# RealWorld) (sc1 :: Int#) ->
           case (ww `cast` ...) sc of _ { (# ipv, ipv1 #) ->
           case ipv1 of _ {
             Nothing -> (# ipv, Right (I# sc1) #);
             Just a ->
               case length $fVectorVectora a of _ { I# y ->
               case y of _ {
                 __DEFAULT -> (# ipv, empResult2 #);
                 4# ->
                   case a of _ { Vector dt dt1 dt2 ->
                   let {
                     $wsucc_
                       :: Int#
                          -> State# RealWorld -> (# State# RealWorld,
 Either Error Int #)
                     $wsucc_ =
                       \ (ww1 :: Int#) (w1 :: State# RealWorld) ->
                         let {
                           $wsucc_1
                             :: Int#
                                -> State# RealWorld -> (# State# RealWorld,
 Either Error Int #)
                           $wsucc_1 =
                             \ (ww2 :: Int#) (w2 :: State# RealWorld) ->
                               case indexArray# dt2 (+# dt ww2) of _ { (#
 ipv2 #) ->
                               case ipv2 of _ {
                                 __DEFAULT -> (# w2, empResult2 #);
                                 CV_Int8 dt4 ->
                                   case indexArray# dt2 (+# dt (+# ww2 1#))
 of _ { (# ipv3 #) ->
                                   case ipv3 of _ {
                                     __DEFAULT -> (# w2, empResult2 #);
                                     CV_Text t -> $sloop w2 (+# sc1 1#)
                                   }
                                   };
                                 CV_Int16 dt4 ->
                                   case indexArray# dt2 (+# dt (+# ww2 1#))
 of _ { (# ipv3 #) ->
                                   case ipv3 of _ {
                                     __DEFAULT -> (# w2, empResult2 #);
                                     CV_Text t -> $sloop w2 (+# sc1 1#)
                                   }
                                   };
                                 CV_Int32 dt4 ->
                                   case indexArray# dt2 (+# dt (+# ww2 1#))
 of _ { (# ipv3 #) ->
                                   case ipv3 of _ {
                                     __DEFAULT -> (# w2, empResult2 #);
                                     CV_Text t -> $sloop w2 (+# sc1 1#)
                                   }
                                   }
                               }
                               } } in
                         case indexArray# dt2 (+# dt ww1) of _ { (# ipv2 #)
 ->
                         case ipv2 of _ {
                           __DEFAULT -> (# w1, empResult2 #);
                           CV_Int8 dt4 -> $wsucc_1 (+# ww1 1#) w1;
                           CV_Int16 dt4 -> $wsucc_1 (+# ww1 1#) w1;
                           CV_Int32 dt4 -> $wsucc_1 (+# ww1 1#) w1
                         }
                         } } in
                   case indexArray# dt2 dt of _ { (# ipv2 #) ->
                   case ipv2 of _ {
                     __DEFAULT -> (# ipv, empResult2 #);
                     CV_Int8 dt4 -> $wsucc_ 1# ipv;
                     CV_Int16 dt4 -> $wsucc_ 1# ipv;
                     CV_Int32 dt4 -> $wsucc_ 1# ipv
                   }
                   }
                   }
               }
               }
 }}}

 You can see a minimized example of the original code here:
 https://gist.github.com/alexbiehl/0a1b5016223e00ae79a1399176e14eef

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