splitmix 0.1.0.1 → 0.1.0.2
raw patch · 8 files changed
+216/−44 lines, 8 filesdep ~base
Dependency ranges changed: base
Files
- Changelog.md +10/−0
- cbits-unix/init.c +39/−0
- cbits-win/init.c +28/−0
- splitmix.cabal +41/−7
- src/System/Random/SplitMix.hs +4/−19
- src/System/Random/SplitMix/Init.hs +58/−0
- src/System/Random/SplitMix32.hs +8/−18
- tests/Initialization.hs +28/−0
Changelog.md view
@@ -1,3 +1,13 @@+# 0.1.0.2++- Drop `time` dependency in favour of handcoded initialization+ - On Unix platforms we use `/dev/urandom` if it exists,+ otherwise use `gettimeofday`, `clock` and `getpid`.+ - On Windows we use `GetCurrentProcessID`, `GetCurrentThreadId()`,+ `GetTickCount`, `GetSystemTime` and `QueryPerformanceCounter`.+ - On GHCJS use `Math.random()`+ - Using `time` is a fallback option (e.g. for Hugs).+ # 0.1.0.1 - Add `INLINEABLE` pragmas to `bitmaskWithRejection*` functions
+ cbits-unix/init.c view
@@ -0,0 +1,39 @@+#include <stdint.h>+#include <stdio.h>+#include <sys/time.h>+#include <sys/types.h>+#include <time.h>+#include <unistd.h>++uint64_t splitmix_init() {++ /* if there is /dev/urandom, read from it */+ FILE *urandom = fopen("/dev/urandom", "r");+ if (urandom) {+ uint64_t result = 0;+ size_t r = fread(&result, sizeof(uint64_t), 1, urandom);+ fclose(urandom);++ if (r == 1) {+ return result;+ } else {+ return 0xfeed1000;+ }++ } else {+ /* time of day */+ struct timeval tp = {0, 0};+ gettimeofday(&tp, NULL);++ /* cputime */+ clock_t c = clock();++ /* process id */+ pid_t p = getpid();++ return ((uint64_t) tp.tv_sec)+ ^ ((uint64_t) tp.tv_usec)+ ^ ((uint64_t) c << 16)+ ^ ((uint64_t) p << 32);+ }+}
+ cbits-win/init.c view
@@ -0,0 +1,28 @@+#include <stdint.h>++#include <Windows.h>++uint64_t splitmix_init() {+ /* Handy list at https://stackoverflow.com/a/3487338/1308058 */++ uint64_t a = GetCurrentProcessId(); /* DWORD */+ uint64_t b = GetCurrentThreadId(); /* DWORD */+ uint64_t c = GetTickCount(); /* DWORD */++ SYSTEMTIME t = {0,0,0,0,0,0,0,0};+ GetSystemTime(&t);++ LARGE_INTEGER i;+ QueryPerformanceCounter(&i);++ return a ^ (b << 32) ^ (c << 16)+ ^ ((uint64_t) t.wYear << 56)+ ^ ((uint64_t) t.wMonth << 48)+ ^ ((uint64_t) t.wDayOfWeek << 40)+ ^ ((uint64_t) t.wDay << 32)+ ^ ((uint64_t) t.wHour << 24)+ ^ ((uint64_t) t.wMinute << 16)+ ^ ((uint64_t) t.wSecond << 8)+ ^ ((uint64_t) t.wMilliseconds << 0)+ ^ ((uint64_t) i.QuadPart);+}
splitmix.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: splitmix-version: 0.1.0.1+version: 0.1.0.2 synopsis: Fast Splittable PRNG description: Pure Haskell implementation of SplitMix described in@@ -29,7 +29,7 @@ license: BSD3 license-file: LICENSE maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>-bug-reports: https://github.com/phadej/splitmix/issues+bug-reports: https://github.com/haskellari/splitmix/issues category: System, Random build-type: Simple tested-with:@@ -43,8 +43,8 @@ || ==8.2.2 || ==8.4.4 || ==8.6.5- || ==8.8.3- || ==8.10.1+ || ==8.8.4+ || ==8.10.2 , GHCJS ==8.4 extra-source-files:@@ -62,11 +62,14 @@ default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src src-compat- other-modules: Data.Bits.Compat exposed-modules: System.Random.SplitMix System.Random.SplitMix32 + other-modules:+ Data.Bits.Compat+ System.Random.SplitMix.Init+ -- dump-core -- build-depends: dump-core -- ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html@@ -74,14 +77,34 @@ build-depends: base >=4.3 && <4.16 , deepseq >=1.3.0.0 && <1.5- , time >=1.2.0.3 && <1.11 if flag(optimised-mixer) cpp-options: -DOPTIMISED_MIX32=1 + -- We don't want to depend on time, nor unix or Win32 packages+ -- because it's valuable that splitmix and QuickCheck doesn't+ -- depend on about anything++ if impl(ghcjs)+ cpp-options: -DSPLITMIX_INIT_GHCJS=1++ else+ if impl(ghc)+ cpp-options: -DSPLITMIX_INIT_C=1++ if os(windows)+ c-sources: cbits-win/init.c++ else+ c-sources: cbits-unix/init.c++ else+ cpp-options: -DSPLITMIX_INIT_COMPAT=1+ build-depends: time >=1.2.0.3 && <1.11+ source-repository head type: git- location: https://github.com/phadej/splitmix.git+ location: https://github.com/haskellari/splitmix.git benchmark comparison type: exitcode-stdio-1.0@@ -189,3 +212,14 @@ , splitmix , tf-random >=0.5 && <0.6 , vector >=0.11.0.0 && <0.13++test-suite initialization+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ ghc-options: -Wall -threaded -rtsopts+ hs-source-dirs: tests+ main-is: Initialization.hs+ build-depends:+ base+ , splitmix+ , HUnit ==1.3.1.2 || >=1.6.0.0 && <1.7
src/System/Random/SplitMix.hs view
@@ -57,10 +57,11 @@ import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.)) import Data.Bits.Compat (countLeadingZeros, popCount, zeroBits) import Data.IORef (IORef, atomicModifyIORef, newIORef)-import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word32, Word64) import System.IO.Unsafe (unsafePerformIO) +import System.Random.SplitMix.Init+ #if defined(__HUGS__) || !MIN_VERSION_base(4,8,0) import Data.Word (Word) #endif@@ -69,10 +70,6 @@ import Control.DeepSeq (NFData (..)) #endif -#if !__GHCJS__-import System.CPUTime (cpuTimePrecision, getCPUTime)-#endif- -- $setup -- >>> import Text.Read (readMaybe) -- >>> import Data.List (unfoldr)@@ -379,9 +376,9 @@ mkSMGen :: Word64 -> SMGen mkSMGen s = SMGen (mix64 s) (mixGamma (s `plus` goldenGamma)) --- | Initialize 'SMGen' using system time.+-- | Initialize 'SMGen' using entropy available on the system (time, ...) initSMGen :: IO SMGen-initSMGen = fmap mkSMGen mkSeedTime+initSMGen = fmap mkSMGen initialSeed -- | Derive a new generator instance from the global 'SMGen' using 'splitSMGen'. newSMGen :: IO SMGen@@ -390,18 +387,6 @@ theSMGen :: IORef SMGen theSMGen = unsafePerformIO $ initSMGen >>= newIORef {-# NOINLINE theSMGen #-}--mkSeedTime :: IO Word64-mkSeedTime = do- now <- getPOSIXTime- let lo = truncate now :: Word32-#if __GHCJS__- let hi = lo-#else- cpu <- getCPUTime- let hi = fromIntegral (cpu `div` cpuTimePrecision) :: Word32-#endif- return $ fromIntegral hi `shiftL` 32 .|. fromIntegral lo ------------------------------------------------------------------------------- -- Hugs
+ src/System/Random/SplitMix/Init.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE CPP #-}+-- | Initialization of global generator.+module System.Random.SplitMix.Init (+ initialSeed,+) where++import Data.Word (Word64)++#if defined(SPLITMIX_INIT_GHCJS) && __GHCJS__++import Data.Word (Word32)++#else+#if defined(SPLITMIX_INIT_C)++#else++import Data.Bits (xor)+import Data.Time.Clock.POSIX (getPOSIXTime)+#if !__GHCJS__+import System.CPUTime (cpuTimePrecision, getCPUTime)+#endif++#endif+#endif++initialSeed :: IO Word64++#if defined(SPLITMIX_INIT_GHCJS) && __GHCJS__++initialSeed = fmap fromIntegral initialSeedJS++foreign import javascript+ "$r = Math.floor(Math.random()*0x100000000);"+ initialSeedJS :: IO Word32++#else+#if defined(SPLITMIX_INIT_C)++initialSeed = initialSeedC++foreign import ccall "splitmix_init" initialSeedC :: IO Word64++#else++initialSeed = do+ now <- getPOSIXTime+ let timebits = truncate now :: Word64+#if __GHCJS__+ let cpubits = 0+#else+ cpu <- getCPUTime+ let cpubits = fromIntegral (cpu `div` cpuTimePrecision) :: Word64+#endif+ return $ timebits `xor` cpubits++#endif+#endif
src/System/Random/SplitMix32.hs view
@@ -41,10 +41,11 @@ import Data.Bits.Compat (countLeadingZeros, finiteBitSize, popCount, zeroBits) import Data.IORef (IORef, atomicModifyIORef, newIORef)-import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word32, Word64) import System.IO.Unsafe (unsafePerformIO) +import System.Random.SplitMix.Init+ #if defined(__HUGS__) || !MIN_VERSION_base(4,8,0) import Data.Word (Word) #endif@@ -53,10 +54,6 @@ import Control.DeepSeq (NFData (..)) #endif -#if !__GHCJS__-import System.CPUTime (cpuTimePrecision, getCPUTime)-#endif- -- $setup -- >>> import Text.Read (readMaybe) -- >>> import Data.List (unfoldr)@@ -359,9 +356,9 @@ mkSMGen :: Word32 -> SMGen mkSMGen s = SMGen (mix32 s) (mixGamma (s + goldenGamma)) --- | Initialize 'SMGen' using system time.+-- | Initialize 'SMGen' using entropy available on the system (time, ...) initSMGen :: IO SMGen-initSMGen = fmap mkSMGen mkSeedTime+initSMGen = fmap mkSMGen initialSeed' -- | Derive a new generator instance from the global 'SMGen' using 'splitSMGen'. newSMGen :: IO SMGen@@ -371,14 +368,7 @@ theSMGen = unsafePerformIO $ initSMGen >>= newIORef {-# NOINLINE theSMGen #-} -mkSeedTime :: IO Word32-mkSeedTime = do- now <- getPOSIXTime- let lo = truncate now :: Word32-#if __GHCJS__- let hi = lo-#else- cpu <- getCPUTime- let hi = fromIntegral (cpu `div` cpuTimePrecision) :: Word32-#endif- return $ fromIntegral hi `shiftL` 32 .|. fromIntegral lo+initialSeed' :: IO Word32+initialSeed' = do+ w64 <- initialSeed+ return (fromIntegral (shiftL w64 32) `xor` fromIntegral w64)
+ tests/Initialization.hs view
@@ -0,0 +1,28 @@+module Main (main) where++import Control.Monad (forM_, replicateM)+import Data.List (tails)+import Test.HUnit (assertFailure)++import qualified System.Random.SplitMix as SM+import qualified System.Random.SplitMix32 as SM32++main :: IO ()+main = do+ g64 <- replicateM 10 (fmap show SM.initSMGen)+ putStrLn $ unlines g64+ forM_ (tails g64) $ \xs' -> case xs' of+ [] -> return ()+ (x:xs) ->+ if all (x /=) xs+ then return ()+ else assertFailure "ERROR: duplicate"++ g32 <- replicateM 10 (fmap show SM32.initSMGen)+ putStrLn $ unlines g32+ forM_ (tails g32) $ \xs' -> case xs' of+ [] -> return ()+ (x:xs) ->+ if all (x /=) xs+ then return ()+ else assertFailure "ERROR: duplicate"