Remove uniqSetToList
authorBartosz Nitka <niteria@gmail.com>
Fri, 1 Jul 2016 11:58:39 +0000 (04:58 -0700)
committerBartosz Nitka <niteria@gmail.com>
Fri, 1 Jul 2016 12:44:27 +0000 (05:44 -0700)
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:
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
compiler/nativeGen/RegAlloc/Graph/Main.hs
compiler/nativeGen/RegAlloc/Graph/Spill.hs
compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
compiler/nativeGen/RegAlloc/Linear/Main.hs
compiler/nativeGen/RegAlloc/Liveness.hs
compiler/utils/GraphColor.hs
compiler/utils/GraphOps.hs
compiler/utils/GraphPpr.hs
compiler/utils/UniqSet.hs

index 392c069..824a859 100644 (file)
@@ -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
index 787b1d2..c3df743 100644 (file)
@@ -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]
index 52ed438..f7b3d01 100644 (file)
@@ -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` ()
index 1ec8d12..9c3ccae 100644 (file)
@@ -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)
index 2383d7b..25d0ff4 100644 (file)
@@ -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
index 8860ebc..beffde9 100644 (file)
@@ -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)
index 3e2edc7..0fe2592 100644 (file)
@@ -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)
index e4a903e..53cf241 100644 (file)
@@ -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]
 
 
index 41b3676..8a1cdd0 100644 (file)
@@ -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.
index 8b194ad..a4c565f 100644 (file)
@@ -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
index 6f7e9d5..9c24689 100644 (file)
@@ -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
index 925997f..f08fa86 100644 (file)
@@ -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