[Git][ghc/ghc][wip/T22404] Wibbles
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Thu Jul 13 10:58:19 UTC 2023
Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC
Commits:
c12834a9 by Simon Peyton Jones at 2023-07-13T11:57:30+01:00
Wibbles
- - - - -
2 changed files:
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Types/Basic.hs
Changes:
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -2944,8 +2944,8 @@ mkZeroedForm (UD { ud_env = rhs_occs })
= emptyDetails { ud_env = mapMaybeUFM do_one rhs_occs }
where
do_one :: LocalOcc -> Maybe LocalOcc
- do_one ManyOccL = Nothing
- do_one (OneOccL _ ic) = Just (OneOccL 0 ic)
+ do_one ManyOccL = Nothing
+ do_one occ@(OneOccL {}) = Just (occ { lo_n_br = 0 })
--------------------
transClosureFV :: VarEnv VarSet -> VarEnv VarSet
@@ -3369,7 +3369,9 @@ info then simply means setting the corresponding zapped set to the whole
type OccInfoEnv = IdEnv LocalOcc -- A finite map from an expression's
-- free variables to their usage
-data LocalOcc = OneOccL {-# UNPACK #-} !Int !InterestingCxt
+data LocalOcc = OneOccL { lo_n_br :: {-# UNPACK #-} !Int
+ , lo_tail :: {-# UNPACK #-} !TailCallInfo
+ , lo_int_cxt :: !InterestingCxt }
| ManyOccL
type ZappedSet = OccInfoEnv -- Values are ignored
@@ -3378,9 +3380,9 @@ data UsageDetails
= UD { ud_env :: !OccInfoEnv
, ud_z_many :: !ZappedSet -- apply 'markMany' to these
, ud_z_in_lam :: !ZappedSet -- apply 'markInsideLam' to these
- , ud_tail :: !(IdEnv TailCallInfo)
+ , ud_z_tail :: !ZappedSet
}
- -- INVARIANT: Both zapped sets are subsets of ud_env
+ -- INVARIANT: All three zapped sets are subsets of ud_env
instance Outputable UsageDetails where
ppr ud = text "UD" <+> (braces $ fsep $ punctuate comma $
@@ -3429,9 +3431,9 @@ mkOneOcc !env id int_cxt arity
= one_occ_uds
where
- one_occ_uds = emptyDetails
- { ud_env = unitVarEnv id (OneOccL 1 int_cxt)
- , ud_tail = unitVarEnv id (AlwaysTailCalled arity) }
+ occ = OneOccL { lo_n_br = 1, lo_int_cxt = int_cxt
+ , lo_tail = AlwaysTailCalled arity }
+ one_occ_uds = emptyDetails { ud_env = unitVarEnv id occ }
addManyOccId :: UsageDetails -> Id -> UsageDetails
-- Add the non-committal (id :-> noOccInfo) to the usage details
@@ -3464,7 +3466,7 @@ emptyDetails :: UsageDetails
emptyDetails = UD { ud_env = emptyVarEnv
, ud_z_many = emptyVarEnv
, ud_z_in_lam = emptyVarEnv
- , ud_tail = emptyVarEnv }
+ , ud_z_tail = emptyVarEnv }
isEmptyDetails :: UsageDetails -> Bool
isEmptyDetails = isEmptyVarEnv . ud_env
@@ -3474,17 +3476,17 @@ delDetails :: UsageDetails -> [Id] -> UsageDetails
delDetails (UD { ud_env = env
, ud_z_many = z_many
, ud_z_in_lam = z_in_lam
- , ud_tail = tail }) bndrs
+ , ud_z_tail = z_tail }) bndrs
= UD { ud_env = env `delVarEnvList` bndrs
, ud_z_many = z_many `delVarEnvList` bndrs
, ud_z_in_lam = z_in_lam `delVarEnvList` bndrs
- , ud_tail = tail `delVarEnvList` bndrs }
+ , ud_z_tail = z_tail `delVarEnvList` bndrs }
markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail
:: UsageDetails -> UsageDetails
-markAllMany ud = ud { ud_z_many = ud_env ud }
-markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud }
-markAllNonTail ud = ud { ud_tail = emptyVarEnv }
+markAllMany ud@(UD { ud_env = env }) = ud { ud_z_many = env }
+markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env }
+markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = env }
markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo
markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails
@@ -3532,7 +3534,7 @@ combineUsageDetailsWith plus_occ_info ud1 ud2
= UD { ud_env = plusVarEnv_C plus_occ_info (ud_env ud1) (ud_env ud2)
, ud_z_many = plusVarEnv (ud_z_many ud1) (ud_z_many ud2)
, ud_z_in_lam = plusVarEnv (ud_z_in_lam ud1) (ud_z_in_lam ud2)
- , ud_tail = plusVarEnv_C andTailCallInfo (ud_tail ud1) (ud_tail ud2) }
+ , ud_z_tail = plusVarEnv (ud_z_tail ud1) (ud_z_tail ud2) }
mkOccInfo :: UsageDetails -> Var -> LocalOcc -> OccInfo
mkOccInfo ud var occ = mkOccInfoByUnique ud (varUnique var) occ
@@ -3540,26 +3542,26 @@ mkOccInfo ud var occ = mkOccInfoByUnique ud (varUnique var) occ
mkOccInfoByUnique :: UsageDetails -> Unique -> LocalOcc -> OccInfo
mkOccInfoByUnique (UD { ud_z_many = z_many
, ud_z_in_lam = z_in_lam
- , ud_tail = tail_env })
+ , ud_z_tail = z_tail })
uniq occ
= case occ of
- OneOccL n_br int_cxt
+ OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt
+ , lo_tail = occ_tail }
| not (uniq `elemVarEnvByKey`z_many)
-> OneOcc { occ_in_lam = in_lam
, occ_n_br = n_br
, occ_int_cxt = int_cxt
, occ_tail = tail }
+ where
+ tail | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo
+ | otherwise = occ_tail
- _other -- ManyOccL and zapped OneOccL
- -> ManyOccs { occ_tail = tail }
-
- where
- tail = case lookupVarEnv_Directly tail_env uniq of
- Nothing -> NoTailCallInfo
- Just tc -> tc
+ in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam
+ | otherwise = NotInsideLam
- in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam
- | otherwise = NotInsideLam
+ _other -- ManyOccL and zapped OneOccL
+ -> ManyOccs { occ_tail = NoTailCallInfo }
+ -- I think this is redundant; remove from ManyOccs
-------------------
-- See Note [Adjusting right-hand sides]
@@ -3851,9 +3853,11 @@ andOccInfo _ _ = ManyOccL
-- (orOccInfo orig new) is used
-- when combining occurrence info from branches of a case
-orOccInfo (OneOccL nbr1 int_cxt1) (OneOccL nbr2 int_cxt2)
- = OneOccL (nbr1 + nbr2) (int_cxt1 `mappend` int_cxt2)
-
+orOccInfo (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = ar1 })
+ (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = ar2 })
+ = OneOccL { lo_n_br = nbr1 + nbr2
+ , lo_int_cxt = int_cxt1 `mappend` int_cxt2
+ , lo_tail = ar1 `andTailCallInfo` ar2 }
orOccInfo _ _ = ManyOccL
andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -1068,8 +1068,9 @@ instance Monoid InsideLam where
mappend = (Semi.<>)
-----------------
-data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]
- | NoTailCallInfo
+data TailCallInfo
+ = AlwaysTailCalled {-# UNPACK #-} !JoinArity -- See Note [TailCallInfo]
+ | NoTailCallInfo
deriving (Eq)
tailCallInfo :: OccInfo -> TailCallInfo
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c12834a91a7c18b525779b14b0f48a1a76085eb2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c12834a91a7c18b525779b14b0f48a1a76085eb2
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230713/31cd9626/attachment-0001.html>
More information about the ghc-commits
mailing list