X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FOccurAnal.lhs;fp=compiler%2FsimplCore%2FOccurAnal.lhs;h=2199ab1b6676cb99ead2741231877d0959dec197;hp=5824874b58179d34a16c6615d40817d66cadbb53;hb=c86161c5cf11de77e911fcb9e1e2bd1f8bd80b42;hpb=f65f61e18bb010109fd5581c44d37382b93a35b5

diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 5824874..2199ab1 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -20,7 +20,7 @@ module OccurAnal (
 import CoreSyn
 import CoreFVs
 import Type		( tyVarsOfType )
-import CoreUtils        ( exprIsTrivial, isDefaultAlt, mkCoerceI )
+import CoreUtils        ( exprIsTrivial, isDefaultAlt, mkCoerceI, isExpandableApp )
 import Coercion		( CoercionI(..), mkSymCoI )
 import Id
 import Name		( localiseName )
@@ -532,11 +532,11 @@ reOrderCycle depth (bind : binds) pairs
         | isDFunId bndr = 9   -- Never choose a DFun as a loop breaker
 	   	     	      -- Note [DFuns should not be loop breakers]
 
-        | Just (inl_rule_info, _) <- isInlineRule_maybe (idUnfolding bndr)
-	= case inl_rule_info of
-	     InlWrapper {} -> 10  -- Note [INLINE pragmas]
-	     _other	   ->  3  -- Data structures are more important than this
-	     		          -- so that dictionary/method recursion unravels
+        | Just (inl_source, _) <- isInlineRule_maybe (idUnfolding bndr)
+	= case inl_source of
+	     InlineWrapper {} -> 10  -- Note [INLINE pragmas]
+	     _other	      ->  3  -- Data structures are more important than this
+	     		             -- so that dictionary/method recursion unravels
 		-- Note that this case hits all InlineRule things, so we
 		-- never look at 'rhs for InlineRule stuff. That's right, because
 		-- 'rhs' is irrelevant for inlining things with an InlineRule
@@ -940,14 +940,16 @@ occAnalApp :: OccEnv
 occAnalApp env (Var fun, args)
   = case args_stuff of { (args_uds, args') ->
     let
-        final_args_uds = markRhsUds env is_pap args_uds
+        final_args_uds = markRhsUds env is_exp args_uds
     in
     (fun_uds +++ final_args_uds, mkApps (Var fun) args') }
   where
     fun_uniq = idUnique fun
     fun_uds  = mkOneOcc env fun (valArgCount args > 0)
-    is_pap = isConLikeId fun || valArgCount args < idArity fun
+    is_exp = isExpandableApp fun (valArgCount args)
     	   -- See Note [CONLIKE pragma] in BasicTypes
+	   -- The definition of is_exp should match that in
+	   -- Simplify.prepareRhs
 
                 -- Hack for build, fold, runST
     args_stuff  | fun_uniq == buildIdKey    = appSpecial env 2 [True,True]  args