X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=2d83a0fc717e53258ef2294f2542675ec482f173;hb=e66a5311c7bfa0690875f2e87bbe74d053e24147;hp=ae46a8baba1769785e166a950ac58986b9d7a752;hpb=794c2f4c8829ba3166c9bdb471856bc00c21f001;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index ae46a8b..2d83a0f 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -120,8 +120,9 @@ mkCoreUnfolding top_lvl expr arity guidance
   = CoreUnfolding { uf_tmpl   	  = occurAnalyseExpr expr,
     		    uf_arity      = arity,
 		    uf_is_top 	  = top_lvl,
-		    uf_is_value   = exprIsHNF expr,
-		    uf_is_cheap   = exprIsCheap expr,
+		    uf_is_value   = exprIsHNF        expr,
+                    uf_is_conlike = exprIsConLike    expr,
+		    uf_is_cheap   = exprIsCheap      expr,
 		    uf_expandable = exprIsExpandable expr,
 		    uf_guidance   = guidance }
 
@@ -936,7 +937,7 @@ Note [Conlike is interesting]
 Consider
 	f d = ...((*) d x y)...
 	... f (df d')...
-where df is con-like. Then we'd really like to inline so that the
+where df is con-like. Then we'd really like to inline 'f' so that the
 rule for (*) (df d) can fire.  To do this 
   a) we give a discount for being an argument of a class-op (eg (*) d)
   b) we say that a con-like argument (eg (df d)) is interesting
@@ -958,10 +959,11 @@ interestingArg e = go e 0
        	 	     	     		--    data constructors here
        | idArity v > n	   = ValueArg	-- Catches (eg) primops with arity but no unfolding
        | n > 0	           = NonTrivArg	-- Saturated or unknown call
-       | evald_unfolding   = ValueArg	-- n==0; look for a value
+       | conlike_unfolding = ValueArg	-- n==0; look for an interesting unfolding
+                                        -- See Note [Conlike is interesting]
        | otherwise	   = TrivArg	-- n==0, no useful unfolding
        where
-         evald_unfolding = isEvaldUnfolding (idUnfolding v)
+         conlike_unfolding = isConLikeUnfolding (idUnfolding v)
 
     go (Type _)          _ = TrivArg
     go (App fn (Type _)) n = go fn n    
@@ -1072,7 +1074,8 @@ exprIsConApp_maybe (Cast expr co)
     let dump_doc = vcat [ppr dc,      ppr dc_univ_tyvars, ppr dc_ex_tyvars,
                          ppr arg_tys, ppr dc_args,        ppr _dc_univ_args,
                          ppr ex_args, ppr val_args]
-    ASSERT2( coreEqType from_ty (mkTyConApp dc_tc _dc_univ_args), dump_doc )
+    in
+    ASSERT2( coreEqType _from_ty (mkTyConApp dc_tc _dc_univ_args), dump_doc )
     ASSERT2( all isTypeArg (ex_args ++ co_args), dump_doc )
     ASSERT2( equalLength val_args arg_tys, dump_doc )
 #endif