From c685ccf47413f070a85c4b739d9d7cc73e6f38e6 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 23 Feb 2005 09:13:49 +0000
Subject: [PATCH] [project @ 2005-02-23 09:13:49 by simonpj]
 --------------------------------------------- 	Another fix
 to data2tag evaluated-ness (sigh) 
 ---------------------------------------------

	Merge to STABLE
---
 ghc/compiler/coreSyn/CorePrep.lhs |   12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/ghc/compiler/coreSyn/CorePrep.lhs b/ghc/compiler/coreSyn/CorePrep.lhs
index 12aca16..d7d2a99 100644
--- a/ghc/compiler/coreSyn/CorePrep.lhs
+++ b/ghc/compiler/coreSyn/CorePrep.lhs
@@ -560,16 +560,16 @@ maybeSaturate fn expr n_args floats ty
 
 	-- Ensure that the argument of DataToTagOp is evaluated
     eval_data2tag_arg :: CoreExpr -> UniqSM (Floats, CoreExpr)
-    eval_data2tag_arg app@(fun `App` Var arg_id)
-	| isEvaldUnfolding (idUnfolding arg_id)	-- Includes nullary constructors
+    eval_data2tag_arg app@(fun `App` arg)
+	| exprIsValue arg		-- Includes nullary constructors
 	= returnUs (emptyFloats, app)	-- The arg is evaluated
 	| otherwise			-- Arg not evaluated, so evaluate it
-	= newVar (idType arg_id)		`thenUs` \ arg_id1 ->
+	= newVar (exprType arg)		`thenUs` \ arg_id ->
 	  let 
-	     arg_id2   = setIdUnfolding arg_id1 evaldUnfolding
+	     arg_id1 = setIdUnfolding arg_id evaldUnfolding
 	  in
-	  returnUs (unitFloat (FloatCase arg_id2 (Var arg_id) False ),
-		    fun `App` Var arg_id2)
+	  returnUs (unitFloat (FloatCase arg_id1 arg False ),
+		    fun `App` Var arg_id1)
 
     eval_data2tag_arg (Note note app)	-- Scc notes can appear
 	= eval_data2tag_arg app		`thenUs` \ (floats, app') ->
-- 
1.7.10.4