Remove uniqSetToList

This documents nondeterminism in code generation and removes
the nondeterministic ufmToList function. In the future someone
will have to use nonDetEltsUFM (with proper explanation)
or pprUFM.

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