From: sof <unknown>
Date: Sun, 19 Oct 1997 21:41:46 +0000 (+0000)
Subject: [project @ 1997-10-19 21:41:46 by sof]
X-Git-Tag: Approx_2487_patches~1357
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=83e19fd507e072332c0762be9295331e5773c4e9;p=ghc-hetmet.git

[project @ 1997-10-19 21:41:46 by sof]
Refrain from doing let-to-case conversion on binders with RHS in whnf
---

diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index 8a122ef..d4617c9 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -490,9 +490,15 @@ tidyCoreExpr (Lam (UsageBinder uv) body)
 	-- some let-to-case stuff is deferred to now).
 tidyCoreExpr (Let (NonRec bndr rhs) body)
   | willBeDemanded (getIdDemandInfo bndr) && 
+    not rhs_is_whnf &&		-- Don't do it if RHS is already in WHNF
     typeOkForCase (idType bndr)
   = ASSERT( not (isPrimType (idType bndr)) )
     tidyCoreExpr (Case rhs (AlgAlts [] (BindDefault bndr body)))
+  where
+    rhs_is_whnf = case mkFormSummary rhs of
+			VarForm -> True
+			ValueForm -> True
+			other -> False
 
 tidyCoreExpr (Let (NonRec bndr rhs) body)
   = tidyCoreExpr rhs		`thenTM` \ rhs' ->