Add newline in debug print
[ghc-hetmet.git] / compiler / simplCore / OccurAnal.lhs
index 5bfb4b9..f56bc71 100644 (file)
@@ -11,6 +11,13 @@ The occurrence analyser re-typechecks a core expression, returning a new
 core expression with (hopefully) improved usage information.
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module OccurAnal (
        occurAnalysePgm, occurAnalyseExpr
     ) where
@@ -20,24 +27,22 @@ module OccurAnal (
 import CoreSyn
 import CoreFVs         ( idRuleVars )
 import CoreUtils       ( exprIsTrivial, isDefaultAlt )
-import Id              ( isDataConWorkId, isOneShotBndr, setOneShotLambda, 
-                         idOccInfo, setIdOccInfo, isLocalId,
-                         isExportedId, idArity, idHasRules,
-                         idType, idUnique, Id
-                       )
+import Id
+import IdInfo
 import BasicTypes      ( OccInfo(..), isOneOcc, InterestingCxt )
 
 import VarSet
 import VarEnv
 
-import Type            ( isFunTy, dropForAlls )
 import Maybes          ( orElse )
 import Digraph         ( stronglyConnCompR, SCC(..) )
 import PrelNames       ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey )
 import Unique          ( Unique )
 import UniqFM          ( keysUFM, intersectsUFM )  
-import Util            ( mapAndUnzip, mapAccumL )
+import Util            ( mapAndUnzip )
 import Outputable
+
+import Data.List
 \end{code}
 
 
@@ -134,7 +139,7 @@ It isn't easy to do a perfect job in one blow.  Consider
 
 \begin{code}
 occAnalBind env (Rec pairs) body_usage
