X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSyn.lhs;h=b6e73134597f199b50c0786711cd01a78cda1817;hb=c01e472e205f09e6cdadc1c878263998f637bc8d;hp=01e2be77c6517e37340631d8091d6ca7ccdbc14c;hpb=72462499b891d5779c19f3bda03f96e24f9554ae;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index 01e2be7..b6e7313 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -45,7 +45,7 @@ module CoreSyn (
 	unfoldingTemplate, setUnfoldingTemplate,
 	maybeUnfoldingTemplate, otherCons, unfoldingArity,
 	isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
-        isExpandableUnfolding, 
+        isExpandableUnfolding, isConLikeUnfolding,
 	isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding, 
 	isStableUnfolding, canUnfold, neverUnfoldGuidance,
 
@@ -413,6 +413,8 @@ data Unfolding
 	uf_is_top     :: Bool,		-- True <=> top level binding
 	uf_is_value   :: Bool,		-- exprIsHNF template (cached); it is ok to discard a `seq` on
 		      			--	this variable
+        uf_is_conlike :: Bool,          -- True <=> application of constructor or CONLIKE function
+                                        --      Cached version of exprIsConLike
 	uf_is_cheap   :: Bool,		-- True <=> doesn't waste (much) work to expand inside an inlining
 					-- 	Cached version of exprIsCheap
 	uf_expandable :: Bool,		-- True <=> can expand in RULE matching
@@ -496,8 +498,9 @@ mkOtherCon = OtherCon
 seqUnfolding :: Unfolding -> ()
 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, 
 		uf_is_value = b1, uf_is_cheap = b2, 
-	   	uf_expandable = b3, uf_arity = a, uf_guidance = g})
-  = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` seqGuidance g
+	   	uf_expandable = b3, uf_is_conlike = b4,
+                uf_arity = a, uf_guidance = g})
+  = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
 
 seqUnfolding _ = ()
 
@@ -541,6 +544,13 @@ isEvaldUnfolding (OtherCon _)		                    = True
 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 isEvaldUnfolding _                                          = False
 
+-- | @True@ if the unfolding is a constructor application, the application
+-- of a CONLIKE function or 'OtherCon'
+isConLikeUnfolding :: Unfolding -> Bool
+isConLikeUnfolding (OtherCon _)                             = True
+isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con
+isConLikeUnfolding _                                        = False
+
 -- | Is the thing we will unfold into certainly cheap?
 isCheapUnfolding :: Unfolding -> Bool
 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap