Make it possible to have different UniqSupply strategies

To get reproducible/deterministic builds, the way that the Uniques are
assigned shouldn't matter. This allows to test for that.

It add 2 new flags:

* `-dinitial-unique`
* `-dunique-increment`

And by varying these you can get interesting effects:

* `-dinitial-unique=0 -dunique-increment 1` - current sequential
  UniqSupply

* `-dinitial-unique=16777215 -dunique-increment -1` - UniqSupply that
  generates in decreasing order

* `-dinitial-unique=1 -dunique-increment PRIME` - where PRIME big enough
  to overflow often - nonsequential order

I haven't proven the usefullness of the last one yet and it's the reason
why we have to mask the bits with `0xFFFFFF` in `genSym`, so I can
remove it if it becomes contentious.

Test Plan: validate on harbormaster

Reviewers: simonmar, austin, ezyang, bgamari

Reviewed By: austin, bgamari

Subscribers: thomie

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

GHC Trac Issues: #4012

5 files changed, 52 insertions, 11 deletions

diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs
index b84270a571..afc4d3c171 100644
--- a/compiler/basicTypes/UniqSupply.hs
+++ b/compiler/basicTypes/UniqSupply.hs
@@ -22,6 +22,9 @@ module UniqSupply (
         -- ** Operations on the monad
         initUs, initUs_,
         lazyThenUs, lazyMapUs,
+
+        -- * Set supply strategy
+        initUniqSupply
   ) where
 
 import Unique
@@ -85,6 +88,7 @@ mkSplitUniqSupply c
        mk_supply
 
 foreign import ccall unsafe "genSym" genSym :: IO Int
+foreign import ccall unsafe "initGenSym" initUniqSupply :: Int -> Int -> IO ()
 
 splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)
 listSplitUniqSupply  (MkSplitUniqSupply _ s1 s2) = s1 : listSplitUniqSupply s2
diff --git a/compiler/cbits/genSym.c b/compiler/cbits/genSym.c
index 08d403d849..70ea417c4b 100644
--- a/compiler/cbits/genSym.c
+++ b/compiler/cbits/genSym.c
@@ -2,16 +2,21 @@
 #include "Rts.h"
 
 static HsInt GenSymCounter = 0;
+static HsInt GenSymInc = 1;
 
 HsInt genSym(void) {
 #if defined(THREADED_RTS)
     if (n_capabilities == 1) {
-        return GenSymCounter++;
+        return GenSymCounter = (GenSymCounter + GenSymInc) & 0xFFFFFF;
     } else {
-        return atomic_inc((StgWord *)&GenSymCounter, 1);
+        return atomic_inc((StgWord *)&GenSymCounter, GenSymInc) & 0xFFFFFF;
     }
 #else
-    return GenSymCounter++;
+    return GenSymCounter = (GenSymCounter + GenSymInc) & 0xFFFFFF;
 #endif
 }
 
+void initGenSym(HsInt NewGenSymCounter, HsInt NewGenSymInc) {
+  GenSymCounter = NewGenSymCounter;
+  GenSymInc = NewGenSymInc;
+}
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 7794145ef5..f7a3edddca 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -900,7 +900,11 @@ data DynFlags = DynFlags {
   maxInlineMemsetInsns  :: Int,
 
   -- | Reverse the order of error messages in GHC/GHCi
-  reverseErrors :: Bool
+  reverseErrors :: Bool,
+
+  -- | Unique supply configuration for testing build determinism
+  initialUnique         :: Int,
+  uniqueIncrement       :: Int
 }
 
 class HasDynFlags m where
@@ -1561,9 +1565,7 @@ defaultDynFlags mySettings =
 
         maxInlineAllocSize = 128,
         maxInlineMemcpyInsns = 32,
-        maxInlineMemsetInsns = 32,
-
-        reverseErrors = False
+        maxInlineMemsetInsns = 32
       }
 
 defaultWays :: Settings -> [Way]
@@ -2402,10 +2404,6 @@ dynamic_flags = [
                                      deprecate "Use -fno-force-recomp instead"))
   , defGhcFlag "no-recomp" (NoArg (do setGeneralFlag Opt_ForceRecomp
                                       deprecate "Use -fforce-recomp instead"))
-  , defFlag "freverse-errors"
-      (noArg (\d -> d {reverseErrors = True} ))
-  , defFlag "fno-reverse-errors"
-      (noArg (\d -> d {reverseErrors = False} ))
 
         ------ HsCpp opts ---------------------------------------------------
   , defFlag "D"              (AnySuffix (upd . addOptP))
diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst
index 9482b8ef93..ddb3c2a832 100644
--- a/docs/users_guide/debugging.rst
+++ b/docs/users_guide/debugging.rst
@@ -429,3 +429,35 @@ Checking for consistency
        single: -dcmm-lint
 
     Ditto for C-- level.
+
+.. _checking-determinism:
+
+Checking for determinism
+------------------------
+
+.. index::
+   single: deterministic builds
+
+``-dinitial-unique=⟨s⟩``
+    .. index::
+       single: -dinitial-unique
+
+    Start ``UniqSupply`` allocation from ⟨s⟩.
+
+``-dunique-increment=⟨i⟩``
+    .. index::
+       single: -dunique-increment
+
+    Set the increment for the generated ``Unique``'s to ⟨i⟩.
+
+    This is useful in combination with ``-dinitial-unique`` to test if the
+    generated files depend on the order of ``Unique``'s.
+
+    Some interesting values:
+
+    * ``-dinitial-unique=0 -dunique-increment=1`` - current sequential
+      ``UniqSupply``
+    * ``-dinitial-unique=16777215 -dunique-increment=-1`` - ``UniqSupply`` that
+      generates in decreasing order
+    * ``-dinitial-unique=1 -dunique-increment=PRIME`` - where PRIME big enough
+      to overflow often - nonsequential order
diff --git a/ghc/Main.hs b/ghc/Main.hs
index fc6ab88960..647bbadcf9 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -44,6 +44,7 @@ import Outputable
 import SrcLoc
 import Util
 import Panic
+import UniqSupply
 import MonadUtils       ( liftIO )
 
 -- Imports for --abi-hash
@@ -236,6 +237,7 @@ main' postLoadMode dflags0 args flagWarnings = do
     printInfoForUser (dflags6 { pprCols = 200 })
                      (pkgQual dflags6) (pprModuleMap dflags6)
 
+  liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)
         ---------------- Final sanity checking -----------
   liftIO $ checkOptions postLoadMode dflags6 srcs objs