summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/llvmGen/LlvmCodeGen/Base.hs5
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/ArchBase.hs13
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/Main.hs21
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/Spill.hs10
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/SpillClean.hs6
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/SpillCost.hs11
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/Main.hs8
-rw-r--r--compiler/nativeGen/RegAlloc/Liveness.hs24
-rw-r--r--compiler/utils/GraphColor.hs6
-rw-r--r--compiler/utils/GraphOps.hs18
-rw-r--r--compiler/utils/GraphPpr.hs9
-rw-r--r--compiler/utils/UniqSet.hs3
12 files changed, 86 insertions, 48 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 392c069822..824a8595fc 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -448,7 +448,10 @@ getGlobalPtr llvmLbl = do
-- will be generated anymore!
generateExternDecls :: LlvmM ([LMGlobal], [LlvmType])
generateExternDecls = do
- delayed <- fmap uniqSetToList $ getEnv envAliases
+ delayed <- fmap nonDetEltsUFM $ getEnv envAliases
+ -- This is non-deterministic but we do not
+ -- currently support deterministic code-generation.
+ -- See Note [Unique Determinism and code generation]
defss <- flip mapM delayed $ \lbl -> do
m_ty <- funLookup lbl
case m_ty of
diff --git a/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs b/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
index 787b1d2f85..c3df743454 100644
--- a/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
@@ -22,6 +22,7 @@ module RegAlloc.Graph.ArchBase (
squeese
) where
import UniqSet
+import UniqFM
import Unique
@@ -88,7 +89,10 @@ worst :: (RegClass -> UniqSet Reg)
worst regsOfClass regAlias neighbors classN classC
= let regAliasS regs = unionManyUniqSets
$ map regAlias
- $ uniqSetToList regs
+ $ nonDetEltsUFM regs
+ -- This is non-deterministic but we do not
+ -- currently support deterministic code-generation.
+ -- See Note [Unique Determinism and code generation]
-- all the regs in classes N, C
regsN = regsOfClass classN
@@ -117,7 +121,8 @@ bound :: (RegClass -> UniqSet Reg)
bound regsOfClass regAlias classN classesC
= let regAliasS regs = unionManyUniqSets
$ map regAlias
- $ uniqSetToList regs
+ $ nonDetEltsUFM regs
+ -- See Note [Unique Determinism and code generation]
regsC_aliases
= unionManyUniqSets
@@ -150,5 +155,5 @@ powersetL = map concat . mapM (\x -> [[],[x]])
-- | powersetLS (list of sets)
powersetLS :: Uniquable a => UniqSet a -> [UniqSet a]
-powersetLS s = map mkUniqSet $ powersetL $ uniqSetToList s
-
+powersetLS s = map mkUniqSet $ powersetL $ nonDetEltsUFM s
+ -- See Note [Unique Determinism and code generation]
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 52ed438f81..f7b3d0179d 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -110,8 +110,11 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
( text "It looks like the register allocator is stuck in an infinite loop."
$$ text "max cycles = " <> int maxSpinCount
$$ text "regsFree = " <> (hcat $ punctuate space $ map ppr
- $ uniqSetToList $ unionManyUniqSets
- $ eltsUFM regsFree)
+ $ nonDetEltsUFM $ unionManyUniqSets
+ $ nonDetEltsUFM regsFree)
+ -- This is non-deterministic but we do not
+ -- currently support deterministic code-generation.
+ -- See Note [Unique Determinism and code generation]
$$ text "slotsFree = " <> ppr (sizeUniqSet slotsFree))
-- Build the register conflict graph from the cmm code.
@@ -312,15 +315,16 @@ graphAddConflictSet
graphAddConflictSet set graph
= let virtuals = mkUniqSet
- [ vr | RegVirtual vr <- uniqSetToList set ]
+ [ vr | RegVirtual vr <- nonDetEltsUFM set ]
graph1 = Color.addConflicts virtuals classOfVirtualReg graph
graph2 = foldr (\(r1, r2) -> Color.addExclusion r1 classOfVirtualReg r2)
graph1
[ (vr, rr)
- | RegVirtual vr <- uniqSetToList set
- , RegReal rr <- uniqSetToList set]
+ | RegVirtual vr <- nonDetEltsUFM set
+ , RegReal rr <- nonDetEltsUFM set]
+ -- See Note [Unique Determinism and code generation]
in graph2
@@ -410,10 +414,11 @@ seqNode node
= seqVirtualReg (Color.nodeId node)
`seq` seqRegClass (Color.nodeClass node)
`seq` seqMaybeRealReg (Color.nodeColor node)
- `seq` (seqVirtualRegList (uniqSetToList (Color.nodeConflicts node)))
- `seq` (seqRealRegList (uniqSetToList (Color.nodeExclusions node)))
+ `seq` (seqVirtualRegList (nonDetEltsUFM (Color.nodeConflicts node)))
+ `seq` (seqRealRegList (nonDetEltsUFM (Color.nodeExclusions node)))
`seq` (seqRealRegList (Color.nodePreference node))
- `seq` (seqVirtualRegList (uniqSetToList (Color.nodeCoalesce node)))
+ `seq` (seqVirtualRegList (nonDetEltsUFM (Color.nodeCoalesce node)))
+ -- It's OK to use nonDetEltsUFM for seq
seqVirtualReg :: VirtualReg -> ()
seqVirtualReg reg = reg `seq` ()
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 1ec8d1276f..9c3ccae315 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -62,9 +62,12 @@ regSpill platform code slotsFree regs
| otherwise
= do
-- Allocate a slot for each of the spilled regs.
- let slots = take (sizeUniqSet regs) $ uniqSetToList slotsFree
+ let slots = take (sizeUniqSet regs) $ nonDetEltsUFM slotsFree
let regSlotMap = listToUFM
- $ zip (uniqSetToList regs) slots
+ $ zip (nonDetEltsUFM regs) slots
+ -- This is non-deterministic but we do not
+ -- currently support deterministic code-generation.
+ -- See Note [Unique Determinism and code generation]
-- Grab the unique supply from the monad.
us <- getUniqueSupplyM
@@ -139,7 +142,8 @@ regSpill_top platform regSlotMap cmm
moreSlotsLive = Set.fromList
$ catMaybes
$ map (lookupUFM regSlotMap)
- $ uniqSetToList regsLive
+ $ nonDetEltsUFM regsLive
+ -- See Note [Unique Determinism and code generation]
slotMap'
= Map.insert blockId (Set.union curSlotsLive moreSlotsLive)
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index 2383d7bb3a..25d0ff4e80 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -414,7 +414,8 @@ intersects assocs = foldl1' intersectAssoc assocs
findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
findRegOfSlot assoc slot
| close <- closeAssoc (SSlot slot) assoc
- , Just (SReg reg) <- find isStoreReg $ uniqSetToList close
+ , Just (SReg reg) <- find isStoreReg $ nonDetEltsUFM close
+ -- See Note [Unique Determinism and code generation]
= Just reg
| otherwise
@@ -582,7 +583,8 @@ closeAssoc a assoc
= closeAssoc' assoc emptyUniqSet (unitUniqSet a)
where
closeAssoc' assoc visited toVisit
- = case uniqSetToList toVisit of
+ = case nonDetEltsUFM toVisit of
+ -- See Note [Unique Determinism and code generation]
-- nothing else to visit, we're done
[] -> visited
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 8860ebc7e0..beffde97bb 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -108,7 +108,10 @@ slurpSpillCostInfo platform cmm
countLIs rsLiveEntry (LiveInstr instr (Just live) : lis)
= do
-- Increment the lifetime counts for regs live on entry to this instr.
- mapM_ incLifetime $ uniqSetToList rsLiveEntry
+ mapM_ incLifetime $ nonDetEltsUFM rsLiveEntry
+ -- This is non-deterministic but we do not
+ -- currently support deterministic code-generation.
+ -- See Note [Unique Determinism and code generation]
-- Increment counts for what regs were read/written from.
let (RU read written) = regUsageOfInstr platform instr
@@ -137,7 +140,8 @@ slurpSpillCostInfo platform cmm
-- | Take all the virtual registers from this set.
takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
takeVirtuals set = mkUniqSet
- [ vr | RegVirtual vr <- uniqSetToList set ]
+ [ vr | RegVirtual vr <- nonDetEltsUFM set ]
+ -- See Note [Unique Determinism and code generation]
-- | Choose a node to spill from this graph
@@ -254,7 +258,8 @@ nodeDegree classOfVirtualReg graph reg
, virtConflicts
<- length
$ filter (\r -> classOfVirtualReg r == classOfVirtualReg reg)
- $ uniqSetToList
+ $ nonDetEltsUFM
+ -- See Note [Unique Determinism and code generation]
$ nodeConflicts node
= virtConflicts + sizeUniqSet (nodeExclusions node)
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 3e2edc7c97..0fe2592e60 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -350,7 +350,8 @@ initBlock id block_live
Nothing ->
setFreeRegsR (frInitFreeRegs platform)
Just live ->
- setFreeRegsR $ foldr (frAllocateReg platform) (frInitFreeRegs platform) [ r | RegReal r <- uniqSetToList live ]
+ setFreeRegsR $ foldr (frAllocateReg platform) (frInitFreeRegs platform) [ r | RegReal r <- nonDetEltsUFM live ]
+ -- See Note [Unique Determinism and code generation]
setAssigR emptyRegMap
-- load info about register assignments leading into this block.
@@ -443,8 +444,9 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
return (new_instrs, [])
_ -> genRaInsn block_live new_instrs id instr
- (uniqSetToList $ liveDieRead live)
- (uniqSetToList $ liveDieWrite live)
+ (nonDetEltsUFM $ liveDieRead live)
+ (nonDetEltsUFM $ liveDieWrite live)
+ -- See Note [Unique Determinism and code generation]
raInsn _ _ _ instr
= pprPanic "raInsn" (text "no match for:" <> ppr instr)
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index e4a903e904..53cf241413 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -221,7 +221,7 @@ instance Outputable instr
where pprRegs :: SDoc -> RegSet -> SDoc
pprRegs name regs
| isEmptyUniqSet regs = empty
- | otherwise = name <> (hcat $ punctuate space $ map ppr $ uniqSetToList regs)
+ | otherwise = name <> (pprUFM regs (hcat . punctuate space . map ppr))
instance Outputable LiveInfo where
ppr (LiveInfo mb_static entryIds liveVRegsOnEntry liveSlotsOnEntry)
@@ -572,7 +572,8 @@ patchEraseLive patchF cmm
patchCmm (CmmProc info label live sccs)
| LiveInfo static id (Just blockMap) mLiveSlots <- info
= let
- patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
+ patchRegSet set = mkUniqSet $ map patchF $ nonDetEltsUFM set
+ -- See Note [Unique Determinism and code generation]
blockMap' = mapMap patchRegSet blockMap
info' = LiveInfo static id (Just blockMap') mLiveSlots
@@ -629,9 +630,10 @@ patchRegsLiveInstr patchF li
(patchRegsOfInstr instr patchF)
(Just live
{ -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
- liveBorn = mkUniqSet $ map patchF $ uniqSetToList $ liveBorn live
- , liveDieRead = mkUniqSet $ map patchF $ uniqSetToList $ liveDieRead live
- , liveDieWrite = mkUniqSet $ map patchF $ uniqSetToList $ liveDieWrite live })
+ liveBorn = mkUniqSet $ map patchF $ nonDetEltsUFM $ liveBorn live
+ , liveDieRead = mkUniqSet $ map patchF $ nonDetEltsUFM $ liveDieRead live
+ , liveDieWrite = mkUniqSet $ map patchF $ nonDetEltsUFM $ liveDieWrite live })
+ -- See Note [Unique Determinism and code generation]
--------------------------------------------------------------------------------
@@ -757,7 +759,8 @@ checkIsReverseDependent sccs'
= let dests = slurpJumpDestsOfBlock block
blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet [blockId block]
badDests = dests `minusUniqSet` blocksSeen'
- in case uniqSetToList badDests of
+ in case nonDetEltsUFM badDests of
+ -- See Note [Unique Determinism and code generation]
[] -> go blocksSeen' sccs
bad : _ -> Just bad
@@ -765,7 +768,8 @@ checkIsReverseDependent sccs'
= let dests = unionManyUniqSets $ map slurpJumpDestsOfBlock blocks
blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet $ map blockId blocks
badDests = dests `minusUniqSet` blocksSeen'
- in case uniqSetToList badDests of
+ in case nonDetEltsUFM badDests of
+ -- See Note [Unique Determinism and code generation]
[] -> go blocksSeen' sccs
bad : _ -> Just bad
@@ -858,7 +862,8 @@ livenessSCCs platform blockmap done
= a' == b'
where a' = map f $ mapToList a
b' = map f $ mapToList b
- f (key,elt) = (key, uniqSetToList elt)
+ f (key,elt) = (key, nonDetEltsUFM elt)
+ -- See Note [Unique Determinism and code generation]
@@ -994,7 +999,8 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
-- registers that are live only in the branch targets should
-- be listed as dying here.
live_branch_only = live_from_branch `minusUniqSet` liveregs
- r_dying_br = uniqSetToList (mkUniqSet r_dying `unionUniqSets`
+ r_dying_br = nonDetEltsUFM (mkUniqSet r_dying `unionUniqSets`
live_branch_only)
+ -- See Note [Unique Determinism and code generation]
diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs
index 41b367692a..8a1cdd0952 100644
--- a/compiler/utils/GraphColor.hs
+++ b/compiler/utils/GraphColor.hs
@@ -309,8 +309,9 @@ selectColor colors graph u
Just nsConflicts
= sequence
$ map (lookupNode graph)
- $ uniqSetToList
+ $ nonDetEltsUFM
$ nodeConflicts node
+ -- See Note [Unique Determinism and code generation]
colors_conflict = mkUniqSet
$ catMaybes
@@ -355,7 +356,8 @@ selectColor colors graph u
-- it wasn't a preference, but it was still ok
| not $ isEmptyUniqSet colors_ok
- , c : _ <- uniqSetToList colors_ok
+ , c : _ <- nonDetEltsUFM colors_ok
+ -- See Note [Unique Determinism and code generation]
= Just c
-- no colors were available for us this time.
diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index 8b194adba5..a4c565f2eb 100644
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -89,11 +89,12 @@ delNode k graph
| Just node <- lookupNode graph k
= let -- delete conflict edges from other nodes to this one.
graph1 = foldl' (\g k1 -> let Just g' = delConflict k1 k g in g') graph
- $ uniqSetToList (nodeConflicts node)
+ $ nonDetEltsUFM (nodeConflicts node)
-- delete coalesce edge from other nodes to this one.
graph2 = foldl' (\g k1 -> let Just g' = delCoalesce k1 k g in g') graph1
- $ uniqSetToList (nodeCoalesce node)
+ $ nonDetEltsUFM (nodeCoalesce node)
+ -- See Note [Unique Determinism and code generation]
-- delete the node
graph3 = graphMapModify (\fm -> delFromUFM fm k) graph2
@@ -181,7 +182,7 @@ addConflicts
addConflicts conflicts getClass
-- just a single node, but no conflicts, create the node anyway.
- | (u : []) <- uniqSetToList conflicts
+ | (u : []) <- nonDetEltsUFM conflicts
= graphMapModify
$ adjustWithDefaultUFM
id
@@ -191,7 +192,8 @@ addConflicts conflicts getClass
| otherwise
= graphMapModify
$ (\fm -> foldl' (\g u -> addConflictSet1 u getClass conflicts g) fm
- $ uniqSetToList conflicts)
+ $ nonDetEltsUFM conflicts)
+ -- See Note [Unique Determinism and code generation]
addConflictSet1 :: Uniquable k
@@ -315,7 +317,8 @@ coalesceGraph' aggressive triv graph kkPairsAcc
--
cList = [ (nodeId node1, k2)
| node1 <- cNodes
- , k2 <- uniqSetToList $ nodeCoalesce node1 ]
+ , k2 <- nonDetEltsUFM $ nodeCoalesce node1 ]
+ -- See Note [Unique Determinism and code generation]
-- do the coalescing, returning the new graph and a list of pairs of keys
-- that got coalesced together.
@@ -562,7 +565,7 @@ validateGraph doc isColored graph
, not $ isEmptyUniqSet badEdges
= pprPanic "GraphOps.validateGraph"
( text "Graph has edges that point to non-existant nodes"
- $$ text " bad edges: " <> vcat (map ppr $ uniqSetToList badEdges)
+ $$ text " bad edges: " <> pprUFM badEdges (vcat . map ppr)
$$ doc )
-- Check that no conflicting nodes have the same color
@@ -602,7 +605,8 @@ checkNode
checkNode graph node
| Just color <- nodeColor node
, Just neighbors <- sequence $ map (lookupNode graph)
- $ uniqSetToList $ nodeConflicts node
+ $ nonDetEltsUFM $ nodeConflicts node
+ -- See Note [Unique Determinism and code generation]
, neighbourColors <- catMaybes $ map nodeColor neighbors
, elem color neighbourColors
diff --git a/compiler/utils/GraphPpr.hs b/compiler/utils/GraphPpr.hs
index 6f7e9d5bb2..9c246893f7 100644
--- a/compiler/utils/GraphPpr.hs
+++ b/compiler/utils/GraphPpr.hs
@@ -86,7 +86,8 @@ dotNode colorMap triv node
excludes
= hcat $ punctuate space
$ map (\n -> text "-" <> ppr n)
- $ uniqSetToList $ nodeExclusions node
+ $ nonDetEltsUFM $ nodeExclusions node
+ -- See Note [Unique Determinism and code generation]
preferences
= hcat $ punctuate space
@@ -144,12 +145,14 @@ dotNodeEdges visited node
| otherwise
= let dconflicts
= map (dotEdgeConflict (nodeId node))
- $ uniqSetToList
+ $ nonDetEltsUFM
+ -- See Note [Unique Determinism and code generation]
$ minusUniqSet (nodeConflicts node) visited
dcoalesces
= map (dotEdgeCoalesce (nodeId node))
- $ uniqSetToList
+ $ nonDetEltsUFM
+ -- See Note [Unique Determinism and code generation]
$ minusUniqSet (nodeCoalesce node) visited
out = vcat dconflicts
diff --git a/compiler/utils/UniqSet.hs b/compiler/utils/UniqSet.hs
index 925997f45a..f08fa866c1 100644
--- a/compiler/utils/UniqSet.hs
+++ b/compiler/utils/UniqSet.hs
@@ -29,7 +29,6 @@ module UniqSet (
sizeUniqSet,
isEmptyUniqSet,
lookupUniqSet,
- uniqSetToList,
partitionUniqSet
) where
@@ -69,7 +68,6 @@ partitionUniqSet :: (a -> Bool) -> UniqSet a -> (UniqSet a, UniqSet a)
sizeUniqSet :: UniqSet a -> Int
isEmptyUniqSet :: UniqSet a -> Bool
lookupUniqSet :: Uniquable a => UniqSet b -> a -> Maybe b
-uniqSetToList :: UniqSet a -> [a]
{-
************************************************************************
@@ -116,7 +114,6 @@ partitionUniqSet = partitionUFM
sizeUniqSet = sizeUFM
isEmptyUniqSet = isNullUFM
lookupUniqSet = lookupUFM
-uniqSetToList = eltsUFM
uniqSetAny :: (a -> Bool) -> UniqSet a -> Bool
uniqSetAny = anyUFM
View Lorry Controller Status