Remove ufmToList

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

7 files changed, 60 insertions, 26 deletions

diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
index 07f4266b48..cfd8f83122 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
@@ -129,7 +129,7 @@ instance (Outputable statics, Outputable instr)
 
         $$ (if (not $ isNullUFM $ raCoalesced s)
                 then    text "#  Registers coalesced."
-                        $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
+                        $$ (pprUFMWithKeys (raCoalesced s) (vcat . map ppr))
                         $$ text ""
                 else empty)
 
@@ -160,7 +160,7 @@ instance (Outputable statics, Outputable instr)
 
         $$ (if (not $ isNullUFM $ raCoalesced s)
                 then    text "#  Registers coalesced."
-                        $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
+                        $$ (pprUFMWithKeys (raCoalesced s) (vcat . map ppr))
                         $$ text ""
                 else empty)
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index ac38e2b450..294608a04e 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -87,7 +87,10 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests)
 
         -- and free up those registers which are now free.
         let to_free =
-                [ r     | (reg, loc) <- ufmToList assig
+                [ r     | (reg, loc) <- nonDetUFMToList assig
+                        -- This is non-deterministic but we do not
+                        -- currently support deterministic code-generation.
+                        -- See Note [Unique Determinism and code generation]
                         , not (elemUniqSet_Directly reg live_set)
                         , r          <- regsOfLoc loc ]
 
@@ -148,7 +151,10 @@ joinToTargets_again
     src_assig dest_assig
 
         -- the assignments already match, no problem.
-        | ufmToList dest_assig == ufmToList src_assig
+        | nonDetUFMToList dest_assig == nonDetUFMToList src_assig
+        -- This is non-deterministic but we do not
+        -- currently support deterministic code-generation.
+        -- See Note [Unique Determinism and code generation]
         = joinToTargets' block_live new_blocks block_id instr dests
 
         -- assignments don't match, need fixup code
@@ -223,7 +229,10 @@ joinToTargets_again
 --
 makeRegMovementGraph :: RegMap Loc -> RegMap Loc -> [(Unique, Loc, [Loc])]
 makeRegMovementGraph adjusted_assig dest_assig
- = [ node       | (vreg, src) <- ufmToList adjusted_assig
+ = [ node       | (vreg, src) <- nonDetUFMToList adjusted_assig
+                    -- This is non-deterministic but we do not
+                    -- currently support deterministic code-generation.
+                    -- See Note [Unique Determinism and code generation]
                     -- source reg might not be needed at the dest:
                 , Just loc <- [lookupUFM_Directly dest_assig vreg]
                 , node <- expandNode vreg src loc ]
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index edb2394954..3e2edc7c97 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -620,7 +620,10 @@ saveClobberedTemps clobbered dying
         assig   <- getAssigR
         let to_spill
                 = [ (temp,reg)
-                        | (temp, InReg reg) <- ufmToList assig
+                        | (temp, InReg reg) <- nonDetUFMToList assig
+                        -- This is non-deterministic but we do not
+                        -- currently support deterministic code-generation.
+                        -- See Note [Unique Determinism and code generation]
                         , any (realRegsAlias reg) clobbered
                         , temp `notElem` map getUnique dying  ]
 
@@ -682,7 +685,10 @@ clobberRegs clobbered
         setFreeRegsR $! foldr (frAllocateReg platform) freeregs clobbered
 
         assig           <- getAssigR
-        setAssigR $! clobber assig (ufmToList assig)
+        setAssigR $! clobber assig (nonDetUFMToList assig)
+          -- This is non-deterministic but we do not
+          -- currently support deterministic code-generation.
+          -- See Note [Unique Determinism and code generation]
 
    where
         -- if the temp was InReg and clobbered, then we will have
@@ -802,17 +808,23 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
                 -- the vregs we could kick out that are already in a slot
                 let candidates_inBoth
                         = [ (temp, reg, mem)
-                                | (temp, InBoth reg mem) <- ufmToList assig
-                                , temp `notElem` keep'
-                                , targetClassOfRealReg platform reg == classOfVirtualReg r ]
+                          | (temp, InBoth reg mem) <- nonDetUFMToList assig
+                          -- This is non-deterministic but we do not
+                          -- currently support deterministic code-generation.
+                          -- See Note [Unique Determinism and code generation]
+                          , temp `notElem` keep'
+                          , targetClassOfRealReg platform reg == classOfVirtualReg r ]
 
                 -- the vregs we could kick out that are only in a reg
                 --      this would require writing the reg to a new slot before using it.
                 let candidates_inReg
                         = [ (temp, reg)
-                                | (temp, InReg reg)     <- ufmToList assig
-                                , temp `notElem` keep'
-                                , targetClassOfRealReg platform reg == classOfVirtualReg r ]
+                          | (temp, InReg reg) <- nonDetUFMToList assig
+                          -- This is non-deterministic but we do not
+                          -- currently support deterministic code-generation.
+                          -- See Note [Unique Determinism and code generation]
+                          , temp `notElem` keep'
+                          , targetClassOfRealReg platform reg == classOfVirtualReg r ]
 
                 let result
 