-  = foldr (_scc_ "occAnalBind.dofinal" do_final_bind) (body_usage, []) sccs
+  = foldr ({-# SCC "occAnalBind.dofinal" #-} do_final_bind) (body_usage, []) sccs
   where
     analysed_pairs :: [Details]
     analysed_pairs  = [ (bndr, rhs_usage, rhs')
@@ -143,12 +148,12 @@ occAnalBind env (Rec pairs) body_usage
                      ]
 
     sccs :: [SCC (Node Details)]
-    sccs = _scc_ "occAnalBind.scc" stronglyConnCompR edges
+    sccs = {-# SCC "occAnalBind.scc" #-} stronglyConnCompR edges
 
 
     ---- stuff for dependency analysis of binds -------------------------------
     edges :: [Node Details]
-    edges = _scc_ "occAnalBind.assoc"
+    edges = {-# SCC "occAnalBind.assoc" #-}
            [ (details, idUnique id, edges_from id rhs_usage)
            | details@(id, rhs_usage, rhs) <- analysed_pairs
            ]
@@ -163,7 +168,7 @@ occAnalBind env (Rec pairs) body_usage
        -- which has n**2 cost, and this meant that edges_from alone 
        -- consumed 10% of total runtime!
     edges_from :: Id -> UsageDetails -> [Unique]
-    edges_from bndr rhs_usage = _scc_ "occAnalBind.edges_from"
+    edges_from bndr rhs_usage = {-# SCC "occAnalBind.edges_from" #-}
                                keysUFM (addRuleUsage rhs_usage bndr)
 
     ---- Stuff to "re-constitute" bindings from dependency-analysis info ------
@@ -294,6 +299,9 @@ reOrderCycle bndrs (bind : binds)
          
     score :: Node Details -> Int       -- Higher score => less likely to be picked as loop breaker
     score ((bndr, _, rhs), _, _)
+        | workerExists (idWorkerInfo bndr)      = 10
+                -- Note [Worker inline loop]
+
        | exprIsTrivial rhs        = 4  -- Practically certain to be inlined
                -- Used to have also: && not (isExportedId bndr)
                -- But I found this sometimes cost an extra iteration when we have
@@ -301,16 +309,17 @@ reOrderCycle bndrs (bind : binds)
                -- where df is the exported dictionary. Then df makes a really
                -- bad choice for loop breaker
          
-       | not_fun_ty (idType bndr) = 3  -- Data types help with cases
-               -- This used to have a lower score than inlineCandidate, but
-               -- it's *really* helpful if dictionaries get inlined fast,
-               -- so I'm experimenting with giving higher priority to data-typed things
-
-       | inlineCandidate bndr rhs = 2  -- Likely to be inlined
-
-       | idHasRules bndr = 1
+       | idHasRules bndr = 3
                -- Avoid things with specialisations; we'd like
                -- to take advantage of them in the subsequent bindings
+               -- Also vital to avoid risk of divergence:
+               -- Note [Recursive rules]
+
+       | is_con_app rhs = 2    -- Data types help with cases
+                -- Note [conapp]
+
+       | inlineCandidate bndr rhs = 1  -- Likely to be inlined
+               -- Note [Inline candidates]
 
        | otherwise = 0
 
@@ -318,7 +327,11 @@ reOrderCycle bndrs (bind : binds)
     inlineCandidate id (Note InlineMe _) = True
     inlineCandidate id rhs              = isOneOcc (idOccInfo id)
 
-       -- Real example (the Enum Ordering instance from PrelBase):
+        -- Note [conapp]
+        --
+        -- It's really really important to inline dictionaries.  Real
+        -- example (the Enum Ordering instance from GHC.Base):
+        --
        --      rec     f = \ x -> case d of (p,q,r) -> p x
        --              g = \ x -> case d of (p,q,r) -> q x
        --              d = (v, f, g)
@@ -327,8 +340,22 @@ reOrderCycle bndrs (bind : binds)
        -- On the other hand we *could* simplify those case expressions if
        -- we didn't stupidly choose d as the loop breaker.
        -- But we won't because constructor args are marked "Many".
-
-    not_fun_ty ty = not (isFunTy (dropForAlls ty))
+        -- Inlining dictionaries is really essential to unravelling
+        -- the loops in static numeric dictionaries, see GHC.Float.
+
+       -- Cheap and cheerful; the simplifer moves casts out of the way
+       -- The lambda case is important to spot x = /\a. C (f a)
+       -- which comes up when C is a dictionary constructor and
+       -- f is a default method.  
+       -- Example: the instance for Show (ST s a) in GHC.ST
+       --
+       -- However we *also* treat (\x. C p q) as a con-app-like thing, 
+       --      Note [Closure conversion]
+    is_con_app (Var v)    = isDataConWorkId v
+    is_con_app (App f _)  = is_con_app f
+    is_con_app (Lam b e)  = is_con_app e
+    is_con_app (Note _ e) = is_con_app e
+    is_con_app other      = False
 
 makeLoopBreaker :: VarSet              -- Binders of this group
                -> UsageDetails         -- Usage of this rhs (neglecting rules)
@@ -341,6 +368,67 @@ makeLoopBreaker bndrs rhs_usg bndr
     rules_only = bndrs `intersectsUFM` rhs_usg
 \end{code}
 
+Note [Worker inline loop]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Never choose a wrapper as the loop breaker!  Because
+wrappers get auto-generated inlinings when importing, and
+that can lead to an infinite inlining loop.  For example:
+  rec {
+       $wfoo x = ....foo x....
+       
+       {-loop brk-} foo x = ...$wfoo x...
+  }
+
+The interface file sees the unfolding for $wfoo, and sees that foo is
+strict (and hence it gets an auto-generated wrapper).  Result: an
+infinite inlining in the importing scope.  So be a bit careful if you
+change this.  A good example is Tree.repTree in
+nofib/spectral/minimax. If the repTree wrapper is chosen as the loop
+breaker then compiling Game.hs goes into an infinite loop (this
+happened when we gave is_con_app a lower score than inline candidates).
+
+Note [Recursive rules]
+~~~~~~~~~~~~~~~~~~~~~~
+Consider this group, which is typical of what SpecConstr builds:
+
+   fs a = ....f (C a)....
+   f  x = ....f (C a)....
+   {-# RULE f (C a) = fs a #-}
+
+So 'f' and 'fs' are mutually recursive.  If we choose 'fs' as the loop breaker,
+all is well; the RULE is applied, and 'fs' becomes self-recursive.
+
+But if we choose 'f' as the loop breaker, we may get an infinite loop:
+       - the RULE is applied in f's RHS (see Note [Self-recursive rules] in Simplify
+       - fs is inlined (say it's small)
+       - now there's another opportunity to apply the RULE
+
+So it's very important not to choose the RULE-variable as the loop breaker.
+This showed up when compiling Control.Concurrent.Chan.getChanContents.
+
+Note [Closure conversion]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+We treat (\x. C p q) as a high-score candidate in the letrec scoring algorithm.
+The immediate motivation came from the result of a closure-conversion transformation
+which generated code like this:
+
+    data Clo a b = forall c. Clo (c -> a -> b) c
+
+    ($:) :: Clo a b -> a -> b
+    Clo f env $: x = f env x
+
+    rec { plus = Clo plus1 ()
+
+        ; plus1 _ n = Clo plus2 n
+
+       ; plus2 Zero     n = n
+       ; plus2 (Succ m) n = Succ (plus $: m $: n) }
+
+If we inline 'plus' and 'plus1', everything unravels nicely.  But if
+we choose 'plus1' as the loop breaker (which is entirely possible
+otherwise), the loop does not unravel nicely.
+
+
 @occAnalRhs@ deals with the question of bindings where the Id is marked
 by an INLINE pragma.  For these we record that anything which occurs
 in its RHS occurs many times.  This pessimistically assumes that ths