X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FsimplCore%2FOccurAnal.lhs;h=295cb6d4946dd438eaa409c1aeddcb8554b55ae8;hb=d83e1ac43a43dc30c7e4f5b64f7b77e32d31886d;hp=7c7cf89d41472c78d0282b7167edfcccf7042bb0;hpb=6dc702e8e8b744196b5841729d16d03f83218834;p=ghc-hetmet.git

diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 7c7cf89..295cb6d 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -15,8 +15,6 @@ module OccurAnal (
         occurAnalysePgm, occurAnalyseExpr
     ) where
 
--- XXX This define is a bit of a hack, and should be done more nicely
-#define FAST_STRING_NOT_NEEDED 1
 #include "HsVersions.h"
 
 import CoreSyn
@@ -348,8 +346,9 @@ occAnalRec (CyclicSCC nodes) (body_usage, binds)
 
     tag_node :: UsageDetails -> Node Details -> (UsageDetails, Node Details)
 	-- (a) Tag the binders in the details with occ info
-	-- (b) Mark the binder with OccInfo saying "no preInlineUnconditionally" if
-	-- 	it is used in any rule (lhs or rhs) of the recursive group
+	-- (b) Mark the binder with "weak loop-breaker" OccInfo 
+	--	saying "no preInlineUnconditionally" if it is used
+	-- 	in any rule (lhs or rhs) of the recursive group
 	--      See Note [Weak loop breakers]
     tag_node usage (ND bndr rhs rhs_usage rhs_fvs, k, ks)
       = (usage `delVarEnv` bndr, (ND bndr2 rhs rhs_usage rhs_fvs, k, ks))
@@ -498,19 +497,28 @@ reOrderCycle (bind : binds)
         | workerExists (idWorkerInfo bndr)      = 10
                 -- Note [Worker inline loop]
 
-        | exprIsTrivial rhs        = 4  -- Practically certain to be inlined
+        | exprIsTrivial rhs        = 5  -- Practically certain to be inlined
                 -- Used to have also: && not (isExportedId bndr)
                 -- But I found this sometimes cost an extra iteration when we have
                 --      rec { d = (a,b); a = ...df...; b = ...df...; df = d }
                 -- where df is the exported dictionary. Then df makes a really
                 -- bad choice for loop breaker
 
-        | is_con_app rhs = 2    -- Data types help with cases
+        | is_con_app rhs = 3    -- Data types help with cases
                 -- Note [conapp]
 
-        | inlineCandidate bndr rhs = 1  -- Likely to be inlined
+-- If an Id is marked "never inline" then it makes a great loop breaker
+-- The only reason for not checking that here is that it is rare
+-- and I've never seen a situation where it makes a difference,
+-- so it probably isn't worth the time to test on every binder
+--	| isNeverActive (idInlinePragma bndr) = -10
+
+        | inlineCandidate bndr rhs = 2  -- Likely to be inlined
                 -- Note [Inline candidates]
 
+        | not (neverUnfold (idUnfolding bndr)) = 1
+                -- the Id has some kind of unfolding
+
         | otherwise = 0
 
     inlineCandidate :: Id -> CoreExpr -> Bool