Make it possible to have different UniqSupply strategies
authorBartosz Nitka <niteria@gmail.com>
Tue, 27 Oct 2015 14:17:32 +0000 (15:17 +0100)
committerBen Gamari <ben@smart-cactus.org>
Tue, 27 Oct 2015 14:20:38 +0000 (15:20 +0100)
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

compiler/basicTypes/UniqSupply.hs
compiler/cbits/genSym.c
compiler/main/DynFlags.hs
docs/users_guide/debugging.rst
ghc/Main.hs

index b84270a..afc4d3c 100644 (file)
@@ -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
index 08d403d..70ea417 100644 (file)
@@ -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;
+}
index 7794145..f7a3edd 100644 (file)
@@ -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))
index 9482b8e..ddb3c2a 100644 (file)
@@ -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
index fc6ab88..647bbad 100644 (file)
@@ -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