@@ -857,7 +869,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
                         = pprPanic ("RegAllocLinear.allocRegsAndSpill: no spill candidates\n")
                         $ vcat
                                 [ text "allocating vreg:  " <> text (show r)
-                                , text "assignment:       " <> text (show $ ufmToList assig)
+                                , text "assignment:       " <> ppr assig
                                 , text "freeRegs:         " <> text (show freeRegs)
                                 , text "initFreeRegs:     " <> text (show (frInitFreeRegs platform `asTypeOf` freeRegs)) ]
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/Stats.hs b/compiler/nativeGen/RegAlloc/Linear/Stats.hs
index b7d93f4436..c55df6bee8 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Stats.hs
@@ -80,7 +80,6 @@ pprStats code statss
         $$ text ""
         $$ text "-- spills-added"
         $$ text "--    (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
-        $$ (vcat $ map pprSpill
-                 $ ufmToList spills)
+        $$ (pprUFMWithKeys spills (vcat . map pprSpill))
         $$ text "")
 
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index b97246012a..e4a903e904 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -462,10 +462,14 @@ slurpReloadCoalesce live
         mergeSlotMaps :: UniqFM Reg -> UniqFM Reg -> UniqFM Reg
         mergeSlotMaps map1 map2
                 = listToUFM
-                $ [ (k, r1)     | (k, r1)       <- ufmToList map1
-                                , case lookupUFM map2 k of
-                                        Nothing -> False
-                                        Just r2 -> r1 == r2 ]
+                $ [ (k, r1)
+                  | (k, r1) <- nonDetUFMToList map1
+                  -- This is non-deterministic but we do not
+                  -- currently support deterministic code-generation.
+                  -- See Note [Unique Determinism and code generation]
+                  , case lookupUFM map2 k of
+                          Nothing -> False
+                          Just r2 -> r1 == r2 ]
 
 
 -- | Strip away liveness information, yielding NatCmmDecl
diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs
index 8ed1451eea..bbf6bb0bd8 100644
--- a/compiler/utils/UniqDFM.hs
+++ b/compiler/utils/UniqDFM.hs
@@ -66,7 +66,7 @@ import qualified Data.IntMap as M
 import Data.Data
 import Data.List (sortBy)
 import Data.Function (on)
-import UniqFM (UniqFM, listToUFM_Directly, ufmToList, ufmToIntMap)
+import UniqFM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap)
 
 -- Note [Deterministic UniqFM]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -372,7 +372,7 @@ instance Monoid (UniqDFM a) where
 -- This should not be used in commited code, provided for convenience to
 -- make ad-hoc conversions when developing
 alwaysUnsafeUfmToUdfm :: UniqFM elt -> UniqDFM elt
-alwaysUnsafeUfmToUdfm = listToUDFM_Directly . ufmToList
+alwaysUnsafeUfmToUdfm = listToUDFM_Directly . nonDetUFMToList
 
 -- Output-ery
 
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index f9832d5455..261dd1c622 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -64,8 +64,8 @@ module UniqFM (
         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
         nonDetEltsUFM, eltsUFM, nonDetKeysUFM,
         ufmToSet_Directly,
-        nonDetUFMToList, ufmToList, ufmToIntMap,
-        pprUniqFM, pprUFM, pluralUFM
+        nonDetUFMToList, ufmToIntMap,
+        pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM
     ) where
 
 import Unique           ( Uniquable(..), Unique, getKey )
@@ -184,7 +184,6 @@ lookupWithDefaultUFM_Directly
                 :: UniqFM elt -> elt -> Unique -> elt
 eltsUFM         :: UniqFM elt -> [elt]
 ufmToSet_Directly :: UniqFM elt -> S.IntSet
-ufmToList       :: UniqFM elt -> [(Unique, elt)]
 
 {-
 ************************************************************************
@@ -286,7 +285,6 @@ lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
 lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
 eltsUFM (UFM m) = M.elems m
 ufmToSet_Directly (UFM m) = M.keysSet m
-ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
 
 anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool
 anyUFM p (UFM m) = M.fold ((||) . p) False m
@@ -357,6 +355,18 @@ pprUFM :: UniqFM a      -- ^ The things to be pretty printed
                         -- printed
 pprUFM ufm pp = pp (nonDetEltsUFM ufm)
 
+-- | Pretty-print a non-deterministic set.
+-- The order of variables is non-deterministic and for pretty-printing that
+-- shouldn't be a problem.
+-- Having this function helps contain the non-determinism created with
+-- nonDetUFMToList.
+pprUFMWithKeys
+       :: UniqFM a                -- ^ The things to be pretty printed
+       -> ([(Unique, a)] -> SDoc) -- ^ The pretty printing function to use on the elements
+       -> SDoc                    -- ^ 'SDoc' where the things have been pretty
+                                  -- printed
+pprUFMWithKeys ufm pp = pp (nonDetUFMToList ufm)
+
 -- | Determines the pluralisation suffix appropriate for the length of a set
 -- in the same way that plural from Outputable does for lists.
 pluralUFM :: UniqFM a -> SDoc