Reduce boolean blindness in OccInfo(OneOcc) #17482

* Transformed the type aliases `InterestingCxt`, `InsideLam` and `OneBranch`
  into data types.
* Added Semigroup and Monoid instances for use in orOccInfo in OccurAnal.hs
* Simplified some usage sites by using pattern matching instead of boolean algebra.

Metric Increase:
    T12150

This increase was on a Mac-build of exactly 1%. This commit does *not* re-intruduce
the asymptotic memory usage described in T12150.

5 files changed, 86 insertions, 56 deletions

diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index 6e18180d1c..94e2d2daa8 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -67,9 +67,9 @@ module BasicTypes(
         isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,
         strongLoopBreaker, weakLoopBreaker,
 
-        InsideLam, insideLam, notInsideLam,
-        OneBranch, oneBranch, notOneBranch,
-        InterestingCxt,
+        InsideLam(..),
+        OneBranch(..),
+        InterestingCxt(..),
         TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,
         isAlwaysTailCalled,
 
@@ -119,6 +119,7 @@ import SrcLoc ( Located,unLoc )
 import Data.Data hiding (Fixity, Prefix, Infix)
 import Data.Function (on)
 import Data.Bits
+import qualified Data.Semigroup as Semi
 
 {-
 ************************************************************************
@@ -897,7 +898,6 @@ data OccInfo
   | IAmALoopBreaker { occ_rules_only :: !RulesOnly
                     , occ_tail       :: !TailCallInfo }
                         -- Note [LoopBreaker OccInfo]
-
   deriving (Eq)
 
 type RulesOnly = Bool
@@ -926,25 +926,52 @@ seqOccInfo occ = occ `seq` ()
 
 -----------------
 -- | Interesting Context
-type InterestingCxt = Bool      -- True <=> Function: is applied
-                                --          Data value: scrutinised by a case with
-                                --                      at least one non-DEFAULT branch
+data InterestingCxt
+  = IsInteresting
+    -- ^ Function: is applied
+    --   Data value: scrutinised by a case with at least one non-DEFAULT branch
+  | NotInteresting
+  deriving (Eq)
+
+-- | If there is any 'interesting' identifier occurance, then the
+-- aggregated occurance info of that identifier is considered interesting.
+instance Semi.Semigroup InterestingCxt where
+  IsInteresting <> _ = IsInteresting
+  _ <> IsInteresting = IsInteresting
+  _ <> _             = NotInteresting
+
+instance Monoid InterestingCxt where
+  mempty = NotInteresting
+  mappend = (Semi.<>)
 
 -----------------
 -- | Inside Lambda
-type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
-                        -- Substituting a redex for this occurrence is
-                        -- dangerous because it might duplicate work.
-insideLam, notInsideLam :: InsideLam
-insideLam    = True
-notInsideLam = False
+data InsideLam
+  = IsInsideLam
+    -- ^ Occurs inside a non-linear lambda
+    -- Substituting a redex for this occurrence is
+    -- dangerous because it might duplicate work.
+  | NotInsideLam
+  deriving (Eq)
+
+-- | If any occurance of an identifier is inside a lambda, then the
+-- occurance info of that identifier marks it as occuring inside a lambda
+instance Semi.Semigroup InsideLam where
+  IsInsideLam <> _ = IsInsideLam
+  _ <> IsInsideLam = IsInsideLam
+  _ <> _           = NotInsideLam
+
+instance Monoid InsideLam where
+  mempty = NotInsideLam
+  mappend = (Semi.<>)
 
 -----------------
-type OneBranch = Bool   -- True <=> Occurs in only one case branch
-                        --      so no code-duplication issue to worry about
-oneBranch, notOneBranch :: OneBranch
-oneBranch    = True
-notOneBranch = False
+data OneBranch
+  = InOneBranch
+    -- ^ One syntactic occurance: Occurs in only one case branch
+    -- so no code-duplication issue to worry about
+  | MultipleBranches
+  deriving (Eq)
 
 -----------------
 data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]
@@ -1005,15 +1032,15 @@ instance Outputable OccInfo where
           pp_ro | rule_only = char '!'
                 | otherwise = empty
   ppr (OneOcc inside_lam one_branch int_cxt tail_info)
-        = text "Once" <> pp_lam <> pp_br <> pp_args <> pp_tail
+        = text "Once" <> pp_lam inside_lam <> pp_br one_branch <> pp_args int_cxt <> pp_tail
         where
-          pp_lam | inside_lam = char 'L'
-                 | otherwise  = empty
-          pp_br  | one_branch = empty
-                 | otherwise  = char '*'
-          pp_args | int_cxt   = char '!'
-                  | otherwise = empty
-          pp_tail             = pprShortTailCallInfo tail_info
+          pp_lam IsInsideLam     = char 'L'
+          pp_lam NotInsideLam    = empty
+          pp_br MultipleBranches = char '*'
+          pp_br InOneBranch      = empty
+          pp_args IsInteresting  = char '!'
+          pp_args NotInteresting = empty
+          pp_tail                = pprShortTailCallInfo tail_info
 
 pprShortTailCallInfo :: TailCallInfo -> SDoc
 pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar)
diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs
index 8a59b98959..ab6e08974e 100644
--- a/compiler/basicTypes/IdInfo.hs
+++ b/compiler/basicTypes/IdInfo.hs
@@ -54,8 +54,7 @@ module IdInfo (
         isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
         occInfo, setOccInfo,
 
-        InsideLam, OneBranch,
-        insideLam, notInsideLam, oneBranch, notOneBranch,
+        InsideLam(..), OneBranch(..),
 
         TailCallInfo(..),
         tailCallInfo, isAlwaysTailCalled,
@@ -508,12 +507,12 @@ zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
   where
         -- The "unsafe" occ info is the ones that say I'm not in a lambda
         -- because that might not be true for an unsaturated lambda
-    is_safe_occ occ | isAlwaysTailCalled occ     = False
-    is_safe_occ (OneOcc { occ_in_lam = in_lam }) = in_lam
-    is_safe_occ _other                           = True
+    is_safe_occ occ | isAlwaysTailCalled occ           = False
+    is_safe_occ (OneOcc { occ_in_lam = NotInsideLam }) = False
+    is_safe_occ _other                                 = True
 
     safe_occ = case occ of
-                 OneOcc{} -> occ { occ_in_lam = True
+                 OneOcc{} -> occ { occ_in_lam = IsInsideLam
                                  , occ_tail   = NoTailCallInfo }
                  IAmALoopBreaker{}
                           -> occ { occ_tail   = NoTailCallInfo }
diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs
index a2eeb9beb8..4a0322f00c 100644
--- a/compiler/coreSyn/CoreOpt.hs
+++ b/compiler/coreSyn/CoreOpt.hs
@@ -418,11 +418,12 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst })
 
         -- Unconditionally safe to inline
     safe_to_inline :: OccInfo -> Bool
-    safe_to_inline (IAmALoopBreaker {}) = False
-    safe_to_inline IAmDead              = True
-    safe_to_inline occ@(OneOcc {})      =  not (occ_in_lam occ)
-                                        && occ_one_br occ
-    safe_to_inline (ManyOccs {})        = False
+    safe_to_inline IAmALoopBreaker{}                  = False
+    safe_to_inline IAmDead                            = True
+    safe_to_inline OneOcc{ occ_in_lam = NotInsideLam
+                         , occ_one_br = InOneBranch } = True
+    safe_to_inline OneOcc{}                           = False
+    safe_to_inline ManyOccs{}                         = False
 
 -------------------
 simple_out_bind :: TopLevelFlag
diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index ecad4a585f..d10b1eda22 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -1534,8 +1534,8 @@ occAnalNonRecRhs env bndr bndrs body
 
     certainly_inline -- See Note [Cascading inlines]
       = case occ of
-          OneOcc { occ_in_lam = in_lam, occ_one_br = one_br }
-            -> not in_lam && one_br && active && not_stable
+          OneOcc { occ_in_lam = NotInsideLam, occ_one_br = InOneBranch }
+            -> active && not_stable
           _ -> False
 
     is_join_point = isAlwaysTailCalled occ
@@ -1783,7 +1783,7 @@ occAnal env (Case scrut bndr ty alts)
 
     occ_anal_scrut (Var v) (alt1 : other_alts)
         | not (null other_alts) || not (isDefaultAlt alt1)
-        = (mkOneOcc env v True 0, Var v)
+        = (mkOneOcc env v IsInteresting 0, Var v)
             -- The 'True' says that the variable occurs in an interesting
             -- context; the case has at least one non-default alternative
     occ_anal_scrut (Tick t e) alts
@@ -1861,7 +1861,7 @@ occAnalApp env (Var fun, args, ticks)
 
     n_val_args = valArgCount args
     n_args     = length args
-    fun_uds    = mkOneOcc env fun (n_val_args > 0) n_args
+    fun_uds    = mkOneOcc env fun (if n_val_args > 0 then IsInteresting else NotInteresting) n_args
     is_exp     = isExpandableApp fun n_val_args
         -- See Note [CONLIKE pragma] in BasicTypes
         -- The definition of is_exp should match that in Simplify.prepareRhs
