[Git][ghc/ghc][wip/par-simpl] Comments
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Nov 16 16:35:14 UTC 2022
Matthew Pickering pushed to branch wip/par-simpl at Glasgow Haskell Compiler / GHC
Commits:
270f43ee by Matthew Pickering at 2022-11-16T16:35:06+00:00
Comments
- - - - -
3 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Types/Var/Env.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -267,7 +267,8 @@ simplScc (should_trace, env0, our_binders) deps b = {-# SCC simplScc #-} do
- -- construct
+ -- Do something to rename local binders to avoid name clashes.
+ -- MP: I don't understand how this works, code was written by Doug
(subst, !new_binds) <- getUniqueSupplyM <&> \us -> initUs_ us . mfix $ \ ~(subst_rec,_) -> let
go_id :: Subst -> Id -> UniqSM (Subst, Id)
go_id s i = do
@@ -304,9 +305,12 @@ simplScc (should_trace, env0, our_binders) deps b = {-# SCC simplScc #-} do
pure (floats2, setInScopeFromF env2 floats2)
+-- | Quotient a core program graph by creating regular sized groups in topological order. The result is a new
+-- quotiented graph with groups of the specified size.
simple_group_binds :: Int -> ([(Int, InBind)], M.Map Int [Int]) -> ([(Int, [InBind])], M.Map Int [Int])
simple_group_binds n (nodes, edges) = finalise (loop n 0 nodes IM.empty)
where
+ -- This part performs the edge quotient.
finalise :: IM.IntMap [(Int, InBind)] -> ([(Int, [InBind])], M.Map Int [Int])
finalise im = let im' = IM.toList im in (map (\(k,v) -> (k, reverse $ map snd v)) im', deps_map)
@@ -323,7 +327,7 @@ simple_group_binds n (nodes, edges) = finalise (loop n 0 nodes IM.empty)
deps_for :: Int -> Set.Set Int
deps_for b = Set.map rev_mapping (Set.fromList (edges M.! b))
-
+ -- This creates the binding groups.
loop k new_group_id im acc =
case im of
-- Finished
@@ -353,11 +357,14 @@ simplTopBinds group_size env0 in_binds --(binds0, g)
1 -> unSM (simpl_binds env1 (map snd (fst in_binds))) te sc
_ -> do
let my_binds = mkUniqSet [lookupRecBndr env1 x | x <- bindersOfBinds (concatMap snd binds0)]
+ -- Create a result variable for each binding group
env_m_vars <- liftIO $ M.fromList <$> (sequence [(k,) <$> newEmptyMVar | (k,_) <- binds0])
+ -- Control the amount of parrelism with a semaphore
sem <- newQSem (te_simpl_threads $ st_config te)
let zero_sc = zeroSimplCount' $ hasDetailedCounts sc
let work :: [IO ()]
work = map (mk_work sem (False, env1, my_binds) env_m_vars te zero_sc) grouped_binds
+ -- Spawn each group into a separate thread
mapM_ forkIO work
let res_vars = M.elems env_m_vars
@@ -384,9 +391,13 @@ simplTopBinds group_size env0 in_binds --(binds0, g)
mk_work sem env1 deps te sc0 (k, b) = do
rs <- for [x | di <- Set.toList (Set.fromList (g M.! k)), di /= k, Just x <- [M.lookup di deps]] readMVar
+ -- Wait for dependencies to finish
let my_var = fromJust (M.lookup k deps)
+ -- Wait for a semaphore slot
bracket_ (waitQSem sem) (signalQSem sem) $ do
+ -- Simplify the group
((f,e),sc) <- unSM (simplScc env1 rs b) te sc0
+ -- Put the result into the result variable
putMVar my_var (f, e, sc)
@@ -410,41 +421,6 @@ simpl_bind env (NonRec b r)
; (env', b') <- addBndrRules env b (lookupRecBndr env b) bind_cxt
; simplRecOrTopPair env' bind_cxt b b' r }
-{-
-simplTopBinds :: SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)
--- See Note [The big picture]
-simplTopBinds env0 binds0
- = do { -- Put all the top-level binders into scope at the start
- -- so that if a rewrite rule has unexpectedly brought
- -- anything into scope, then we don't get a complaint about that.
- -- It's rather as if the top-level binders were imported.
- -- See Note [Glomming] in "GHC.Core.Opt.OccurAnal".
- -- See Note [Bangs in the Simplifier]
- ; !env1 <- {-#SCC "simplTopBinds-simplRecBndrs" #-} simplRecBndrs env0 (bindersOfBinds binds0)
- ; (floats, env2) <- {-#SCC "simplTopBinds-simpl_binds" #-} simpl_binds env1 binds0
- ; freeTick SimplifierDone
- ; return (floats, env2) }
- where
- -- We need to track the zapped top-level binders, because
- -- they should have their fragile IdInfo zapped (notably occurrence info)
- -- That's why we run down binds and bndrs' simultaneously.
- --
- simpl_binds :: SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)
- simpl_binds env [] = return (emptyFloats env, env)
- simpl_binds env (bind:binds) = do { (float, env1) <- simpl_bind env bind
- ; (floats, env2) <- simpl_binds env1 binds
- -- See Note [Bangs in the Simplifier]
- ; let !floats1 = float `addFloats` floats
- ; return (floats1, env2) }
-
- simpl_bind env (Rec pairs)
- = simplRecBind env (BC_Let TopLevel Recursive) pairs
- simpl_bind env (NonRec b r)
- = do { let bind_cxt = BC_Let TopLevel NonRecursive
- ; (env', b') <- addBndrRules env b (lookupRecBndr env b) bind_cxt
- ; simplRecOrTopPair env' bind_cxt b b' r }
- -}
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Core/Subst.hs
=====================================
@@ -508,6 +508,8 @@ substUnfolding _ subst df@(DFunUnfolding { df_bndrs = bndrs, df_args = args })
(subst',bndrs') = substBndrs subst bndrs
args' = map (substExpr subst') args
+-- MP: These is a hack here atm because we rename local bindings after simplication is finished and need
+-- to reflect these changes into the stable unfoldings.
substUnfolding hack subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_src = src })
-- Retain stable unfoldings
| not (isStableSource src) -- Zap an unstable unfolding, to save substitution work
=====================================
compiler/GHC/Types/Var/Env.hs
=====================================
@@ -109,6 +109,9 @@ import GHC.Utils.Outputable
--
-- "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides
-- the motivation for this abstraction.
+-- The InScopeSet is a pair of (Var, Int) to track how many times variables in the
+-- InScopeSet have been updated, so that if we union two InScopeSets together we know
+-- to choose the updated variables.
newtype InScopeSet = InScope (VarEnv (Var, Int))
-- Note [Lookups in in-scope set]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/270f43ee369b56dc77f3ad0cf89628336ecbc124
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/270f43ee369b56dc77f3ad0cf89628336ecbc124
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/20221116/addcadaf/attachment-0001.html>
More information about the ghc-commits
mailing list