From: simonmar <unknown>
Date: Fri, 15 Dec 2000 14:48:09 +0000 (+0000)
Subject: [project @ 2000-12-15 14:48:09 by simonmar]
X-Git-Tag: Approximately_9120_patches~3090
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0a5fb01254aff2c4bd9043f5e459f34b5a08f4cf;p=ghc-hetmet.git

[project @ 2000-12-15 14:48:09 by simonmar]
Don't eta reduce something we just saturated.  (D'oh!)

This fixes the problem which causes a bootstrapped HEAD compiler to
crash.
---

diff --git a/ghc/compiler/coreSyn/CoreSat.lhs b/ghc/compiler/coreSyn/CoreSat.lhs
index 1b347d1..b47c514 100644
--- a/ghc/compiler/coreSyn/CoreSat.lhs
+++ b/ghc/compiler/coreSyn/CoreSat.lhs
@@ -334,7 +334,8 @@ deLam expr@(Lam _ _)
     (bndrs, body) = collectBinders expr
 
     eta expr@(App _ _)
-	| n_remaining >= 0 &&
+	| ok_to_eta_reduce f &&
+	  n_remaining >= 0 &&
 	  and (zipWith ok bndrs last_args) &&
 	  not (any (`elemVarSet` fvs_remaining) bndrs)
 	= Just remaining_expr
@@ -348,6 +349,14 @@ deLam expr@(Lam _ _)
 	  ok bndr (Var arg) = bndr == arg
 	  ok bndr other	    = False
 
+	  -- we can't eta reduce something which must be saturated.
+	  ok_to_eta_reduce (Var f)
+		 = case idFlavour f of
+		      PrimOpId op  -> False
+		      DataConId dc -> False
+		      other 	   -> True
+	  ok_to_eta_reduce _ = False --safe. ToDo: generalise
+
     eta (Let bind@(NonRec b r) body)
 	| not (any (`elemVarSet` fvs) bndrs)
 		 = case eta body of