concurrent-supply-0.1.8/0000755000000000000000000000000012646560545013437 5ustar0000000000000000concurrent-supply-0.1.8/.travis.yml0000644000000000000000000000002212646560545015542 0ustar0000000000000000language: haskell concurrent-supply-0.1.8/CHANGELOG.markdown0000644000000000000000000000026512646560545016475 0ustar00000000000000000.1.8 ----- * Support GHC 8 0.1.7 ----- * `-fno-full-laziness` was added to work around changes in the GHC inliner. 0.1.5 ----- * Claim to be Trustworthy * Added a simple example concurrent-supply-0.1.8/concurrent-supply.cabal0000644000000000000000000000302612646560545020140 0ustar0000000000000000name: concurrent-supply category: Concurrency, Parallelism version: 0.1.8 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: experimental homepage: http://github.com/ekmett/concurrent-supply/ bug-reports: http://github.com/ekmett/concurrent-supply/issues copyright: Copyright (C) 2011 Edward A. Kmett synopsis: A fast concurrent unique identifier supply with a pure API description: A fast supply of concurrent unique identifiers suitable for use within a single process. Once the initial 'Supply' has been initialized, the remainder of the API is pure. See "Control.Concurrent.Supply" for details. build-type: Simple extra-source-files: .travis.yml CHANGELOG.markdown source-repository head type: git location: git://github.com/ekmett/concurrent-supply.git flag test-properties manual: True default: True library default-language: Haskell2010 hs-source-dirs: src other-extensions: MagicHash, UnboxedTuples exposed-modules: Control.Concurrent.Supply ghc-options: -Wall build-depends: base >= 4 && < 5, hashable >= 1.1 && < 1.3, ghc-prim test-suite properties type: exitcode-stdio-1.0 main-is: properties.hs default-language: Haskell2010 ghc-options: -w -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: test if !flag(test-properties) buildable: False else build-depends: base, concurrent-supply, containers concurrent-supply-0.1.8/LICENSE0000644000000000000000000000236412646560545014451 0ustar0000000000000000Copyright 2011-2013 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. concurrent-supply-0.1.8/Setup.hs0000644000000000000000000000005612646560545015074 0ustar0000000000000000import Distribution.Simple main = defaultMain concurrent-supply-0.1.8/src/0000755000000000000000000000000012646560545014226 5ustar0000000000000000concurrent-supply-0.1.8/src/Control/0000755000000000000000000000000012646560545015646 5ustar0000000000000000concurrent-supply-0.1.8/src/Control/Concurrent/0000755000000000000000000000000012646560545017770 5ustar0000000000000000concurrent-supply-0.1.8/src/Control/Concurrent/Supply.hs0000644000000000000000000001201312646560545021615 0ustar0000000000000000{-# LANGUAGE MagicHash, UnboxedTuples, CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif {-# OPTIONS_GHC -fno-full-laziness #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.Supply -- Copyright : (C) 2011-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- A fast unique identifier supply with local pooling and replay -- support. -- -- One often has a desire to generate a bunch of integer identifiers within -- a single process that are unique within that process. You could use -- UUIDs, but they can be expensive to generate; you don't want to have -- your threads contending for a single external counter if the identifier -- is not going to be used outside the process. -- -- @concurrent-supply@ builds a tree-like structure which can be split; you -- can make smaller unique supplies and then you allocate from your supplies -- locally. Internally it pulls from a unique supply one block at a time as -- you walk into parts of the tree that haven't been explored. -- ---------------------------------------------------------------------------- module Control.Concurrent.Supply ( Supply -- * Variables , newSupply , freshId , splitSupply -- * Unboxed API , freshId# , splitSupply# ) where import Data.Hashable import Data.IORef #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710 import Data.Functor ((<$>)) import Data.Monoid #endif import GHC.IO (unsafeDupablePerformIO, unsafePerformIO) import GHC.Types (Int(..)) import GHC.Prim (Int#) infixr 5 :- data Stream a = a :- Stream a instance Functor Stream where fmap f (a :- as) = f a :- fmap f as extract :: Stream a -> a extract (a :- _) = a units :: Stream () units = () :- units {-# NOINLINE units #-} data Block = Block Int !(Stream Block) instance Eq Block where Block a (Block b _ :- _) == Block c (Block d _ :- _) = a == c && b == d instance Ord Block where Block a (Block b _ :- _) `compare` Block c (Block d _ :- _) = compare a c `mappend` compare b d instance Show Block where showsPrec d (Block a (Block b _ :- _)) = showParen (d >= 10) $ showString "Block " . showsPrec 10 a . showString " (Block " . showsPrec 10 b . showString " ... :- ...)" instance Hashable Block where hashWithSalt s (Block a (Block b _ :- _)) = s `hashWithSalt` a `hashWithSalt` b blockSize :: Int blockSize = 1024 {-# INLINE blockSize #-} -- Minimum size to be worth splitting a supply rather than just CAS'ing twice to avoid multiple subsequent biased splits minSplitSupplySize :: Int minSplitSupplySize = 32 -- based on sqrt blockSize {-# INLINE minSplitSupplySize #-} blockCounter :: IORef Int blockCounter = unsafePerformIO (newIORef 0) {-# NOINLINE blockCounter #-} modifyBlock :: a -> IO Int modifyBlock _ = atomicModifyIORef blockCounter $ \ i -> let i' = i + blockSize in i' `seq` (i', i) {-# NOINLINE modifyBlock #-} gen :: a -> Block gen x = Block (unsafeDupablePerformIO (modifyBlock x)) (gen <$> units) {-# NOINLINE gen #-} newBlock :: IO Block newBlock = return $! gen () {-# NOINLINE newBlock #-} splitBlock# :: Block -> (# Block, Block #) splitBlock# (Block i (x :- xs)) = (# x, Block i xs #) {-# INLINE splitBlock# #-} -- | A user managed globally unique variable supply. data Supply = Supply {-# UNPACK #-} !Int {-# UNPACK #-} !Int Block deriving (Eq,Ord,Show) instance Hashable Supply where hashWithSalt s (Supply i j b) = s `hashWithSalt` i `hashWithSalt` j `hashWithSalt` b blockSupply :: Block -> Supply blockSupply (Block i bs) = Supply i (i + blockSize - 1) (extract bs) {-# INLINE blockSupply #-} -- | Grab a new supply. Any two supplies obtained with newSupply are guaranteed to return -- disjoint sets of identifiers. Replaying the same sequence of operations on the same -- Supply will yield the same results. newSupply :: IO Supply newSupply = blockSupply <$> newBlock {-# INLINE newSupply #-} -- | Obtain a fresh Id from a Supply. freshId :: Supply -> (Int, Supply) freshId s = case freshId# s of (# i, s' #) -> (I# i, s') {-# INLINE freshId #-} -- | Split a supply into two supplies that will return disjoint identifiers splitSupply :: Supply -> (Supply, Supply) splitSupply s = case splitSupply# s of (# l, r #) -> (l, r) {-# INLINE splitSupply #-} -- | An unboxed version of freshId freshId# :: Supply -> (# Int#, Supply #) freshId# (Supply i@(I# i#) j b) | i /= j = (# i#, Supply (i + 1) j b #) | otherwise = (# i#, blockSupply b #) {-# INLINE freshId# #-} -- | An unboxed version of splitSupply splitSupply# :: Supply -> (# Supply, Supply #) splitSupply# (Supply i k b) = case splitBlock# b of (# bl, br #) | k - i >= minSplitSupplySize , j <- i + div (k - i) 2 -> (# Supply i j bl, Supply (j + 1) k br #) | Block x (l :- r :- _) <- bl , y <- x + div blockSize 2 , z <- x + blockSize - 1 -> (# Supply x (y - 1) l, Supply y z r #) {-# INLINE splitSupply# #-} concurrent-supply-0.1.8/test/0000755000000000000000000000000012646560545014416 5ustar0000000000000000concurrent-supply-0.1.8/test/properties.hs0000644000000000000000000000073112646560545017147 0ustar0000000000000000module Main where import Control.Monad import Control.Concurrent.Supply import Data.Set import System.Exit reps = 2049 main = do supply <- newSupply let ids = loop supply reps let n = size (fromList ids) when (n == reps) exitSuccess putStrLn $ "Only " ++ show n ++ " out of " ++ show reps ++ " supplied identifiers are distinct" print ids exitFailure where loop s 0 = [] loop s n = let (fId,s') = freshId s in fId : loop s' (n-1)