diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,8 @@ +# 0.0.2 + +- Support back to GHC-7.0 +- Add `Read SMGen` instance + # 0.0.1 - Add `NFData SMGen` instance diff --git a/splitmix.cabal b/splitmix.cabal --- a/splitmix.cabal +++ b/splitmix.cabal @@ -1,8 +1,7 @@ -cabal-version: >= 1.10 -name: splitmix -version: 0.0.1 - -synopsis: Fast Splittable PRNG +cabal-version: >=1.10 +name: splitmix +version: 0.0.2 +synopsis: Fast Splittable PRNG description: Pure Haskell implementation of SplitMix described in . @@ -27,19 +26,14 @@ (the mixing functions are easily inverted, and two successive outputs suffice to reconstruct the internal state). -license: BSD3 -license-file: LICENSE -maintainer: Oleg Grenrus -bug-reports: https://github.com/phadej/splitmix#issues -category: System -build-type: Simple +license: BSD3 +license-file: LICENSE +maintainer: Oleg Grenrus +bug-reports: https://github.com/phadej/splitmix#issues +category: System +build-type: Simple tested-with: - GHC==7.6.3, - GHC==7.8.4, - GHC==7.10.3, - GHC==8.0.2, - GHC==8.2.2, - GHC==8.4.2 + GHC ==8.6.4 || ==8.4.4 || ==8.2.2 || ==8.0.2 || ==7.10.3 || ==7.8.4 || ==7.6.3 || ==7.4.2 || ==7.2.2 || ==7.0.4 extra-source-files: README.md @@ -49,18 +43,18 @@ default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src - exposed-modules: - System.Random.SplitMix - build-depends: - base >=4.5 && <4.12, - deepseq >=1.3.0.1 && <1.5, - time >=1.4.0.1 && <1.9, - random >=1.1 && <1.2 + exposed-modules: System.Random.SplitMix -- dump-core -- build-depends: dump-core -- ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html + build-depends: + base >=4.3 && <4.13 + , deepseq >=1.3.0.0 && <1.5 + , random >=1.0 && <1.2 + , time >=1.2.0.3 && <1.9 + source-repository head type: git location: https://github.com/phadej/splitmix.git @@ -72,12 +66,12 @@ hs-source-dirs: bench main-is: Bench.hs build-depends: - base, - splitmix, - random, - containers >=0.5 && <0.6, - tf-random >=0.5 && <0.6, - criterion >=1.1.0.0 && <1.5 + base + , containers >=0.4.2.1 && <0.7 + , criterion >=1.1.0.0 && <1.6 + , random + , splitmix + , tf-random >=0.5 && <0.6 test-suite montecarlo-pi type: exitcode-stdio-1.0 @@ -86,8 +80,8 @@ hs-source-dirs: tests main-is: SplitMixPi.hs build-depends: - base, - splitmix + base + , splitmix test-suite splitmix-dieharder type: exitcode-stdio-1.0 @@ -96,13 +90,13 @@ hs-source-dirs: tests main-is: Dieharder.hs build-depends: - base, - splitmix, - random, - deepseq, - async >=2.2.1 && <2.3, - vector >=0.12.0.1 && <0.13, - base-compat-batteries >=0.10.1 && <0.11, - bytestring >=0.10.4.0 && <0.11, - process >=1.1.0.2 && <1.7, - tf-random >=0.5 && <0.6 + async >=2.2.1 && <2.3 + , base + , base-compat-batteries >=0.10.5 && <0.11 + , bytestring >=0.9.1.8 && <0.11 + , deepseq + , process >=1.0.1.5 && <1.7 + , random + , splitmix + , tf-random >=0.5 && <0.6 + , vector >=0.11.0.0 && <0.13 diff --git a/src/System/Random/SplitMix.hs b/src/System/Random/SplitMix.hs --- a/src/System/Random/SplitMix.hs +++ b/src/System/Random/SplitMix.hs @@ -23,7 +23,16 @@ -- because generated sequences of pseudorandom values are too predictable -- (the mixing functions are easily inverted, and two successive outputs -- suffice to reconstruct the internal state). +-- +-- Note: This module supports all GHCs since GHC-7.0.4, +-- but GHC-7.0 and GHC-7.2 have slow implementation, as there +-- are no native 'popCount'. +-- +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} +#endif module System.Random.SplitMix ( SMGen, nextWord64, @@ -40,7 +49,7 @@ ) where import Control.DeepSeq (NFData (..)) -import Data.Bits (popCount, shiftL, shiftR, xor, (.|.)) +import Data.Bits (shiftL, shiftR, xor, (.|.)) import Data.IORef (IORef, atomicModifyIORef, newIORef) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word32, Word64) @@ -49,25 +58,62 @@ import qualified System.Random as R +#if MIN_VERSION_base(4,5,0) +import Data.Bits (popCount) +#else +import Data.Bits ((.&.)) +popCount :: Word64 -> Int +popCount = go 0 + where + go !c 0 = c + go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant +#endif + +-- $setup +-- >>> import Text.Read (readMaybe) +-- >>> import Data.List (unfoldr) +-- >>> import Text.Printf (printf) + ------------------------------------------------------------------------------- -- Generator ------------------------------------------------------------------------------- -- | SplitMix generator state. -data SMGen = SMGen - { _seed :: !Word64 - , _gamma :: !Word64 -- ^ always odd - } +data SMGen = SMGen !Word64 !Word64 -- seed and gamma; gamma is odd deriving Show instance NFData SMGen where rnf (SMGen _ _) = () +-- | +-- +-- >>> readMaybe "SMGen 1 1" :: Maybe SMGen +-- Just (SMGen 1 1) +-- +-- >>> readMaybe "SMGen 1 2" :: Maybe SMGen +-- Nothing +-- +-- >>> readMaybe (show (mkSMGen 42)) :: Maybe SMGen +-- Just (SMGen 9297814886316923340 13679457532755275413) +-- +instance Read SMGen where + readsPrec d r = readParen (d > 10) (\r0 -> + [ (SMGen seed gamma, r3) + | ("SMGen", r1) <- lex r0 + , (seed, r2) <- readsPrec 11 r1 + , (gamma, r3) <- readsPrec 11 r2 + , odd gamma + ]) r + ------------------------------------------------------------------------------- -- Operations ------------------------------------------------------------------------------- -- | Generate a 'Word64'. +-- +-- >>> take 3 $ map (printf "%x") $ unfoldr (Just . nextWord64) (mkSMGen 1337) :: [String] +-- ["b5c19e300e8b07b3","d600e0e216c0ac76","c54efc3b3cc5af29"] +-- nextWord64 :: SMGen -> (Word64, SMGen) nextWord64 (SMGen seed gamma) = (mix64 seed', SMGen seed' gamma) where @@ -79,6 +125,10 @@ (w64, g') -> (fromIntegral w64, g') -- | Generate a 'Double' in @[0, 1)@ range. +-- +-- >>> take 8 $ map (printf "%0.3f") $ unfoldr (Just . nextDouble) (mkSMGen 1337) :: [String] +-- ["0.710","0.836","0.771","0.409","0.297","0.527","0.589","0.067"] +-- nextDouble :: SMGen -> (Double, SMGen) nextDouble g = case nextWord64 g of (w64, g') -> (fromIntegral (w64 `shiftR` 11) * doubleUlp, g') @@ -144,6 +194,10 @@ ------------------------------------------------------------------------------- -- | Create 'SMGen' using seed and gamma. +-- +-- >>> seedSMGen 2 2 +-- SMGen 2 3 +-- seedSMGen :: Word64 -- ^ seed -> Word64 -- ^ gamma @@ -159,6 +213,10 @@ unseedSMGen (SMGen seed gamma) = (seed, gamma) -- | Preferred way to deterministically construct 'SMGen'. +-- +-- >>> mkSMGen 42 +-- SMGen 9297814886316923340 13679457532755275413 +-- mkSMGen :: Word64 -> SMGen mkSMGen s = SMGen (mix64 s) (mixGamma (s + goldenGamma)) diff --git a/tests/Dieharder.hs b/tests/Dieharder.hs --- a/tests/Dieharder.hs +++ b/tests/Dieharder.hs @@ -9,6 +9,7 @@ import Control.Concurrent.QSem import Control.DeepSeq (force) import Data.Bits (shiftL, (.|.)) +import Data.Char (isSpace) import Data.List (isInfixOf, unfoldr) import Data.Maybe (fromMaybe) import Data.Word (Word64) @@ -17,8 +18,7 @@ import GHC.IO.Exception (IOErrorType (..), IOException (..)) import System.Environment (getArgs) import System.IO (Handle, hGetContents) -import Text.Read (readMaybe) -import Text.Printf (printf) +import Text.Printf (printf) import qualified Control.Concurrent.Async as A import qualified Control.Exception as E @@ -166,6 +166,21 @@ else return gen' {-# INLINE generate #-} +------------------------------------------------------------------------------- +-- readMaybe +------------------------------------------------------------------------------- + +readEither :: Read a => String -> Either String a +readEither s = + case [ x | (x,rest) <- reads s, all isSpace rest ] of + [x] -> Right x + [] -> Left "Prelude.read: no parse" + _ -> Left "Prelude.read: ambiguous parse" + +readMaybe :: Read a => String -> Maybe a +readMaybe s = case readEither s of + Left _ -> Nothing + Right a -> Just a ------------------------------------------------------------------------------- -- Do it yourself command line parsing -------------------------------------------------------------------------------