[commit: ghc] master: Use atomic counter for GHC.Event.Unique (5d2a92a)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/5d2a92a1455349011568f18526b0d5d4ce51f692/ghc

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

commit 5d2a92a1455349011568f18526b0d5d4ce51f692
Author: alexbiehl <alex.biehl at gmail.com>
Date:   Tue Jan 3 10:59:39 2017 -0500

    Use atomic counter for GHC.Event.Unique
    
    Reviewers: hvr, austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: mpickering, thomie
    
    Differential Revision: https://phabricator.haskell.org/D2905


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

5d2a92a1455349011568f18526b0d5d4ce51f692
 libraries/base/GHC/Event/PSQ.hs    |  1 +
 libraries/base/GHC/Event/Unique.hs | 37 ++++++++++++++++---------------------
 2 files changed, 17 insertions(+), 21 deletions(-)

diff --git a/libraries/base/GHC/Event/PSQ.hs b/libraries/base/GHC/Event/PSQ.hs
index a4c0ccc..311265f 100644
--- a/libraries/base/GHC/Event/PSQ.hs
+++ b/libraries/base/GHC/Event/PSQ.hs
@@ -89,6 +89,7 @@ module GHC.Event.PSQ
     ) where
 
 import GHC.Base hiding (empty)
+import GHC.Float () -- for Show Double instasnce
 import GHC.Num (Num(..))
 import GHC.Show (Show(showsPrec))
 import GHC.Event.Unique (Unique)
diff --git a/libraries/base/GHC/Event/Unique.hs b/libraries/base/GHC/Event/Unique.hs
index abdd3fe..0363af2 100644
--- a/libraries/base/GHC/Event/Unique.hs
+++ b/libraries/base/GHC/Event/Unique.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash,
+  NoImplicitPrelude, UnboxedTuples #-}
 
 module GHC.Event.Unique
     (
@@ -9,36 +10,30 @@ module GHC.Event.Unique
     , newUnique
     ) where
 
-import Data.Int (Int64)
 import GHC.Base
-import GHC.Conc.Sync (TVar, atomically, newTVarIO, readTVar, writeTVar)
-import GHC.Num (Num(..))
-import GHC.Show (Show(..))
+import GHC.Num(Num)
+import GHC.Show(Show(..))
 
--- We used to use IORefs here, but Simon switched us to STM when we
--- found that our use of atomicModifyIORef was subject to a severe RTS
--- performance problem when used in a tight loop from multiple
--- threads: http://ghc.haskell.org/trac/ghc/ticket/3838
---
--- There seems to be no performance cost to using a TVar instead.
+#include "MachDeps.h"
 
-newtype UniqueSource = US (TVar Int64)
+data UniqueSource = US (MutableByteArray# RealWorld)
 
-newtype Unique = Unique { asInt64 :: Int64 }
+newtype Unique = Unique { asInt :: Int }
     deriving (Eq, Ord, Num)
 
 -- | @since 4.3.1.0
 instance Show Unique where
-    show = show . asInt64
+    show = show . asInt
 
 newSource :: IO UniqueSource
-newSource = US `fmap` newTVarIO 0
+newSource = IO $ \s ->
+  case newByteArray# size s of
+    (# s', mba #) -> (# s', US mba #)
+  where
+    !(I# size) = SIZEOF_HSINT
 
 newUnique :: UniqueSource -> IO Unique
-newUnique (US ref) = atomically $ do
-  u <- readTVar ref
-  let !u' = u+1
-  writeTVar ref u'
-  return $ Unique u'
+newUnique (US mba) = IO $ \s ->
+  case fetchAddIntArray# mba 0# 1# s of
+    (# s', a #) -> (# s', Unique (I# a) #)
 {-# INLINE newUnique #-}
-