Document SCC determinism

I've documented the guarantees that stronglyConnCompFromEdgedVertices
provides and commented on the call sites to explain why they are
OK from determinism standpoint. I've changed the functions to
nonDetUFM versions, so that it's explicit they could introduce
nondeterminism.  I haven't defined container (VarSet, NameSet)
specific versions, so that we have less functions to worry about.

Test Plan: this is mostly just documentation,
it should have no runtime effect

Reviewers: bgamari, simonmar, austin, simonpj

Reviewed By: simonpj

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2194

GHC Trac Issues: #4012

12 files changed, 102 insertions, 15 deletions

diff --git a/compiler/basicTypes/NameEnv.hs b/compiler/basicTypes/NameEnv.hs
index 674323d290..740c40605e 100644
--- a/compiler/basicTypes/NameEnv.hs
+++ b/compiler/basicTypes/NameEnv.hs
@@ -48,6 +48,16 @@ import Maybes
 ************************************************************************
 -}
 
+{-
+Note [depAnal determinism]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+depAnal is deterministic provided it gets the nodes in a deterministic order.
+The order of lists that get_defs and get_uses return doesn't matter, as these
+are only used to construct the edges, and stronglyConnCompFromEdgedVertices is
+deterministic even when the edges are not in deterministic order as explained
+in Note [Deterministic SCC] in Digraph.
+-}
+
 depAnal :: (node -> [Name])      -- Defs
         -> (node -> [Name])      -- Uses
         -> [node]
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 7f8397bf07..64c78319a6 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -106,6 +106,7 @@ import Maybes
 import Binary
 import Fingerprint
 import Exception
+import UniqFM
 
 import Control.Monad
 import Data.Function
@@ -396,7 +397,12 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
        name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
        localOccs = map (getUnique . getParent . getOccName)
                         . filter ((== this_mod) . name_module)
-                        . nameSetElems
+                        . nonDetEltsUFM
+                   -- It's OK to use nonDetEltsUFM as localOccs is only
+                   -- used to construct the edges and
+                   -- stronglyConnCompFromEdgedVertices is deterministic
+                   -- even with non-deterministic order of edges as
+                   -- explained in Note [Deterministic SCC] in Digraph.
           where getParent occ = lookupOccEnv parent_map occ `orElse` occ
 
         -- maps OccNames to their parents in the current module.
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 45ca7050ad..61f4dd8a3e 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -46,6 +46,7 @@ import Bag
 import Util
 import Outputable
 import FastString
+import UniqFM
 import Maybes           ( orElse )
 import qualified GHC.LanguageExtensions as LangExt
 
@@ -516,7 +517,9 @@ depAnalBinds binds_w_dus
   = (map get_binds sccs, map get_du sccs)
   where
     sccs = depAnal (\(_, defs, _) -> defs)
-                   (\(_, _, uses) -> nameSetElems uses)
+                   (\(_, _, uses) -> nonDetEltsUFM uses)
+                   -- It's OK to use nonDetEltsUFM here as explained in
+                   -- Note [depAnal determinism] in NameEnv.
                    (bagToList binds_w_dus)
 
     get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index f92bae9f02..d91ce86cff 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -50,6 +50,7 @@ import Util             ( debugIsOn, partitionWith )
 import HscTypes         ( HscEnv, hsc_dflags )
 import ListSetOps       ( findDupsEq, removeDups, equivClasses )
 import Digraph          ( SCC, flattenSCC, flattenSCCs, stronglyConnCompFromEdgedVertices )
+import UniqFM
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
@@ -1339,8 +1340,12 @@ depAnalTyClDecls :: GlobalRdrEnv
 depAnalTyClDecls rdr_env ds_w_fvs
   = stronglyConnCompFromEdgedVertices edges
   where
