Strict bindings are wrongly floated out of case alternatives.

With this program:

{-# LANGUAGE MagicHash, BangPatterns #-}
module Broken where
import qualified Data.Vector            as V
import qualified Data.Vector.Unboxed    as U

broken :: V.Vector (U.Vector Double) -> Int -> Int -> IO Double
broken !arrs !ix !len
 = case ix >= len of
         True   -> error "sorry"
         False  -> return ((arrs `V.unsafeIndex` ix) `U.unsafeIndex` ix)

Note that both indexing operations are within the 'False' branch, and the test is intended to check that the indexing is indeed safe.

Sadly, the simplifier floats the inner indexing operation outside the bounds check:

broken1
broken1 =
  \ arrs_s185 ix_s18a len_s18j eta_s18o ->
    let { Vector ipv_s18e _ ipv2_s18d ~ _ <- arrs_s185 } in
    let { I# ipv3_s18f ~ _     <- ix_s18a } in
    let { __DEFAULT ~ sat_s18D <- +# ipv_s18e ipv3_s18f } in
    let { (# x_s18p #) ~ _     <- indexArray# ipv2_s18d sat_s18D } in     *** NO! ***
    let { I# ipv4_s18m ~ _     <- len_s18j } in
    case >=# ipv3_s18f ipv4_s18m of _ {
      False ->
        let {
          sat_s18G
          sat_s18G =
            let { Vector rb_s18v _ rb2_s18u ~ _ <- x_s18p `cast` ... } in
            let { __DEFAULT ~ sat_s18J <- +# rb_s18v ipv3_s18f } in
            let { __DEFAULT ~ sat_s18K
            <- indexDoubleArray# rb2_s18u sat_s18J
            } in
            D# sat_s18K } in
        (# eta_s18o, sat_s18G #);
      True -> broken2 `cast` ...
    }

If it was a lazy binding it would have been ok to float it, but it's not. This issue is probably causing other problems in GHC, maybe #5085 (closed). This is broken in the head as well as 7.2.

Trac metadata

Trac field	Value
Version	7.2.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture