[project @ 2001-01-05 16:06:01 by simonmar]

Add some constraints to the tryRhsTyLam transformation to prevent it
floating out expressions of unlifted type.

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index dd1f86a..5f8c77f 100644 (file)
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -536,8 +536,8 @@ as we would normally do.
 tryRhsTyLam :: OutExpr -> SimplM ([OutBind], OutExpr)
 
 tryRhsTyLam rhs                        -- Only does something if there's a let
-  | null tyvars || not (worth_it body) -- inside a type lambda, and a WHNF inside that
-  = returnSmpl ([], rhs)
+  | null tyvars || not (worth_it body) -- inside a type lambda, 
+  = returnSmpl ([], rhs)               -- and a WHNF inside that
 
   | otherwise
   = go (\x -> x) body          `thenSmpl` \ (binds, body') ->
@@ -546,8 +546,11 @@ tryRhsTyLam rhs                    -- Only does something if there's a let
   where
     (tyvars, body) = collectTyBinders rhs
 
-    worth_it (Let _ e)      = whnf_in_middle e
-    worth_it other                  = False
+    worth_it (Let (NonRec x rhs) e) | isUnLiftedType (exprType rhs) = False
+    worth_it (Let _ e) = whnf_in_middle e
+    worth_it other     = False
+
+    whnf_in_middle (Let (NonRec x rhs) e) | isUnLiftedType (exprType rhs) = False
     whnf_in_middle (Let _ e) = whnf_in_middle e
     whnf_in_middle e        = exprIsCheap e