diff --git a/System/Random.hs b/System/Random.hs --- a/System/Random.hs +++ b/System/Random.hs @@ -96,6 +96,15 @@ import Data.IORef import Numeric ( readDec ) +#ifdef __GLASGOW_HASKELL__ +import GHC.Exts ( build ) +#else +-- | A dummy variant of build without fusion. +{-# INLINE build #-} +build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] +build g = g (:) [] +#endif + -- The standard nhc98 implementation of Time.ClockTime does not match -- the extended one expected in this module, so we lash-up a quick -- replacement here. @@ -189,7 +198,7 @@ -} data StdGen - = StdGen Int32 Int32 + = StdGen !Int32 !Int32 instance RandomGen StdGen where next = stdNext @@ -235,6 +244,11 @@ mkStdGen :: Int -> StdGen -- why not Integer ? mkStdGen s = mkStdGen32 $ fromIntegral s +{- +From ["System.Random\#LEcuyer"]: "The integer variables s1 and s2 ... must be +initialized to values in the range [1, 2147483562] and [1, 2147483398] +respectively." +-} mkStdGen32 :: Int32 -> StdGen mkStdGen32 sMaybeNegative = StdGen (s1+1) (s2+1) where @@ -247,8 +261,6 @@ createStdGen :: Integer -> StdGen createStdGen s = mkStdGen32 $ fromIntegral s --- FIXME: 1/2/3 below should be ** (vs@30082002) XXX - {- | With a source of random number supply in hand, the 'Random' class allows the programmer to extract random values of a variety of types. @@ -279,13 +291,15 @@ -- | Plural variant of 'randomR', producing an infinite list of -- random values instead of returning a new generator. + {-# INLINE randomRs #-} randomRs :: RandomGen g => (a,a) -> g -> [a] - randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g + randomRs ival g = build (\cons _nil -> buildRandoms cons (randomR ival) g) -- | Plural variant of 'random', producing an infinite list of -- random values instead of returning a new generator. + {-# INLINE randoms #-} randoms :: RandomGen g => g -> [a] - randoms g = (\(x,g') -> x : randoms g') (random g) + randoms g = build (\cons _nil -> buildRandoms cons random g) -- | A variant of 'randomR' that uses the global random number generator -- (see "System.Random#globalrng"). @@ -297,7 +311,19 @@ randomIO :: IO a randomIO = getStdRandom random +-- | Produce an infinite list-equivalent of random values. +{-# INLINE buildRandoms #-} +buildRandoms :: RandomGen g + => (a -> as -> as) -- ^ E.g. '(:)' but subject to fusion + -> (g -> (a,g)) -- ^ E.g. 'random' + -> g -- ^ A 'RandomGen' instance + -> as +buildRandoms cons rand = go + where + -- The seq fixes part of #4218 and also makes fused Core simpler. + go g = x `seq` (x `cons` go g') where (x,g') = rand g + instance Random Integer where randomR ival g = randomIvalInteger ival g random g = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g @@ -421,25 +447,34 @@ randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g) randomIvalIntegral (l,h) = randomIvalInteger (toInteger l, toInteger h) +{-# SPECIALIZE randomIvalInteger :: (Num a) => + (Integer, Integer) -> StdGen -> (a, StdGen) #-} + randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g) randomIvalInteger (l,h) rng | l > h = randomIvalInteger (h,l) rng - | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng') + | otherwise = case (f 1 0 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng') where + (genlo, genhi) = genRange rng + b = fromIntegral genhi - fromIntegral genlo + 1 + + -- Probabilities of the most likely and least likely result + -- will differ at most by a factor of (1 +- 1/q). Assuming the RandomGen + -- is uniform, of course + + -- On average, log q / log b more random values will be generated + -- than the minimum + q = 1000 k = h - l + 1 - -- ERROR: b here (2^31-87) represents a baked-in assumption about genRange: - b = 2147483561 - n = iLogBase b k + magtgt = k * q - -- Here we loop until we've generated enough randomness to cover the range: - f 0 acc g = (acc, g) - f n' acc g = - let - (x,g') = next g - in - -- We shift over the random bits generated thusfar (* b) and add in the new ones. - f (n' - 1) (fromIntegral x + acc * b) g' + -- generate random values until we exceed the target magnitude + f mag v g | mag >= magtgt = (v, g) + | otherwise = v' `seq`f (mag*b) v' g' where + (x,g') = next g + v' = (v * b + (fromIntegral x - fromIntegral genlo)) + -- The continuous functions on the other hand take an [inclusive,exclusive) range. randomFrac :: (RandomGen g, Fractional a) => g -> (a, g) randomFrac = randomIvalDouble (0::Double,1) realToFrac @@ -459,17 +494,10 @@ (scaled_x, rng') int32Count :: Integer -int32Count = toInteger (maxBound::Int32) - toInteger (minBound::Int32) + 1 - --- Perform an expensive logarithm on arbitrary-size integers by repeated division. --- --- (NOTE: This actually returns ceiling(log(i) base b) except with an --- incorrect result at iLogBase b b = 2.) -iLogBase :: Integer -> Integer -> Integer -iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b) +int32Count = toInteger (maxBound::Int32) - toInteger (minBound::Int32) + 1 -- GHC ticket #3982 stdRange :: (Int,Int) -stdRange = (0, 2147483562) +stdRange = (1, 2147483562) stdNext :: StdGen -> (Int, StdGen) -- Returns values in the range stdRange @@ -528,7 +556,7 @@ -- |Applies 'split' to the current global random generator, -- updates it with one of the results, and returns the other. newStdGen :: IO StdGen -newStdGen = atomicModifyIORef theStdGen split +newStdGen = atomicModifyIORef' theStdGen split {- |Uses the supplied function to get a value from the current global random generator, and updates the global generator with the new generator @@ -541,7 +569,7 @@ -} getStdRandom :: (StdGen -> (a,StdGen)) -> IO a -getStdRandom f = atomicModifyIORef theStdGen (swap . f) +getStdRandom f = atomicModifyIORef' theStdGen (swap . f) where swap (v,g) = (g,v) {- $references diff --git a/random.cabal b/random.cabal --- a/random.cabal +++ b/random.cabal @@ -1,13 +1,15 @@ name: random -version: 1.0.1.1 +version: 1.0.1.3 -- 1.0.1.0 -- bump for bug fixes, but no SplittableGen yet -- 1.0.1.1 -- bump for overflow bug fixes +-- 1.0.1.2 -- bump for ticket 8704, build fusion +-- 1.0.1.3 -- bump for various bug fixes license: BSD3 license-file: LICENSE maintainer: rrnewton@gmail.com -bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=libraries/random +bug-reports: https://github.com/haskell/random/issues synopsis: random number library category: System description: @@ -15,7 +17,9 @@ library, including the ability to split random number generators. build-type: Simple -Cabal-Version: >= 1.6 +-- cabal-version 1.8 needed because "the field 'build-depends: random' refers +-- to a library which is defined within the same package" +cabal-version: >= 1.8 @@ -28,5 +32,31 @@ source-repository head type: git - location: http://darcs.haskell.org/packages/random.git/ + location: http://git.haskell.org/packages/random.git +-- To run the Test-Suite: +-- $ cabal configure --enable-tests +-- $ cabal test --show-details=always --test-options="+RTS -M1M -RTS" + +Test-Suite T7936 + type: exitcode-stdio-1.0 + main-is: T7936.hs + hs-source-dirs: tests + build-depends: base >= 3 && < 5, random + ghc-options: -rtsopts -O2 + +Test-Suite TestRandomRs + type: exitcode-stdio-1.0 + main-is: TestRandomRs.hs + hs-source-dirs: tests + build-depends: base >= 3 && < 5, random + ghc-options: -rtsopts -O2 + -- TODO. Why does the following not work? + --test-options: +RTS -M1M -RTS + +Test-Suite TestRandomIOs + type: exitcode-stdio-1.0 + main-is: TestRandomIOs.hs + hs-source-dirs: tests + build-depends: base >= 3 && < 5, random + ghc-options: -rtsopts -O2 diff --git a/tests/T7936.hs b/tests/T7936.hs new file mode 100644 --- /dev/null +++ b/tests/T7936.hs @@ -0,0 +1,14 @@ +-- Test for ticket #7936: +-- https://ghc.haskell.org/trac/ghc/ticket/7936 +-- +-- Used to fail with: +-- +-- $ cabal test T7936 --test-options="+RTS -M1M -RTS" +-- T7936: Heap exhausted; + +module Main where + +import System.Random (newStdGen) +import Control.Monad (replicateM_) + +main = replicateM_ 100000 newStdGen diff --git a/tests/TestRandomIOs.hs b/tests/TestRandomIOs.hs new file mode 100644 --- /dev/null +++ b/tests/TestRandomIOs.hs @@ -0,0 +1,20 @@ +-- Test for ticket #4218 (TestRandomIOs): +-- https://ghc.haskell.org/trac/ghc/ticket/4218 +-- +-- Used to fail with: +-- +-- $ cabal test TestRandomIOs --test-options="+RTS -M1M -RTS" +-- TestRandomIOs: Heap exhausted; + +module Main where + +import Control.Monad (replicateM) +import System.Random (randomIO) + +-- Build a list of 5000 random ints in memory (IO Monad is strict), and print +-- the last one. +-- Should use less than 1Mb of heap space, or we are generating a list of +-- unevaluated thunks. +main = do + rs <- replicateM 5000 randomIO :: IO [Int] + print $ last rs diff --git a/tests/TestRandomRs.hs b/tests/TestRandomRs.hs new file mode 100644 --- /dev/null +++ b/tests/TestRandomRs.hs @@ -0,0 +1,22 @@ +-- Test for ticket #4218 (TestRandomRs): +-- https://ghc.haskell.org/trac/ghc/ticket/4218 +-- +-- Fixed together with ticket #8704 +-- https://ghc.haskell.org/trac/ghc/ticket/8704 +-- Commit 4695ffa366f659940369f05e419a4f2249c3a776 +-- +-- Used to fail with: +-- +-- $ cabal test TestRandomRs --test-options="+RTS -M1M -RTS" +-- TestRandomRs: Heap exhausted; + +module Main where + +import Control.Monad (liftM, replicateM) +import System.Random (randomRs, getStdGen) + +-- Return the five-thousandth random number: +-- Should run in constant space (< 1Mb heap). +main = do + n <- (last . take 5000 . randomRs (0, 1000000)) `liftM` getStdGen + print (n::Integer)