X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FcoreSyn%2FCoreUtils.lhs;h=0eab695dc6feeb9236d9fd1359c8d06629a55dd9;hb=53da379cee909d23b9f785c2250e64cba34ad3b2;hp=2eedd331314a2de3dcefedeebc2348006ea10e7e;hpb=46ff3d8caded776ab471d3682258147e42be8f14;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 2eedd33..0eab695 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -69,7 +69,6 @@ import CostCentre
 import Unique
 import Outputable
 import TysPrim
-import PrelNames( absentErrorIdKey )
 import FastString
 import Maybes
 import Util
@@ -465,22 +464,27 @@ Note [exprIsDupable]
 
 \begin{code}
 exprIsDupable :: CoreExpr -> Bool
-exprIsDupable (Type _)   = True
-exprIsDupable (Var _)    = True
-exprIsDupable (Lit lit)  = litIsDupable lit
-exprIsDupable (Note _ e) = exprIsDupable e
-exprIsDupable (Cast e _) = exprIsDupable e
-exprIsDupable expr
-  = go expr 0
+exprIsDupable e
+  = isJust (go dupAppSize e)
   where
-    go (Var _)   _      = True
-    go (App f a) n_args =  n_args < dupAppSize
-			&& exprIsDupable a
-			&& go f (n_args+1)
-    go _         _      = False
+    go :: Int -> CoreExpr -> Maybe Int
+    go n (Type {}) = Just n
+    go n (Var {})  = decrement n
+    go n (Note _ e) = go n e
+    go n (Cast e _) = go n e
+    go n (App f a) | Just n' <- go n a = go n' f
+    go n (Lit lit) | litIsDupable lit = decrement n
+    go _ _ = Nothing
+
+    decrement :: Int -> Maybe Int
+    decrement 0 = Nothing
+    decrement n = Just (n-1)
 
 dupAppSize :: Int
-dupAppSize = 4		-- Size of application we are prepared to duplicate
+dupAppSize = 8	 -- Size of term we are prepared to duplicate
+	         -- This is *just* big enough to make test MethSharing
+		 -- inline enough join points.  Really it should be
+		 -- smaller, and could be if we fixed Trac #4960.
 \end{code}
 
 %************************************************************************
@@ -562,6 +566,7 @@ exprIsCheap' good_app other_expr 	-- Applications and variables
   = go other_expr []
   where
 	-- Accumulate value arguments, then decide
+    go (Cast e _) val_args                 = go e val_args
     go (App f a) val_args | isRuntimeArg a = go f (a:val_args)
 			  | otherwise      = go f val_args
 
@@ -697,10 +702,7 @@ exprOkForSpeculation (Case e _ _ alts)
 
 exprOkForSpeculation other_expr
   = case collectArgs other_expr of
-	(Var f, args) | f `hasKey` absentErrorIdKey	-- Note [Absent error Id]
-                      -> all exprOkForSpeculation args  --    in WwLib
-                      | otherwise 
-                      -> spec_ok (idDetails f) args
+	(Var f, args) -> spec_ok (idDetails f) args
         _             -> False
  
   where