@@ -2475,8 +2475,8 @@ andUDsList = foldl' andUDs emptyDetails
 mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails
 mkOneOcc env id int_cxt arity
   | isLocalId id
-  = singleton $ OneOcc { occ_in_lam  = False
-                       , occ_one_br  = True
+  = singleton $ OneOcc { occ_in_lam  = NotInsideLam
+                       , occ_one_br  = InOneBranch
                        , occ_int_cxt = int_cxt
                        , occ_tail    = AlwaysTailCalled arity }
   | id `elemVarSet` occ_gbl_scrut env
@@ -2855,7 +2855,7 @@ markMany, markInsideLam, markNonTailCalled :: OccInfo -> OccInfo
 markMany IAmDead = IAmDead
 markMany occ     = ManyOccs { occ_tail = occ_tail occ }
 
-markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = True }
+markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = IsInsideLam }
 markInsideLam occ             = occ
 
 markNonTailCalled IAmDead = IAmDead
@@ -2876,9 +2876,9 @@ orOccInfo (OneOcc { occ_in_lam = in_lam1, occ_int_cxt = int_cxt1
                   , occ_tail   = tail1 })
           (OneOcc { occ_in_lam = in_lam2, occ_int_cxt = int_cxt2
                   , occ_tail   = tail2 })
-  = OneOcc { occ_one_br  = False -- False, because it occurs in both branches
-           , occ_in_lam  = in_lam1 || in_lam2
-           , occ_int_cxt = int_cxt1 && int_cxt2
+  = OneOcc { occ_one_br  = MultipleBranches -- because it occurs in both branches
+           , occ_in_lam  = in_lam1 `mappend` in_lam2
+           , occ_int_cxt = int_cxt1 `mappend` int_cxt2
            , occ_tail    = tail1 `andTailCallInfo` tail2 }
 
 orOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index e8829c845c..6074d00aa9 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -1158,12 +1158,12 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
     extend_subst_with inl_rhs = extendIdSubst env bndr (mkContEx rhs_env inl_rhs)
 
     one_occ IAmDead = True -- Happens in ((\x.1) v)
-    one_occ (OneOcc { occ_one_br = True      -- One textual occurrence
-                    , occ_in_lam = in_lam
-                    , occ_int_cxt = int_cxt })
-        | not in_lam = isNotTopLevel top_lvl || early_phase
-        | otherwise  = int_cxt && canInlineInLam rhs
-    one_occ _        = False
+    one_occ OneOcc{ occ_one_br = InOneBranch
+                  , occ_in_lam = NotInsideLam }   = isNotTopLevel top_lvl || early_phase
+    one_occ OneOcc{ occ_one_br = InOneBranch
+                  , occ_in_lam = IsInsideLam
+                  , occ_int_cxt = IsInteresting } = canInlineInLam rhs
+    one_occ _                                     = False
 
     pre_inline_unconditionally = gopt Opt_SimplPreInlining (seDynFlags env)
     mode   = getMode env
@@ -1297,7 +1297,7 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs
                         -- PRINCIPLE: when we've already simplified an expression once,
                         -- make sure that we only inline it if it's reasonably small.
 
-           && (not in_lam ||
+           && (in_lam == NotInsideLam ||
                         -- Outside a lambda, we want to be reasonably aggressive
                         -- about inlining into multiple branches of case
                         -- e.g. let x = <non-value>
@@ -1306,7 +1306,7 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs
                         -- the uses in C1, C2 are not 'interesting'
                         -- An example that gets worse if you add int_cxt here is 'clausify'
 
-                (isCheapUnfolding unfolding && int_cxt))
+                (isCheapUnfolding unfolding && int_cxt == IsInteresting))
                         -- isCheap => acceptable work duplication; in_lam may be true
                         -- int_cxt to prevent us inlining inside a lambda without some
                         -- good reason.  See the notes on int_cxt in preInlineUnconditionally
@@ -2251,7 +2251,10 @@ mkCase3 _dflags scrut bndr alts_ty alts
 -- InIds, so it's crucial that isExitJoinId is only called on freshly
 -- occ-analysed code. It's not a generic function you can call anywhere.
 isExitJoinId :: Var -> Bool
-isExitJoinId id = isJoinId id && isOneOcc (idOccInfo id) && occ_in_lam (idOccInfo id)
+isExitJoinId id
+  = isJoinId id
+  && isOneOcc (idOccInfo id)
+  && occ_in_lam (idOccInfo id) == IsInsideLam
 
 {-
 Note [Dead binders]