Print tidy rules in user style, to avoid gratuitous uniques

[ghc-hetmet.git] / compiler / simplCore / OccurAnal.lhs

diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 794217f..2b2c058 100644 (file)
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -28,7 +28,7 @@ import VarSet
 import VarEnv
 
 import Maybes           ( orElse )
-import Digraph          ( stronglyConnCompR, SCC(..) )
+import Digraph          ( SCC(..), stronglyConnCompFromEdgedVerticesR )
 import PrelNames        ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey )
 import Unique           ( Unique )
 import UniqFM           ( keysUFM, intersectUFM_C, foldUFM_Directly )
@@ -84,7 +84,10 @@ occAnalBind :: OccEnv
                 [CoreBind])
 
 occAnalBind env (NonRec binder rhs) body_usage
-  | not (binder `usedIn` body_usage)            -- It's not mentioned
+  | isTyVar binder                     -- A type let; we don't gather usage info
+  = (body_usage, [NonRec binder rhs])
+
+  | not (binder `usedIn` body_usage)    -- It's not mentioned
   = (body_usage, [])
 
   | otherwise                   -- It's mentioned in the body
@@ -287,7 +290,7 @@ occAnalBind env (Rec pairs) body_usage
     bndr_set = mkVarSet (map fst pairs)
 
     sccs :: [SCC (Node Details)]
-    sccs = {-# SCC "occAnalBind.scc" #-} stronglyConnCompR rec_edges
+    sccs = {-# SCC "occAnalBind.scc" #-} stronglyConnCompFromEdgedVerticesR rec_edges
 
     rec_edges :: [Node Details]
     rec_edges = {-# SCC "occAnalBind.assoc" #-}  map make_node pairs
@@ -346,8 +349,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))
@@ -361,7 +365,7 @@ occAnalRec (CyclicSCC nodes) (body_usage, binds)
        ----------------------------
        -- Now reconstruct the cycle
     pairs | no_rules  = reOrderCycle tagged_nodes
-         | otherwise = concatMap reOrderRec (stronglyConnCompR loop_breaker_edges)
+         | otherwise = concatMap reOrderRec (stronglyConnCompFromEdgedVerticesR loop_breaker_edges)
 
        -- See Note [Choosing loop breakers] for looop_breaker_edges
     loop_breaker_edges = map mk_node tagged_nodes
@@ -470,7 +474,7 @@ reOrderCycle [bind]     -- Common case of simple self-recursion
 reOrderCycle (bind : binds)
   =     -- Choose a loop breaker, mark it no-inline,
         -- do SCC analysis on the rest, and recursively sort them out
-    concatMap reOrderRec (stronglyConnCompR unchosen) ++
+    concatMap reOrderRec (stronglyConnCompFromEdgedVerticesR unchosen) ++
     [(makeLoopBreaker False bndr, rhs)]
 
   where
@@ -496,19 +500,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