-    edges = [ (d, tcdName (unLoc d), map (getParent rdr_env) (nameSetElems fvs))
+    edges = [ (d, tcdName (unLoc d), map (getParent rdr_env) (nonDetEltsUFM fvs))
             | (d, fvs) <- ds_w_fvs ]
+            -- It's OK to use nonDetEltsUFM here as
+            -- stronglyConnCompFromEdgedVertices is still deterministic
+            -- even if the edges are in nondeterministic order as explained
+            -- in Note [Deterministic SCC] in Digraph.
 
 toParents :: GlobalRdrEnv -> NameSet -> NameSet
 toParents rdr_env ns
diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index 41a6f7fa71..b9edba7bd9 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -691,7 +691,10 @@ instance Outputable Details where
 
 makeNode :: OccEnv -> ImpRuleEdges -> VarSet -> (Var, CoreExpr) -> Node Details
 makeNode env imp_rule_edges bndr_set (bndr, rhs)
-  = (details, varUnique bndr, keysUFM node_fvs)
+  = (details, varUnique bndr, nonDetKeysUFM node_fvs)
+    -- It's OK to use nonDetKeysUFM here as stronglyConnCompFromEdgedVerticesR
+    -- is still deterministic with edges in nondeterministic order as
+    -- explained in Note [Deterministic SCC] in Digraph.
   where
     details = ND { nd_bndr = bndr
                  , nd_rhs  = rhs'
@@ -800,7 +803,11 @@ occAnalRec (CyclicSCC nodes) (body_uds, binds)
         -- See Note [Choosing loop breakers] for loop_breaker_edges
     loop_breaker_edges = map mk_node tagged_nodes
     mk_node (details@(ND { nd_inl = inl_fvs }), k, _)
-      = (details, k, keysUFM (extendFvs_ rule_fv_env inl_fvs))
+      = (details, k, nonDetKeysUFM (extendFvs_ rule_fv_env inl_fvs))
+        -- It's OK to use nonDetKeysUFM here as
+        -- stronglyConnCompFromEdgedVerticesR is still deterministic with edges
+        -- in nondeterministic order as explained in
+        -- Note [Deterministic SCC] in Digraph.
 
     ------------------------------------
     rule_fv_env :: IdEnv IdSet
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 19b503400b..fc04ec9999 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -58,6 +58,7 @@ import Outputable
 import Type(mkStrLitTy, tidyOpenType)
 import PrelNames( mkUnboundName, gHC_PRIM, ipClassName )
 import TcValidity (checkValidType)
+import UniqFM
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
@@ -498,10 +499,13 @@ type BKey = Int -- Just number off the bindings
 mkEdges :: TcSigFun -> LHsBinds Name -> [Node BKey (LHsBind Name)]
 -- See Note [Polymorphic recursion] in HsBinds.
 mkEdges sig_fn binds
-  = [ (bind, key, [key | n <- nameSetElems (bind_fvs (unLoc bind)),
+  = [ (bind, key, [key | n <- nonDetEltsUFM (bind_fvs (unLoc bind)),
                          Just key <- [lookupNameEnv key_map n], no_sig n ])
     | (bind, key) <- keyd_binds
     ]
+    -- It's OK to use nonDetEltsUFM here as stronglyConnCompFromEdgedVertices
+    -- is still deterministic even if the edges are in nondeterministic order
+    -- as explained in Note [Deterministic SCC] in Digraph.
   where
     no_sig :: Name -> Bool
     no_sig n = noCompleteSig (sig_fn n)
diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs
index c4d02d8248..b86e3f4678 100644
--- a/compiler/typecheck/TcEvidence.hs
+++ b/compiler/typecheck/TcEvidence.hs
@@ -62,6 +62,7 @@ import Outputable
 import FastString
 import SrcLoc
 import Data.IORef( IORef )
+import UniqFM
 
 {-
 Note [TcCoercions]
@@ -695,8 +696,11 @@ sccEvBinds bs = stronglyConnCompFromEdgedVertices edges
 
     mk_node :: EvBind -> (EvBind, EvVar, [EvVar])
     mk_node b@(EvBind { eb_lhs = var, eb_rhs = term })
-      = (b, var, varSetElems (evVarsOfTerm term `unionVarSet`
-                              coVarsOfType (varType var)))
+      = (b, var, nonDetEltsUFM (evVarsOfTerm term `unionVarSet`
+                                coVarsOfType (varType var)))
+      -- It's OK to use nonDetEltsUFM here as stronglyConnCompFromEdgedVertices
+      -- is still deterministic even if the edges are in nondeterministic order
+      -- as explained in Note [Deterministic SCC] in Digraph.
 
 evVarsOfCallStack :: EvCallStack -> VarSet
 evVarsOfCallStack cs = case cs of
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index 10fd0cce5f..606e3c19e8 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -2479,8 +2479,12 @@ checkForCyclicBinds ev_binds
     is_co_bind (EvBind { eb_lhs = b }) = isEqPred (varType b)
 
     edges :: [(EvBind, EvVar, [EvVar])]
-    edges = [ (bind, bndr, varSetElems (evVarsOfTerm rhs))
+    edges = [ (bind, bndr, nonDetEltsUFM (evVarsOfTerm rhs))
             | bind@(EvBind { eb_lhs = bndr, eb_rhs = rhs}) <- bagToList ev_binds ]
+            -- It's OK to use nonDetEltsUFM here as
+            -- stronglyConnCompFromEdgedVertices is still deterministic even
+            -- if the edges are in nondeterministic order as explained in
+            -- Note [Deterministic SCC] in Digraph.
 #endif
 
 nestImplicTcS :: Maybe EvBindsVar -> TyCoVarSet -- bound in this implication
diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index 62933b5923..2d6637ea29 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -60,6 +60,7 @@ import Data.List
 import Bag
 import FastString
 import FV
+import UniqFM
 
 import Control.Monad
 
@@ -130,9 +131,13 @@ synonymTyConsOfType ty
 -}
 
 mkSynEdges :: [LTyClDecl Name] -> [(LTyClDecl Name, Name, [Name])]
-mkSynEdges syn_decls = [ (ldecl, name, nameSetElems fvs)
+mkSynEdges syn_decls = [ (ldecl, name, nonDetEltsUFM fvs)
                        | ldecl@(L _ (SynDecl { tcdLName = L _ name
                                              , tcdFVs = fvs })) <- syn_decls ]
+            -- It's OK to use nonDetEltsUFM here as
+            -- stronglyConnCompFromEdgedVertices is still deterministic even
+            -- if the edges are in nondeterministic order as explained in
+            -- Note [Deterministic SCC] in Digraph.
 
 calcSynCycles :: [LTyClDecl Name] -> [SCC (LTyClDecl Name)]
 calcSynCycles = stronglyConnCompFromEdgedVertices . mkSynEdges
@@ -419,8 +424,10 @@ calcRecFlags boot_details is_boot mrole_env all_tycons
     nt_edges = [(t, mk_nt_edges t) | t <- new_tycons]
 
     mk_nt_edges nt      -- Invariant: nt is a newtype
-        = [ tc | tc <- nameEnvElts (tyConsOfType (new_tc_rhs nt))
+        = [ tc | tc <- nonDetEltsUFM (tyConsOfType (new_tc_rhs nt))
                         -- tyConsOfType looks through synonyms
+                        -- It's OK to use nonDetEltsUFM here, see
+                        -- Note [findLoopBreakers determinism].
                , tc `elem` new_tycons ]
            -- If not (tc `elem` new_tycons) we know that either it's a local *data* type,
            -- or it's imported.  Either way, it can't form part of a newtype cycle
@@ -433,7 +440,9 @@ calcRecFlags boot_details is_boot mrole_env all_tycons
     mk_prod_edges tc    -- Invariant: tc is a product tycon
         = concatMap (mk_prod_edges1 tc) (dataConOrigArgTys (head (tyConDataCons tc)))
 
-    mk_prod_edges1 ptc ty = concatMap (mk_prod_edges2 ptc) (nameEnvElts (tyConsOfType ty))
+    mk_prod_edges1 ptc ty = concatMap (mk_prod_edges2 ptc) (nonDetEltsUFM (tyConsOfType ty))
+                                      -- It's OK to use nonDetEltsUFM here, see
+                                      -- Note [findLoopBreakers determinism].
 
     mk_prod_edges2 ptc tc
         | tc `elem` prod_tycons   = [tc]                -- Local product
@@ -447,6 +456,14 @@ calcRecFlags boot_details is_boot mrole_env all_tycons
 new_tc_rhs :: TyCon -> Type
 new_tc_rhs tc = snd (newTyConRhs tc)    -- Ignore the type variables
 
+{-
+Note [findLoopBreakers determinism]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The order of edges doesn't matter for determinism here as explained in
+Note [Deterministic SCC] in Digraph. It's enough for the order of nodes
+to be deterministic.
+-}
+
 findLoopBreakers :: [(TyCon, [TyCon])] -> [Name]
 -- Finds a set of tycons that cut all loops
 findLoopBreakers deps
diff --git a/compiler/utils/Digraph.hs b/compiler/utils/Digraph.hs
index 2c90c1e41e..1d6ef24e61 100644
--- a/compiler/utils/Digraph.hs
+++ b/compiler/utils/Digraph.hs
@@ -94,6 +94,7 @@ type Node key payload = (payload, key, [key])
 emptyGraph :: Graph a
 emptyGraph = Graph (array (1, 0) []) (error "emptyGraph") (const Nothing)
 
+-- See Note [Deterministic SCC]
 graphFromEdgedVertices
         :: Ord key                      -- We only use Ord for efficiency,
                                         -- it doesn't effect the result, so
@@ -200,6 +201,18 @@ depend on earlier ones, but not vice versa i.e. later components only have
 edges going from them to earlier ones.
 -}
 
+{-
+Note [Deterministic SCC]
+~~~~~~~~~~~~~~~~~~~~~~~~
+stronglyConnCompFromEdgedVertices and stronglyConnCompFromEdgedVerticesR
+provide a following guarantee:
+Given a deterministically ordered list of nodes it returns a deterministically
+ordered list of strongly connected components, where the list of vertices
+in an SCC is also deterministically ordered.
+Note that the order of edges doesn't need to be deterministic for this to work.
+We use the order of nodes to normalize the order of edges.
+-}
+
 stronglyConnCompG :: Graph node -> [SCC node]
 stronglyConnCompG graph = decodeSccs graph forest
   where forest = {-# SCC "Digraph.scc" #-} scc (gr_int_graph graph)
@@ -216,6 +229,7 @@ decodeSccs Graph { gr_int_graph = graph, gr_vertex_to_node = vertex_fn } forest
 
 
 -- The following two versions are provided for backwards compatability:
+-- See Note [Deterministic SCC]
 stronglyConnCompFromEdgedVertices
         :: Ord key
         => [Node key payload]
@@ -226,6 +240,7 @@ stronglyConnCompFromEdgedVertices
 
 -- The "R" interface is used when you expect to apply SCC to
 -- (some of) the result of SCC, so you dont want to lose the dependency info
+-- See Note [Deterministic SCC]
 stronglyConnCompFromEdgedVerticesR
         :: Ord key
         => [Node key payload]
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index 590358ab40..2ff635268d 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -61,7 +61,7 @@ module UniqFM (
         isNullUFM,
         lookupUFM, lookupUFM_Directly,
         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
-        nonDetEltsUFM, eltsUFM, keysUFM, splitUFM,
+        nonDetEltsUFM, eltsUFM, nonDetKeysUFM, keysUFM, splitUFM,
         ufmToSet_Directly,
         ufmToList, ufmToIntMap,
         joinUFM, pprUniqFM, pprUFM, pluralUFM
@@ -303,10 +303,18 @@ anyUFM p (UFM m) = M.fold ((||) . p) False m
 allUFM :: (elt -> Bool) -> UniqFM elt -> Bool
 allUFM p (UFM m) = M.fold ((&&) . p) True m
 
--- See Note [Deterministic UniqFM] to learn about nondeterminism
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
 nonDetEltsUFM :: UniqFM elt -> [elt]
 nonDetEltsUFM (UFM m) = M.elems m
 
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetKeysUFM :: UniqFM elt -> [Unique]
+nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
+
 ufmToIntMap :: UniqFM elt -> M.IntMap elt
 ufmToIntMap (UFM m) = m
 
diff --git a/compiler/vectorise/Vectorise/Type/Classify.hs b/compiler/vectorise/Vectorise/Type/Classify.hs
index 0140989233..75d43d4e36 100644
--- a/compiler/vectorise/Vectorise/Type/Classify.hs
+++ b/compiler/vectorise/Vectorise/Type/Classify.hs
@@ -98,8 +98,12 @@ type TyConGroup = ([TyCon], UniqSet TyCon)
 tyConGroups :: [TyCon] -> [TyConGroup]
 tyConGroups tcs = map mk_grp (stronglyConnCompFromEdgedVertices edges)
   where
-    edges = [((tc, ds), tc, uniqSetToList ds) | tc <- tcs
+    edges = [((tc, ds), tc, nonDetEltsUFM ds) | tc <- tcs
                                 , let ds = tyConsOfTyCon tc]
+            -- It's OK to use nonDetEltsUFM here as
+            -- stronglyConnCompFromEdgedVertices is still deterministic even
+            -- if the edges are in nondeterministic order as explained in
+            -- Note [Deterministic SCC] in Digraph.
 
     mk_grp (AcyclicSCC (tc, ds)) = ([tc], ds)
     mk_grp (CyclicSCC els)       = (tcs, unionManyUniqSets dss)