[Git][ghc/ghc][wip/romes/12935] 2 commits: Revert "Undo a bit more NonDet LblMap"
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Tue Jul 9 13:47:59 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
15bd7255 by Rodrigo Mesquita at 2024-07-09T11:13:32+01:00
Revert "Undo a bit more NonDet LblMap"
This reverts commit f526e1aee078712a5ae611d73fe90afa5e5095cb.
- - - - -
dba04972 by Rodrigo Mesquita at 2024-07-09T11:13:37+01:00
Revert "Make FactBase deterministic again"
This reverts commit 315f05c001f41cf27b75870aa60d55f15a725421.
- - - - -
8 changed files:
- compiler/GHC/Cmm/Dataflow.hs
- compiler/GHC/Cmm/Dataflow/Label.hs
- compiler/GHC/Cmm/Dataflow/Label/NonDet.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/LayoutStack.hs
- compiler/GHC/Cmm/Liveness.hs
- compiler/GHC/Cmm/ProcPoint.hs
- compiler/GHC/Cmm/Sink.hs
Changes:
=====================================
compiler/GHC/Cmm/Dataflow.hs
=====================================
@@ -43,8 +43,9 @@ import Data.Kind (Type)
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
-import GHC.Cmm.Dataflow.Label
+import GHC.Cmm.Dataflow.Label (LabelMap)
import qualified GHC.Cmm.Dataflow.Label as Det
+import GHC.Cmm.Dataflow.Label.NonDet hiding (LabelMap)
type family Fact (x :: Extensibility) f :: Type
type instance Fact C f = FactBase f
@@ -157,7 +158,7 @@ fixpointAnalysis direction lattice do_block entry blockmap = loop start
-- information in fbase1 and (if something changed) we update it
-- and add the affected blocks to the worklist.
(todo2, fbase2) = {-# SCC "mapFoldWithKey" #-}
- Det.mapFoldlWithKey
+ nonDetMapFoldlWithKey
(updateFact join dep_blocks) (todo1, fbase1) out_facts
in loop todo2 fbase2
loop _ !fbase1 = fbase1
@@ -230,7 +231,7 @@ fixpointRewrite dir lattice do_block entry blockmap = loop start blockmap
do_block block fbase1
let blocks2 = Det.mapInsert (entryLabel new_block) new_block blocks1
(todo2, fbase2) = {-# SCC "mapFoldWithKey_rewrite" #-}
- Det.mapFoldlWithKey
+ nonDetMapFoldlWithKey
(updateFact join dep_blocks) (todo1, fbase1) out_facts
loop todo2 blocks2 fbase2
loop _ !blocks1 !fbase1 = return (blocks1, fbase1)
=====================================
compiler/GHC/Cmm/Dataflow/Label.hs
=====================================
@@ -11,8 +11,6 @@ module GHC.Cmm.Dataflow.Label
, LabelMap
, LabelSet
, mkHooplLabel
- , FactBase
- , lookupFact
-- * Set
, setEmpty
, setNull
@@ -296,10 +294,3 @@ instance TrieMap LabelMap where
foldTM k m z = mapFoldr k z m
filterTM f m = mapFilter f m
------------------------------------------------------------------------------
--- FactBase
-
-type FactBase f = LabelMap f
-
-lookupFact :: Label -> FactBase f -> Maybe f
-lookupFact = mapLookup
=====================================
compiler/GHC/Cmm/Dataflow/Label/NonDet.hs
=====================================
@@ -22,6 +22,8 @@ module GHC.Cmm.Dataflow.Label.NonDet
( Label
, LabelMap
, LabelSet
+ , FactBase
+ , lookupFact
, mkHooplLabel
-- * Set
, setEmpty
@@ -286,3 +288,10 @@ instance OutputableP env a => OutputableP env (LabelMap a) where
-- foldTM k m z = mapFoldr k z m -- TODO:ERROR?
-- filterTM f m = mapFilter f m
+-----------------------------------------------------------------------------
+-- FactBase
+
+type FactBase f = LabelMap f
+
+lookupFact :: Label -> FactBase f -> Maybe f
+lookupFact = mapLookup
=====================================
compiler/GHC/Cmm/Info/Build.hs
=====================================
@@ -27,6 +27,8 @@ import GHC.Cmm.Config
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
+import GHC.Cmm.Dataflow.Label.NonDet (lookupFact)
+import qualified GHC.Cmm.Dataflow.Label.NonDet as NonDet
import GHC.Cmm.Dataflow
import GHC.Unit.Module
import GHC.Data.Graph.Directed
@@ -536,7 +538,7 @@ newtype CAFfyLabel = CAFfyLabel CLabel
deriving newtype instance OutputableP env CLabel => OutputableP env CAFfyLabel
type CAFSet = Set CAFfyLabel
-type CAFEnv = LabelMap CAFSet
+type CAFEnv = NonDet.LabelMap CAFSet
-- | Records the CAFfy references of a set of static data decls.
type DataCAFEnv = Map CLabel CAFSet
@@ -603,7 +605,7 @@ cafAnal
-> CAFEnv
cafAnal platform contLbls topLbl cmmGraph =
analyzeCmmBwd cafLattice
- (cafTransfers platform contLbls (g_entry cmmGraph) topLbl) cmmGraph mapEmpty
+ (cafTransfers platform contLbls (g_entry cmmGraph) topLbl) cmmGraph NonDet.mapEmpty
cafLattice :: DataflowLattice CAFSet
@@ -663,7 +665,7 @@ cafTransfers platform contLbls entry topLbl
text "topLbl:" <+> pdoc platform topLbl $$
text "cafs in exit:" <+> pdoc platform joined $$
text "result:" <+> pdoc platform result) $
- mapSingleton (entryLabel eNode) result
+ NonDet.mapSingleton (entryLabel eNode) result
-- -----------------------------------------------------------------------------
@@ -779,7 +781,7 @@ depAnalSRTs platform cafEnv cafEnv_static decls =
| (l, lbl) <- labelledBlocks
, Just (cafs :: Set CAFfyLabel) <-
[case l of
- BlockLabel l -> mapLookup l cafEnv
+ BlockLabel l -> NonDet.mapLookup l cafEnv
DeclLabel cl -> Map.lookup cl cafEnv_static]
, let cafs' = Set.delete lbl cafs
]
@@ -814,7 +816,7 @@ getCAFs platform cafEnv = mapMaybe getCAFLabel
| Just info <- mapLookup (g_entry g) (info_tbls top_info)
, let rep = cit_rep info
, isStaticRep rep && isThunkRep rep
- , Just cafs <- mapLookup (g_entry g) cafEnv
+ , Just cafs <- NonDet.mapLookup (g_entry g) cafEnv
= Just (Just (g_entry g), mkCAFfyLabel platform top_lbl, cafs)
| otherwise
@@ -907,7 +909,7 @@ doSRTs cfg moduleSRTInfo dus procs data_ = do
CmmStaticsRaw lbl _ -> (lbl, set)
(proc_envs, procss) = unzip procs
- cafEnv = mapUnions proc_envs -- ToDo: May be more expensive now with LabelMap
+ cafEnv = NonDet.mapUnions proc_envs
decls = map (cmmDataDeclCmmDecl . snd) data_ ++ concat procss
staticFuns = mapFromList (getStaticFuns decls)
=====================================
compiler/GHC/Cmm/LayoutStack.hs
=====================================
@@ -263,7 +263,7 @@ cmmLayoutStack cfg procpoints entry_args
layout :: CmmConfig
-> LabelSet -- proc points
- -> LabelMap CmmLocalLive -- liveness
+ -> NonDet.LabelMap CmmLocalLive -- liveness
-> BlockId -- entry
-> ByteOff -- stack args on entry
@@ -439,7 +439,7 @@ getStackLoc (Young l) n stackmaps =
-- extra code that goes *after* the Sp adjustment.
handleLastNode
- :: CmmConfig -> ProcPointSet -> LabelMap CmmLocalLive -> LabelMap ByteOff
+ :: CmmConfig -> ProcPointSet -> NonDet.LabelMap CmmLocalLive -> LabelMap ByteOff
-> NonDet.LabelMap StackMap -> StackMap -> CmmTickScope
-> Block CmmNode O O
-> CmmNode O C
@@ -571,7 +571,7 @@ handleLastNode cfg procpoints liveness cont_info stackmaps
-- the destination, because this StackMap might be used
-- by fixupStack if this is a join point.
| otherwise = return (l, l, stack1, [])
- where live = mapFindWithDefault (panic "handleBranch") l liveness
+ where live = NonDet.mapFindWithDefault (panic "handleBranch") l liveness
stack1 = stack0 { sm_regs = filterUFM is_live (sm_regs stack0) }
is_live (r,_) = r `elemRegSet` live
@@ -620,7 +620,7 @@ fixupStack old_stack new_stack = concatMap move new_locs
setupStackFrame
:: Platform
-> BlockId -- label of continuation
- -> LabelMap CmmLocalLive -- liveness
+ -> NonDet.LabelMap CmmLocalLive -- liveness
-> ByteOff -- updfr
-> ByteOff -- bytes of return values on stack
-> StackMap -- current StackMap
@@ -630,7 +630,7 @@ setupStackFrame platform lbl liveness updfr_off ret_args stack0
= (cont_stack, assignments)
where
-- get the set of LocalRegs live in the continuation
- live = mapFindWithDefault Set.empty lbl liveness
+ live = NonDet.mapFindWithDefault Set.empty lbl liveness
-- the stack from the base to updfr_off is off-limits.
-- our new stack frame contains:
@@ -1058,7 +1058,7 @@ insertReloadsAsNeeded
-> UniqDSM [CmmBlock]
insertReloadsAsNeeded platform procpoints final_stackmaps entry blocks =
toBlockList . fst <$>
- rewriteCmmBwd liveLattice rewriteCC (ofBlockList entry blocks) mapEmpty
+ rewriteCmmBwd liveLattice rewriteCC (ofBlockList entry blocks) NonDet.mapEmpty
where
rewriteCC :: RewriteFun CmmLocalLive
rewriteCC (BlockCC e_node middle0 x_node) fact_base0 = do
@@ -1085,7 +1085,7 @@ insertReloadsAsNeeded platform procpoints final_stackmaps entry blocks =
= (middle0, live_at_middle0)
-- Final liveness for this block.
- !fact_base2 = mapSingleton entry_label live_with_reloads
+ !fact_base2 = NonDet.mapSingleton entry_label live_with_reloads
return (BlockCC e_node middle1 x_node, fact_base2)
=====================================
compiler/GHC/Cmm/Liveness.hs
=====================================
@@ -19,7 +19,7 @@ import GHC.Cmm.BlockId
import GHC.Cmm
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow
-import GHC.Cmm.Dataflow.Label
+import GHC.Cmm.Dataflow.Label.NonDet
import GHC.Cmm.LRegSet
import GHC.Data.Maybe
=====================================
compiler/GHC/Cmm/ProcPoint.hs
=====================================
@@ -29,6 +29,7 @@ import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
+import qualified GHC.Cmm.Dataflow.Label.NonDet as NonDet
-- Compute a minimal set of proc points for a control-flow graph.
@@ -134,7 +135,7 @@ instance Outputable Status where
-- Once you know what the proc-points are, figure out
-- what proc-points each block is reachable from
-- See Note [Proc-point analysis]
-procPointAnalysis :: ProcPointSet -> CmmGraph -> LabelMap Status
+procPointAnalysis :: ProcPointSet -> CmmGraph -> NonDet.LabelMap Status
procPointAnalysis procPoints cmmGraph@(CmmGraph {g_graph = graph}) =
analyzeCmmFwd procPointLattice procPointTransfer cmmGraph initProcPoints
where
@@ -196,14 +197,14 @@ extendPPSet
extendPPSet platform g blocks procPoints =
let env = procPointAnalysis procPoints g
add pps block = let id = entryLabel block
- in case mapLookup id env of
+ in case NonDet.mapLookup id env of
Just ProcPoint -> setInsert id pps
_ -> pps
procPoints' = foldlGraphBlocks add setEmpty g
newPoints = mapMaybe ppSuccessor blocks
newPoint = listToMaybe newPoints
ppSuccessor b =
- let nreached id = case mapLookup id env `orElse`
+ let nreached id = case NonDet.mapLookup id env `orElse`
pprPanic "no ppt" (ppr id <+> pdoc platform b) of
ProcPoint -> 1
ReachedBy ps -> setSize ps
@@ -235,7 +236,7 @@ extendPPSet platform g blocks procPoints =
-- Input invariant: A block should only be reachable from a single ProcPoint.
-- ToDo: use the _ret naming convention that the old code generator
-- used. -- EZY
-splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> CmmDecl
+splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> NonDet.LabelMap Status -> CmmDecl
-> UniqDSM [CmmDecl]
splitAtProcPoints _ _ _ _ _ t@(CmmData _ _) = return [t]
splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
@@ -249,7 +250,7 @@ splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
let add_block :: LabelMap (LabelMap CmmBlock) -> CmmBlock -> LabelMap (LabelMap CmmBlock)
add_block graphEnv b =
- case mapLookup bid procMap of
+ case NonDet.mapLookup bid procMap of
Just ProcPoint -> add graphEnv bid bid b
Just (ReachedBy set) ->
case setElems set of
@@ -263,7 +264,7 @@ splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
let liveness = cmmGlobalLiveness platform g
let ppLiveness pp = filter isArgReg $ regSetToList $
- expectJust "ppLiveness" $ mapLookup pp liveness
+ expectJust "ppLiveness" $ NonDet.mapLookup pp liveness
graphEnv <- return $ foldlGraphBlocks add_block mapEmpty g
-- Build a map from proc point BlockId to pairs of:
=====================================
compiler/GHC/Cmm/Sink.hs
=====================================
@@ -14,8 +14,7 @@ import GHC.Cmm.Liveness
import GHC.Cmm.LRegSet
import GHC.Cmm.Utils
import GHC.Cmm.Dataflow.Block
-import GHC.Cmm.Dataflow.Label (mapFindWithDefault)
-import qualified GHC.Cmm.Dataflow.Label.NonDet as NonDet
+import GHC.Cmm.Dataflow.Label.NonDet
import GHC.Cmm.Dataflow.Graph
import GHC.Platform.Regs
@@ -154,7 +153,7 @@ type Assignments = [Assignment]
-- x = e1
cmmSink :: CmmConfig -> CmmGraph -> UniqDSM CmmGraph
-cmmSink cfg graph = ofBlockList (g_entry graph) <$> sink NonDet.mapEmpty blocks
+cmmSink cfg graph = ofBlockList (g_entry graph) <$> sink mapEmpty blocks
where
platform = cmmPlatform cfg
liveness = cmmLocalLivenessL platform graph
@@ -164,13 +163,13 @@ cmmSink cfg graph = ofBlockList (g_entry graph) <$> sink NonDet.mapEmpty blocks
join_pts = findJoinPoints blocks
- sink :: NonDet.LabelMap Assignments -> [CmmBlock] -> UniqDSM [CmmBlock]
+ sink :: LabelMap Assignments -> [CmmBlock] -> UniqDSM [CmmBlock]
sink _ [] = pure []
sink sunk (b:bs) = do
-- Now sink and inline in this block
(prepend, last_fold) <- runOpt cfg $ constantFoldNode last
- (middle', assigs) <- walk cfg (ann_middles ++ annotate platform live_middle prepend) (NonDet.mapFindWithDefault [] lbl sunk)
+ (middle', assigs) <- walk cfg (ann_middles ++ annotate platform live_middle prepend) (mapFindWithDefault [] lbl sunk)
let (final_last, assigs') = tryToInline platform live last_fold assigs
-- Now, drop any assignments that we will not sink any further.
@@ -193,10 +192,9 @@ cmmSink cfg graph = ofBlockList (g_entry graph) <$> sink NonDet.mapEmpty blocks
final_middle = foldl' blockSnoc middle' dropped_last
- sunk' = NonDet.mapUnion sunk $
- NonDet.mapFromList
- [ (l, filterAssignments platform (getLive l) assigs'')
- | l <- succs ]
+ sunk' = mapUnion sunk $
+ mapFromList [ (l, filterAssignments platform (getLive l) assigs'')
+ | l <- succs ]
(blockJoin first final_middle final_last :) <$> sink sunk' bs
@@ -216,7 +214,7 @@ cmmSink cfg graph = ofBlockList (g_entry graph) <$> sink NonDet.mapEmpty blocks
-- We cannot sink into join points (successors with more than
-- one predecessor), so identify the join points and the set
-- of registers live in them.
- (joins, nonjoins) = partition (`NonDet.mapMember` join_pts) succs
+ (joins, nonjoins) = partition (`mapMember` join_pts) succs
live_in_joins = unionsLRegSet (map getLive joins)
-- We do not want to sink an assignment into multiple branches,
@@ -266,13 +264,13 @@ annotate platform live nodes = snd $ foldr ann (live,[]) nodes
--
-- Find the blocks that have multiple successors (join points)
--
-findJoinPoints :: [CmmBlock] -> NonDet.LabelMap Int
-findJoinPoints blocks = NonDet.mapFilter (>1) succ_counts
+findJoinPoints :: [CmmBlock] -> LabelMap Int
+findJoinPoints blocks = mapFilter (>1) succ_counts
where
all_succs = concatMap successors blocks
- succ_counts :: NonDet.LabelMap Int
- succ_counts = foldl' (\acc l -> NonDet.mapInsertWith (+) l 1 acc) NonDet.mapEmpty all_succs
+ succ_counts :: LabelMap Int
+ succ_counts = foldl' (\acc l -> mapInsertWith (+) l 1 acc) mapEmpty all_succs
--
-- filter the list of assignments to remove any assignments that
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f526e1aee078712a5ae611d73fe90afa5e5095cb...dba049723168ab1ec9e3d865bfa55ba67731cbdc
--
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f526e1aee078712a5ae611d73fe90afa5e5095cb...dba049723168ab1ec9e3d865bfa55ba67731cbdc
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/20240709/99c067a4/attachment-0001.html>
More information about the ghc-commits
mailing list