Add the notion of "constructor-like" Ids for rule-matching
[ghc-hetmet.git] / compiler / simplCore / OccurAnal.lhs
index 58f72cb..c5f323e 100644 (file)
@@ -171,8 +171,8 @@ However things are made quite a bit more complicated by RULES.  Remember
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     We avoid infinite inlinings by choosing loop breakers, and
     ensuring that a loop breaker cuts each loop.  But what is a
-    "loop"?  In particular, a RULES is like an equation for 'f' that
-    is *always* inlined if it are applicable.  We do *not* disable
+    "loop"?  In particular, a RULE is like an equation for 'f' that
+    is *always* inlined if it is applicable.  We do *not* disable
     rules for loop-breakers.  It's up to whoever makes the rules to
     make sure that the rules themselves alwasys terminate.  See Note
     [Rules for recursive functions] in Simplify.lhs
@@ -237,8 +237,9 @@ However things are made quite a bit more complicated by RULES.  Remember
   * Note [Rule dependency info]
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~
     The VarSet in a SpecInfo is used for dependency analysis in the
-    occurrence analyser.  We must track free vars in *both* lhs and rhs.  Why both?
-    Consider
+    occurrence analyser.  We must track free vars in *both* lhs and rhs.  
+    Hence use of idRuleVars, rather than idRuleRhsVars in addRuleUsage.  
+    Why both? Consider
         x = y
         RULE f x = 4
     Then if we substitute y for x, we'd better do so in the
@@ -509,7 +510,7 @@ reOrderCycle (bind : binds)
                 -- bad choice for loop breaker
 
         | is_con_app rhs = 3    -- Data types help with cases
-                -- Note [conapp]
+                -- Note [Constructor applictions]
 
 -- 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
@@ -560,22 +561,24 @@ reOrderCycle (bind : binds)
     is_con_app _          = False
 
 makeLoopBreaker :: Bool -> Id -> Id
--- Set the loop-breaker flag
--- See Note [Weak loop breakers]
+-- Set the loop-breaker flag: see Note [Weak loop breakers]
 makeLoopBreaker weak bndr = setIdOccInfo bndr (IAmALoopBreaker weak)
 \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:
+Note [INLINE pragmas]
+~~~~~~~~~~~~~~~~~~~~~
+Never choose a function with an INLINE pramga as the loop breaker!  
+If such a function is mutually-recursive with a non-INLINE thing,
+then the latter should be the loop-breaker.
+
+A particular case is wrappers generated by the demand analyser.
+If you make then into a loop breaker you may get 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
@@ -584,6 +587,22 @@ 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 [Constructor applications]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+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)
+
+Here, f and g occur just once; but we can't inline them into d.
+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".
+Inlining dictionaries is really essential to unravelling
+the loops in static numeric dictionaries, see GHC.Float.
+
 Note [Closure conversion]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 We treat (\x. C p q) as a high-score candidate in the letrec scoring algorithm.
@@ -629,7 +648,7 @@ occAnalRhs env id rhs
   = occAnal ctxt rhs
   where
     ctxt | certainly_inline id = env
-         | otherwise           = rhsCtxt
+         | otherwise           = rhsCtxt env
         -- Note that we generally use an rhsCtxt.  This tells the occ anal n
         -- that it's looking at an RHS, which has an effect in occAnalApp
         --
@@ -657,10 +676,14 @@ addRuleUsage :: UsageDetails -> Id -> UsageDetails
 -- Add the usage from RULES in Id to the usage
 addRuleUsage usage id
   = foldVarSet add usage (idRuleVars id)
+        -- idRuleVars here: see Note [Rule dependency info]
   where
-    add v u = addOneOcc u v NoOccInfo           -- Give a non-committal binder info
-                                                -- (i.e manyOcc) because many copies
-                                                -- of the specialised thing can appear
+    add v u = addOneOcc u v NoOccInfo
+       -- Give a non-committal binder info (i.e manyOcc) because
+       --   a) Many copies of the specialised thing can appear
+       --   b) We don't want to substitute a BIG expression inside a RULE
+       --      even if that's the only occurrence of the thing
+       --      (Same goes for INLINE.)
 \end{code}
 
 Expressions
