X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FCorePrep.lhs;fp=ghc%2Fcompiler%2FcoreSyn%2FCorePrep.lhs;h=d7d2a999fcb703a9a7d6283ee430360256dc9dd0;hb=c685ccf47413f070a85c4b739d9d7cc73e6f38e6;hp=12aca166e84c64f6e18dd075448df07bb923bbe7;hpb=fed0cc3f79f40987204258b9b62997a19e4d1afa;p=ghc-hetmet.git

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') ->