X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FConFold.lhs;fp=ghc%2Fcompiler%2FsimplCore%2FConFold.lhs;h=9299be2dca4ee903e6e4c4b54101cac5eba49d2b;hb=f016a43fcbcca53a284e8d6206705ed468a97736;hp=e6f4be7fbbd1f057d0a127cb39bf712ff7294b19;hpb=29ad936c0443b6af87c26e19d61d1352ac5e7f3e;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/ConFold.lhs b/ghc/compiler/simplCore/ConFold.lhs
index e6f4be7..9299be2 100644
--- a/ghc/compiler/simplCore/ConFold.lhs
+++ b/ghc/compiler/simplCore/ConFold.lhs
@@ -21,7 +21,8 @@ import TysWiredIn	( trueDataCon, falseDataCon )
 import TyCon		( tyConDataCons, isEnumerationTyCon )
 import DataCon		( dataConTag, fIRST_TAG )
 import Const		( conOkForAlt )
-import CoreUnfold	( Unfolding(..) )
+import CoreUnfold	( Unfolding(..), isEvaldUnfolding )
+import CoreUtils	( exprIsValue )
 import Type		( splitTyConApp_maybe )
 
 import Char		( ord, chr )
@@ -89,13 +90,13 @@ NB: If we ever do case-floating, we have an extra worry:
 
 The second case must never be floated outside of the first!
 
-\begin{code}p
-tryPrimOp SeqOp [Type ty, Con (Literal lit) _]
+\begin{code}
+tryPrimOp SeqOp [Type ty, arg]
+  | is_evald arg
   = Just (Con (Literal (mkMachInt 1)) [])
-
-tryPrimOp SeqOp args@[Type ty, Var var]
-  | isEvaluated (getIdUnfolding var) = Just (Con (Literal (mkMachInt 1)) []))	-- var is eval'd
-  | otherwise			     = Nothing 					-- var not eval'd
+  where
+    is_evald (Var v) = isEvaldUnfolding (getIdUnfolding v)
+    is_evald arg     = exprIsValue arg
 \end{code}
 
 \begin{code}