@@ -763,7 +786,7 @@ occAnal env expr@(Lam _ _)
     (really_final_usage,
      mkLams tagged_binders body') }
   where
-    env_body        = vanillaCtxt                       -- Body is (no longer) an RhsContext
+    env_body        = vanillaCtxt env        -- Body is (no longer) an RhsContext
     (binders, body) = collectBinders expr
     binders'        = oneShotGroup env binders
     linear          = all is_one_shot binders'
@@ -793,7 +816,7 @@ occAnal env (Case scrut bndr ty alts)
                                 Nothing -> usage
                                 Just _  -> extendVarEnv usage bndr NoOccInfo
 
-    alt_env = setVanillaCtxt env
+    alt_env = mkAltEnv env bndr_swap
         -- Consider     x = case v of { True -> (p,q); ... }
         -- Then it's fine to inline p and q
 
@@ -810,7 +833,7 @@ occAnal env (Case scrut bndr ty alts)
                                        -- in an interesting context; the case has
                                        -- at least one non-default alternative
     occ_anal_scrut scrut _alts  
-       = occAnal vanillaCtxt scrut    -- No need for rhsCtxt
+       = occAnal (vanillaCtxt env) scrut    -- No need for rhsCtxt
 
 occAnal env (Let bind body)
   = case occAnal env body                of { (body_usage, body') ->
@@ -818,11 +841,11 @@ occAnal env (Let bind body)
        (final_usage, mkLets new_binds body') }}
 
 occAnalArgs :: OccEnv -> [CoreExpr] -> (UsageDetails, [CoreExpr])
-occAnalArgs _env args
+occAnalArgs env args
   = case mapAndUnzip (occAnal arg_env) args of  { (arg_uds_s, args') ->
     (foldr (+++) emptyDetails arg_uds_s, args')}
   where
-    arg_env = vanillaCtxt
+    arg_env = vanillaCtxt env
 \end{code}
 
 Applications are dealt with specially because we want
@@ -841,7 +864,7 @@ occAnalApp env (Var fun, args)
   where
     fun_uniq = idUnique fun
     fun_uds  = mkOneOcc env fun (valArgCount args > 0)
-    is_pap = isDataConWorkId fun || valArgCount args < idArity fun
+    is_pap = isConLikeId fun || valArgCount args < idArity fun
 
                 -- Hack for build, fold, runST
     args_stuff  | fun_uniq == buildIdKey    = appSpecial env 2 [True,True]  args
@@ -896,12 +919,12 @@ appSpecial :: OccEnv
 appSpecial env n ctxt args
   = go n args
   where
-    arg_env = vanillaCtxt
+    arg_env = vanillaCtxt env
 
     go _ [] = (emptyDetails, [])        -- Too few args
 
     go 1 (arg:args)                     -- The magic arg
-      = case occAnal (setCtxt arg_env ctxt) arg of      { (arg_uds, arg') ->
+      = case occAnal (setCtxtTy arg_env ctxt) arg of    { (arg_uds, arg') ->
         case occAnalArgs env args of                    { (args_uds, args') ->
         (arg_uds +++ args_uds, arg':args') }}
 
@@ -924,25 +947,22 @@ We do these two transformations right here:
     ==>
       case (x |> co) of b { pi -> let x = b |> sym co in ri }
 
-    Why (2)?  See Note [Ccase of cast]
+    Why (2)?  See Note [Case of cast]
 
 In both cases, in a particular alternative (pi -> ri), we only 
 add the binding if
   (a) x occurs free in (pi -> ri)
        (ie it occurs in ri, but is not bound in pi)
   (b) the pi does not bind b (or the free vars of co)
-  (c) x is not a 
 We need (a) and (b) for the inserted binding to be correct.
 
-Notice that (a) rapidly becomes false, so no bindings are injected.
-
-Notice the deliberate shadowing of 'x'. But we must call localiseId 
-on 'x' first, in case it's a GlobalId, or has an External Name.
-See, for example, SimplEnv Note [Global Ids in the substitution].
-
 For the alternatives where we inject the binding, we can transfer
 all x's OccInfo to b.  And that is the point.
 
+Notice that 
+  * The deliberate shadowing of 'x'. 
+  * That (a) rapidly becomes false, so no bindings are injected.
+
 The reason for doing these transformations here is because it allows
 us to adjust the OccInfo for 'x' and 'b' as we go.
 
@@ -960,6 +980,90 @@ us to adjust the OccInfo for 'x' and 'b' as we go.
 The Maybe (Id,CoreExpr) passed to occAnalAlt is the extra let-binding
 {x=b}; it's Nothing if the binder-swap doesn't happen.
 
+There is a danger though.  Consider
+      let v = x +# y
+      in case (f v) of w -> ...v...v...
+And suppose that (f v) expands to just v.  Then we'd like to
+use 'w' instead of 'v' in the alternative.  But it may be too
+late; we may have substituted the (cheap) x+#y for v in the 
+same simplifier pass that reduced (f v) to v.
+
+I think this is just too bad.  CSE will recover some of it.
+
+Note [Binder swap on GlobalId scrutinees]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When the scrutinee is a GlobalId we must take care in two ways
+
+ i) In order to *know* whether 'x' occurs free in the RHS, we need its
+    occurrence info. BUT, we don't gather occurrence info for
+    GlobalIds.  That's what the (small) occ_scrut_ids set in OccEnv is
+    for: it says "gather occurrence info for these.
+
+ ii) We must call localiseId on 'x' first, in case it's a GlobalId, or
+     has an External Name. See, for example, SimplEnv Note [Global Ids in
+     the substitution].
+
+Historical note [no-case-of-case]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We *used* to suppress the binder-swap in case expressoins when 
+-fno-case-of-case is on.  Old remarks:
+    "This happens in the first simplifier pass,
+    and enhances full laziness.  Here's the bad case:
+            f = \ y -> ...(case x of I# v -> ...(case x of ...) ... )
+    If we eliminate the inner case, we trap it inside the I# v -> arm,
+    which might prevent some full laziness happening.  I've seen this
+    in action in spectral/cichelli/Prog.hs:
+             [(m,n) | m <- [1..max], n <- [1..max]]
+    Hence the check for NoCaseOfCase."
+However, now the full-laziness pass itself reverses the binder-swap, so this
+check is no longer necessary.
+
+Historical note [Suppressing the case binder-swap]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+This old note describes a problem that is also fixed by doing the
+binder-swap in OccAnal:
+
+    There is another situation when it might make sense to suppress the
+    case-expression binde-swap. If we have
+
+        case x of w1 { DEFAULT -> case x of w2 { A -> e1; B -> e2 }
+                       ...other cases .... }
+
+    We'll perform the binder-swap for the outer case, giving
+
+        case x of w1 { DEFAULT -> case w1 of w2 { A -> e1; B -> e2 }
+                       ...other cases .... }
+
+    But there is no point in doing it for the inner case, because w1 can't
+    be inlined anyway.  Furthermore, doing the case-swapping involves
+    zapping w2's occurrence info (see paragraphs that follow), and that
+    forces us to bind w2 when doing case merging.  So we get
+
+        case x of w1 { A -> let w2 = w1 in e1
+                       B -> let w2 = w1 in e2
+                       ...other cases .... }
+
+    This is plain silly in the common case where w2 is dead.
+
+    Even so, I can't see a good way to implement this idea.  I tried
+    not doing the binder-swap if the scrutinee was already evaluated
+    but that failed big-time:
+
+            data T = MkT !Int
+
+            case v of w  { MkT x ->
+            case x of x1 { I# y1 ->
+            case x of x2 { I# y2 -> ...
+
+    Notice that because MkT is strict, x is marked "evaluated".  But to
+    eliminate the last case, we must either make sure that x (as well as
+    x1) has unfolding MkT y1.  THe straightforward thing to do is to do
+    the binder-swap.  So this whole note is a no-op.
+
+It's fixed by doing the binder-swap in OccAnal because we can do the
+binder-swap unconditionally and still get occurrence analysis
+information right.
+
 Note [Case of cast]
 ~~~~~~~~~~~~~~~~~~~
 Consider        case (x `cast` co) of b { I# ->
@@ -1005,7 +1109,7 @@ occAnalAlt env case_bndr mb_scrut_var (con, bndrs, rhs)
           (usg_wo_scrut, scrut_var') = tagBinder alt_usg (localiseId scrut_var)
                        -- Note the localiseId; we're making a new binding
                        -- for it, and it might have an External Name, or
-                       -- even be a GlobalId
+                       -- even be a GlobalId; Note [Binder swap on GlobalId scrutinees]
           shadowing bndr = bndr `elemVarSet` rhs_fvs
           rhs_fvs = exprFreeVars scrut_rhs
 
@@ -1021,8 +1125,15 @@ occAnalAlt env case_bndr mb_scrut_var (con, bndrs, rhs)
 
 \begin{code}
 data OccEnv
-  = OccEnv OccEncl      -- Enclosing context information
-           CtxtTy       -- Tells about linearity
+  = OccEnv { occ_encl     :: !OccEncl      -- Enclosing context information
+          , occ_ctxt      :: !CtxtTy       -- Tells about linearity
+          , occ_scrut_ids :: !GblScrutIds }
+
+type GblScrutIds = IdSet  -- GlobalIds that are scrutinised, and for which
+                         -- we want to gather occurence info; see
+                         -- Note [Binder swap for GlobalId scrutinee]
+                         -- No need to prune this if there's a shadowing binding
+                         -- because it's OK for it to be too big
 
 -- OccEncl is used to control whether to inline into constructor arguments
 -- For example:
@@ -1049,24 +1160,36 @@ type CtxtTy = [Bool]
         --                      the CtxtTy inside applies
 
 initOccEnv :: OccEnv
-initOccEnv = OccEnv OccRhs []
-
-vanillaCtxt :: OccEnv
-vanillaCtxt = OccEnv OccVanilla []
-
-rhsCtxt :: OccEnv
-rhsCtxt     = OccEnv OccRhs     []
+initOccEnv = OccEnv { occ_encl = OccRhs
+                   , occ_ctxt = []
+                   , occ_scrut_ids = emptyVarSet }
+
+vanillaCtxt :: OccEnv -> OccEnv
+vanillaCtxt env = OccEnv { occ_encl = OccVanilla, occ_ctxt = []
+                        , occ_scrut_ids = occ_scrut_ids env }
+
+rhsCtxt :: OccEnv -> OccEnv
+rhsCtxt env = OccEnv { occ_encl = OccRhs, occ_ctxt = []
+                    , occ_scrut_ids = occ_scrut_ids env }
+
+mkAltEnv :: OccEnv -> Maybe (Id, CoreExpr) -> OccEnv
+-- Does two things: a) makes the occ_ctxt = OccVanilla
+--                 b) extends the scrut_ids if necessary
+mkAltEnv env (Just (scrut_id, _))
+  | not (isLocalId scrut_id) 
+  = OccEnv { occ_encl      = OccVanilla
+          , occ_scrut_ids = extendVarSet (occ_scrut_ids env) scrut_id
+          , occ_ctxt      = occ_ctxt env }
+mkAltEnv env _
+  | isRhsEnv env = env { occ_encl = OccVanilla }
+  | otherwise    = env
+
+setCtxtTy :: OccEnv -> CtxtTy -> OccEnv
+setCtxtTy env ctxt = env { occ_ctxt = ctxt }
 
 isRhsEnv :: OccEnv -> Bool
-isRhsEnv (OccEnv OccRhs     _) = True
-isRhsEnv (OccEnv OccVanilla _) = False
-
-setVanillaCtxt :: OccEnv -> OccEnv
-setVanillaCtxt (OccEnv OccRhs ctxt_ty) = OccEnv OccVanilla ctxt_ty
-setVanillaCtxt other_env               = other_env
-
-setCtxt :: OccEnv -> CtxtTy -> OccEnv
-setCtxt (OccEnv encl _) ctxt = OccEnv encl ctxt
+isRhsEnv (OccEnv { occ_encl = OccRhs })     = True
+isRhsEnv (OccEnv { occ_encl = OccVanilla }) = False
 
 oneShotGroup :: OccEnv -> [CoreBndr] -> [CoreBndr]
         -- The result binders have one-shot-ness set that they might not have had originally.
@@ -1074,7 +1197,7 @@ oneShotGroup :: OccEnv -> [CoreBndr] -> [CoreBndr]
         -- linearity context knows that c,n are one-shot, and it records that fact in
         -- the binder. This is useful to guide subsequent float-in/float-out tranformations
 
-oneShotGroup (OccEnv _encl ctxt) bndrs
+oneShotGroup (OccEnv { occ_ctxt = ctxt }) bndrs
   = go ctxt bndrs []
   where
     go _ [] rev_bndrs = reverse rev_bndrs
@@ -1088,8 +1211,8 @@ oneShotGroup (OccEnv _encl ctxt) bndrs
     go ctxt (bndr:bndrs) rev_bndrs = go ctxt bndrs (bndr:rev_bndrs)
 
 addAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv
-addAppCtxt (OccEnv encl ctxt) args
-  = OccEnv encl (replicate (valArgCount args) True ++ ctxt)
+addAppCtxt env@(OccEnv { occ_ctxt = ctxt }) args
+  = env { occ_ctxt = replicate (valArgCount args) True ++ ctxt }
 \end{code}
 
 %************************************************************************
@@ -1174,9 +1297,10 @@ setBinderOcc usage bndr
 
 \begin{code}
 mkOneOcc :: OccEnv -> Id -> InterestingCxt -> UsageDetails
-mkOneOcc _env id int_cxt
+mkOneOcc env id int_cxt
   | isLocalId id = unitVarEnv id (OneOcc False True int_cxt)
-  | otherwise    = emptyDetails
+  | id `elemVarSet` occ_scrut_ids env = unitVarEnv id NoOccInfo
+  | otherwise                        = emptyDetails
 
 markMany, markInsideLam, markInsideSCC :: OccInfo -> OccInfo