random-bytestring (empty) → 0.0.1
raw patch · 11 files changed
+585/−0 lines, 11 filesdep +asyncdep +basedep +bytestringsetup-changed
Dependencies added: async, base, bytestring, criterion, entropy, ghc-prim, mwc-random, nats, primitive, random, random-bytestring
Files
- CHANGELOG.md +4/−0
- LICENSE +20/−0
- README.md +10/−0
- Setup.hs +2/−0
- benchmark/Benchmarks.hs +65/−0
- benchmark/Implementations.hs +221/−0
- benchmark/benchmark-compare.hs +23/−0
- benchmark/benchmark.hs +23/−0
- benchmark/eventlog-compare.hs +32/−0
- random-bytestring.cabal +108/−0
- src/Data/ByteString/Random.hs +77/−0
+ CHANGELOG.md view
@@ -0,0 +1,4 @@+0.0.1+=====++* First public release
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2017 Lars Kuhtz <lakuhtz@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,10 @@+[](https://travis-ci.org/larskuhtz/random-bytestring)++# Efficient Random Haskell ByteStrings++## Installation++```sh+cabal install random-bytestring+```+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmark/Benchmarks.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE UnicodeSyntax #-}++-- -------------------------------------------------------------------------- --+-- |+-- Module: Benchmarks+-- Copyright: (c) Lars Kuhtz <lakuhtz@gmail.com> 2017+-- License: MIT+-- Maintainer: lakuhtz@gmail.com+-- Stability: experimental+--+-- -------------------------------------------------------------------------- --++module Benchmarks+( Impl(..)+, benchmarks+, largeBenchmarks+) where++import Criterion+import Control.Concurrent.Async+import Data.ByteString+import Data.Monoid+import Numeric.Natural++data Impl = Impl String (Natural → IO ByteString)++benchmarks ∷ [Impl] → [Benchmark]+benchmarks impls =+ [ bgroup "single-threaded"+ [ singleThreaded impls 1024+ , singleThreaded impls (1024 * 1024)+ ]+ , bgroup "multi-threaded"+ [ concurrent impls 10 1024+ , concurrent impls 10 (1024 * 1024)+ ]+ ]++largeBenchmarks ∷ [Impl] → [Benchmark]+largeBenchmarks impls =+ [ bgroup "single-threaded"+ [ singleThreaded impls 1024+ , singleThreaded impls (1024 * 1024)+ , singleThreaded impls (1024 * 1024 * 10)+ , singleThreaded impls (1024 * 1024 * 100)+ ]+ , bgroup "multi-threaded"+ [ concurrent impls 10 1024+ , concurrent impls 10 (1024 * 1024)+ , concurrent impls 10 (1024 * 1024 * 10)+ -- , concurrent impls 10 (1024 * 1024 * 100)+ ]+ ]++concurrent ∷ [Impl] → Natural → Natural → Benchmark+concurrent impls c n = bgroup (show c <> "-" <> show n)+ [ cgo label f | (Impl label f) ← impls ]+ where+ cgo s f = bench s $ nfIO $+ forConcurrently [0..(c-1)] (const $ f n)++singleThreaded ∷ [Impl] → Natural → Benchmark+singleThreaded impls n = bgroup (show n)+ [ bench label $ nfIO $ f n | (Impl label f) ← impls ]+
+ benchmark/Implementations.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}++-- -------------------------------------------------------------------------- --+-- |+-- Module: Implementations+-- Copyright: (c) Lars Kuhtz <lakuhtz@gmail.com> 2017+-- License: MIT+-- Maintainer: lakuhtz@gmail.com+-- Stability: experimental+--+-- -------------------------------------------------------------------------- --++module Implementations+( allImplementations++, random+, entropy+, mwcUnfoldr+, mwcUnfoldrIO++--+, mwcMalloc8+, mwcMalloc32+, mwcMalloc64+) where++import Control.Exception (bracketOnError)+import Control.Monad.Primitive++import Data.ByteString (ByteString, pack, unfoldrN)+import Data.ByteString.Unsafe (unsafePackAddressLen)+import Data.Word (Word8, Word32, Word64)++import Foreign (mallocBytes, poke, plusPtr, free, castPtr)++import GHC.Prim+import GHC.Ptr (Ptr(..))++import Numeric.Natural++import System.Entropy (getEntropy)+import System.Random (randoms, getStdGen)+import System.Random.MWC (uniform, create, Gen)++import Benchmarks++-- -------------------------------------------------------------------------- --+-- All Implemenations++allImplementations ∷ [Impl]+allImplementations =+ [ Impl "random" random+ , Impl "entropy" entropy+ , Impl "mwc-unfoldr" mwcUnfoldr+ , Impl "mwc-unfoldr-io" mwcUnfoldrIO+ , Impl "mwc-malloc-8" mwcMalloc8+ , Impl "mwc-malloc-32" mwcMalloc32+ , Impl "mwc-malloc-64" mwcMalloc64+ ]++-- -------------------------------------------------------------------------- --+-- Basic++random ∷ Natural → IO ByteString+random n = (pack . take (fromIntegral n) . randoms) <$> getStdGen++-- -------------------------------------------------------------------------- --+-- entropy++entropy ∷ Natural → IO ByteString+entropy n = getEntropy (fromIntegral n)++-- -------------------------------------------------------------------------- --+-- Malloc8++mwcMalloc8 ∷ Natural → IO ByteString+mwcMalloc8 n = do+ !gen ← create+ bracketOnError (mallocBytes len) free $ \ptr@(Ptr !addr) → do+ go gen ptr+ unsafePackAddressLen len addr++ where+ len ∷ Int+ !len = fromIntegral n++ go !gen !ptr = loop 0+ where+ loop !i+ | i == pred len = return ()+ | otherwise = do+ !b ← uniform gen ∷ IO Word8+ poke (ptr `plusPtr` i) b+ loop (succ i)++-- -------------------------------------------------------------------------- --+-- Malloc32++mwcMalloc32 ∷ Natural → IO ByteString+mwcMalloc32 n = do+ !gen ← create+ bracketOnError (mallocBytes len8) free $ \ptr@(Ptr !addr) → do+ go gen ptr+ unsafePackAddressLen len8 addr+ where+ len8, len32 ∷ Int+ !len8 = fromIntegral n+ !len32 = len8 `div` 4++ go !gen !startPtr = loop32 startPtr+ where+ !fin32Ptr = startPtr `plusPtr` (len32 * 4)+ loop32 !curPtr+ | curPtr < fin32Ptr = do+ !b ← uniform gen ∷ IO Word32+ poke curPtr b+ loop32 $ curPtr `plusPtr` 4+ | otherwise = loop8 $ castPtr curPtr++ !fin8Ptr = startPtr `plusPtr` len8+ loop8 !curPtr+ | curPtr < fin8Ptr = do+ !b ← uniform gen ∷ IO Word8+ poke curPtr b+ loop8 $ curPtr `plusPtr` 1+ | otherwise = return ()+++-- -------------------------------------------------------------------------- --+-- Malloc64++mwcMalloc64 ∷ Natural → IO ByteString+mwcMalloc64 n = do+ !gen ← create+ bracketOnError (mallocBytes len8) free $ \ptr@(Ptr !addr) → do+ go gen ptr+ unsafePackAddressLen len8 addr+ where+ len8, len64 ∷ Int+ !len8 = fromIntegral n+ !len64 = len8 `div` 8++ go ∷ Gen (PrimState IO) → Ptr Word64 → IO ()+ go !gen !startPtr = loop64 startPtr+ where+ fin64Ptr ∷ Ptr Word64+ !fin64Ptr = startPtr `plusPtr` (len64 * 8)++ loop64 ∷ Ptr Word64 → IO ()+ loop64 !curPtr+ | curPtr < fin64Ptr = do+ !b ← uniform gen ∷ IO Word64+ poke curPtr b+ loop64 $ curPtr `plusPtr` 8+ | otherwise = loop8 $ castPtr curPtr++ fin8Ptr ∷ Ptr Word8+ !fin8Ptr = startPtr `plusPtr` len8++ loop8 ∷ Ptr Word8 → IO ()+ loop8 !curPtr+ | curPtr < fin8Ptr = do+ !b ← uniform gen ∷ IO Word8+ poke curPtr b+ loop8 $ curPtr `plusPtr` 1+ | otherwise = return ()++-- -------------------------------------------------------------------------- --+-- unfoldrN, PrimMonad++data Box m = Box !(State# (PrimState m))++mwcUnfoldr ∷ ∀ m . (PrimMonad m, PrimBase m) ⇒ Natural → m ByteString+mwcUnfoldr n = do+ !gen ← create+ primitive $ go gen+ where+ go+ ∷ Gen (PrimState m)+ → State# (PrimState m)+ → (# State# (PrimState m), ByteString #)+ go !gen !st =+ let !(!b, Just (Box !st')) = unfoldrN (fromIntegral n) (step gen) (Box st)+ in (# st', b #)++ step+ ∷ Gen (PrimState m)+ → Box m+ → Maybe (Word8, Box m)+ step !gen (Box !s) =+ let (# !s', !b #) = internal (uniform gen ∷ m Word8) s+ in Just (b, Box s')++-- -------------------------------------------------------------------------- --+-- unfoldrN, IO++mwcUnfoldrIO ∷ Natural → IO ByteString+mwcUnfoldrIO n = do+ !gen ← create+ primitive $ go gen+ where+ go+ ∷ Gen (PrimState IO)+ → State# (PrimState IO)+ → (# State# (PrimState IO), ByteString #)+ go !gen !st =+ let !(!b, Just (Box !st')) = unfoldrN (fromIntegral n) (step gen) (Box st)+ in (# st', b #)++ step+ ∷ Gen (PrimState IO)+ → Box IO+ → Maybe (Word8, Box IO)+ step !gen (Box !s) =+ let (# !s', !b #) = internal (uniform gen ∷ IO Word8) s+ in Just (b, Box s')+
+ benchmark/benchmark-compare.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE UnicodeSyntax #-} + +-- -------------------------------------------------------------------------- -- +-- | +-- Module: Main +-- Copyright: (c) Lars Kuhtz <lakuhtz@gmail.com> 2017 +-- License: MIT +-- Maintainer: lakuhtz@gmail.com +-- Stability: experimental +-- +-- -------------------------------------------------------------------------- -- + +module Main +( main +) where + +import Benchmarks +import Criterion.Main +import Implementations + +main ∷ IO () +main = defaultMain $ benchmarks allImplementations +
+ benchmark/benchmark.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE UnicodeSyntax #-} + +-- -------------------------------------------------------------------------- -- +-- | +-- Module: Main +-- Copyright: (c) Lars Kuhtz <lakuhtz@gmail.com> 2017 +-- License: MIT +-- Maintainer: lakuhtz@gmail.com +-- Stability: experimental +-- +-- -------------------------------------------------------------------------- -- + +module Main +( main +) where + +import Benchmarks +import Criterion.Main +import Data.ByteString.Random + +main ∷ IO () +main = defaultMain $ largeBenchmarks [Impl "Data.ByteString.Random" random] +
+ benchmark/eventlog-compare.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE BangPatterns #-}++-- -------------------------------------------------------------------------- --+-- |+-- Module: Main+-- Copyright: (c) Lars Kuhtz <lakuhtz@gmail.com> 2017+-- License: MIT+-- Maintainer: lakuhtz@gmail.com+-- Stability: experimental+--+-- -------------------------------------------------------------------------- --++module Main+( main+) where++import Control.Concurrent++import Benchmarks+import Implementations++main ∷ IO ()+main = mapM_ run allImplementations+ where+ run (Impl label act) = do+ putStrLn label+ !_ ← act $ 1024 * 1024 * 5+ threadDelay 500000+ return ()++
+ random-bytestring.cabal view
@@ -0,0 +1,108 @@+Name: random-bytestring+Version: 0.0.1+Synopsis: Efficient generation of random bytestrings+Description:+ Efficient generation of random bytestrings+Homepage: https://www.github.com/larskuhtz/random-bytestring+License: MIT+Author: Lars Kuhtz <lakuhtz@gmail.com>+Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+Copyright: Copyright (c) 2017 Lars Kuhtz <lakuhtz@gmail.com>+Category: System+Build-type: Simple+Cabal-version: >= 1.18+Tested-With: GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.2+License-file: LICENSE++extra-doc-files:+ README.md,+ CHANGELOG.md++source-repository head+ type: git+ location: https://www.github.com/larskuhtz/random-bytestring++Library+ default-language: Haskell2010+ hs-source-dirs: src++ exposed-modules:+ Data.ByteString.Random++ build-depends:+ base >= 4.7 && < 4.10 && < 4.10,+ bytestring >= 0.10,+ mwc-random >= 0.13++ if impl(ghc < 7.10)+ build-depends:+ nats >= 1.1++ ghc-options: -Wall++Benchmark benchmark+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: benchmark.hs+ hs-source-dirs: benchmark+ ghc-options: -Wall -O2 -threaded -with-rtsopts=-N -rtsopts+ build-depends:+ random-bytestring,+ async >= 2.1,+ base >= 4.7 && < 4.10,+ bytestring >= 0.10,+ criterion >= 1.1++ if impl(ghc < 7.10)+ build-depends:+ nats >= 1.1++ other-modules:+ Benchmarks++Benchmark benchmark-compare+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: benchmark-compare.hs+ hs-source-dirs: benchmark+ ghc-options: -Wall -O2 -threaded -with-rtsopts=-N -rtsopts+ build-depends:+ random-bytestring,+ async >= 2.1,+ base >= 4.7 && < 4.10,+ bytestring >= 0.10,+ criterion >= 1.1,+ entropy >= 0.3,+ ghc-prim >= 0.3,+ mwc-random >= 0.13,+ primitive >= 0.6,+ random >= 1.1++ if impl(ghc < 7.10)+ build-depends:+ nats >= 1.1++ other-modules:+ Benchmarks,+ Implementations ++Benchmark eventlog-compare+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: eventlog-compare.hs+ hs-source-dirs: benchmark+ ghc-options: -Wall -O2 -threaded -with-rtsopts=-N -rtsopts -eventlog+ build-depends:+ random-bytestring,+ async >= 2.1,+ base >= 4.7 && < 4.10,+ bytestring >= 0.10,+ criterion >= 1.1,+ entropy >= 0.3,+ ghc-prim >= 0.3,+ mwc-random >= 0.13,+ primitive >= 0.6,+ random >= 1.1+ other-modules:+ Benchmarks,+ Implementations
+ src/Data/ByteString/Random.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE BangPatterns #-}++-- -------------------------------------------------------------------------- --+-- |+-- Module: Data.ByteString.Random+-- Copyright: (c) Lars Kuhtz <lakuhtz@gmail.com> 2017+-- License: MIT+-- Maintainer: lakuhtz@gmail.com+-- Stability: experimental+--+-- -------------------------------------------------------------------------- --++module Data.ByteString.Random+( random+, randomGen+) where++import Control.Exception (bracketOnError)++import Data.ByteString (ByteString)+import Data.ByteString.Unsafe (unsafePackAddressLen)+import Data.Word (Word8, Word64)++import Foreign (mallocBytes, poke, plusPtr, free, castPtr)++import GHC.Ptr (Ptr(..))++import Numeric.Natural (Natural)++import System.Random.MWC (uniform, GenIO, create)++random ∷ Natural → IO ByteString+random n = do+ gen ← create+ randomGen gen n++randomGen ∷ GenIO → Natural → IO ByteString+randomGen gen n =+ bracketOnError (mallocBytes len8) free $ \ptr@(Ptr !addr) → do+ {-# SCC "go" #-} go ptr+ {-# SCC "pack" #-} unsafePackAddressLen len8 addr+ where+ len8, len64 ∷ Int+ !len8 = fromIntegral n+ !len64 = len8 `div` 8++ go ∷ Ptr Word64 → IO ()+ go !startPtr = loop64 startPtr+ where+ -- Would it help to add more manual unrolling levels?+ -- How smart is the compiler about unrolling loops?++ -- Generate 64bit values+ fin64Ptr ∷ Ptr Word64+ !fin64Ptr = startPtr `plusPtr` (len64 * 8)++ loop64 ∷ Ptr Word64 → IO ()+ loop64 !curPtr+ | curPtr < fin64Ptr = {-# SCC "loop64" #-} do+ !b ← uniform gen ∷ IO Word64+ {-# SCC "poke64" #-} poke curPtr b+ loop64 $ {-# SCC "ptr_inc" #-} curPtr `plusPtr` 8+ | otherwise = loop8 $ castPtr curPtr++ -- Generate 8bit values+ fin8Ptr ∷ Ptr Word8+ !fin8Ptr = startPtr `plusPtr` len8++ loop8 ∷ Ptr Word8 → IO ()+ loop8 !curPtr+ | curPtr < fin8Ptr = {-# SCC "loop8" #-} do+ !b ← uniform gen ∷ IO Word8+ poke curPtr b+ loop8 $ curPtr `plusPtr` 1+ | otherwise = return ()+