[commit: ghc] master: Make it possible to have different UniqSupply strategies (158d2a9)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/158d2a91581d82dc1690a858b474eaab3a02e43e/ghc

>---------------------------------------------------------------

commit 158d2a91581d82dc1690a858b474eaab3a02e43e
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Tue Oct 27 15:17:32 2015 +0100

    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


>---------------------------------------------------------------

158d2a91581d82dc1690a858b474eaab3a02e43e
 compiler/basicTypes/UniqSupply.hs |  4 ++++
 compiler/cbits/genSym.c           | 11 ++++++++---
 compiler/main/DynFlags.hs         | 14 ++++++--------
 docs/users_guide/debugging.rst    | 32 ++++++++++++++++++++++++++++++++
 ghc/Main.hs                       |  2 ++
 5 files changed, 52 insertions(+), 11 deletions(-)

diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs
index b84270a..afc4d3c 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 08d403d..70ea417 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 7794145..f7a3edd 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 9482b8e..ddb3c2a 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 fc6ab88..647bbad 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