Do not call preInlineUnconditionally in simplNonRecX

This looks to me like a long-standing bug. simplNonRecX was calling
preInlineUnconditionally, even though it was given an already-simplified
expression.  Exponential behaviour beckons.

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index d8f9506..4a71774 100644 (file)
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -364,6 +364,7 @@ simplNonRecX env bndr new_rhs thing_inside
     let body' = wrapFloats floats body in 
     returnSmpl (emptyFloats env, Case new_rhs bndr' (exprType body') [(DEFAULT, [], body')])
 
     let body' = wrapFloats floats body in 
     returnSmpl (emptyFloats env, Case new_rhs bndr' (exprType body') [(DEFAULT, [], body')])
 

+{- No, no, no!  Do not try preInlineUnconditionally 

   | preInlineUnconditionally env NotTopLevel bndr new_rhs
        -- This happens; for example, the case_bndr during case of
        -- known constructor:  case (a,b) of x { (p,q) -> ... }
   | preInlineUnconditionally env NotTopLevel bndr new_rhs
        -- This happens; for example, the case_bndr during case of
        -- known constructor:  case (a,b) of x { (p,q) -> ... }

@@ -374,6 +375,7 @@ simplNonRecX env bndr new_rhs thing_inside
        -- e.g.  case (f x, g y) of (a,b) -> ....
        -- If a,b occur once we can avoid constructing the let binding for them.
   = thing_inside (extendIdSubst env bndr (DoneEx new_rhs))
        -- e.g.  case (f x, g y) of (a,b) -> ....
        -- If a,b occur once we can avoid constructing the let binding for them.
   = thing_inside (extendIdSubst env bndr (DoneEx new_rhs))

+-}

 
   | otherwise
   = simplBinder env bndr       `thenSmpl` \ (env, bndr') ->
 
   | otherwise
   = simplBinder env bndr       `thenSmpl` \ (env, bndr') ->