X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FRandom.lhs;h=a6c00550f457d6390017078fc811d15218538db5;hb=871db587eda4fcba3fdc049b225a1d63a4ebe641;hp=a1a7e22e98c53cecbc5be638ee796e9c28f0a331;hpb=0d65c1627fcb0aa951c6457c879fdd7626e83a62;p=ghc-hetmet.git diff --git a/ghc/lib/std/Random.lhs b/ghc/lib/std/Random.lhs index a1a7e22..a6c0055 100644 --- a/ghc/lib/std/Random.lhs +++ b/ghc/lib/std/Random.lhs @@ -1,7 +1,10 @@ +% ------------------------------------------------------------------------------ +% $Id: Random.lhs,v 1.24 2001/02/28 00:01:03 qrczak Exp $ % -% (c) The GRASP/AQUA Project, Glasgow University, 1995-99 +% (c) The University of Glasgow, 1995-2000 % +\section[Random]{Module @Random@} The June 1988 (v31 #6) issue of the Communications of the ACM has an article by Pierre L'Ecuyer called, "Efficient and Portable Combined @@ -28,16 +31,24 @@ module Random , newStdGen ) where -import CPUTime (getCPUTime) -import PrelST -import PrelRead -import PrelIOBase -import PrelNumExtra ( float2Double, double2Float ) -import PrelBase -import PrelArr -import Char ( isSpace, chr, ord ) -import Time (getClockTime, ClockTime(..)) - +#ifndef __HUGS__ +import PrelGHC ( RealWorld ) +import PrelShow ( showSignedInt, showSpace ) +import PrelRead ( readDec ) +import PrelIOBase ( unsafePerformIO, stToIO ) +import PrelArr ( STRef, newSTRef, readSTRef, writeSTRef ) +import Time ( getClockTime, ClockTime(..) ) +#else +import PrelPrim ( IORef + , newIORef + , readIORef + , writeIORef + , unsafePerformIO + ) +#endif + +import CPUTime ( getCPUTime ) +import Char ( isSpace, chr, ord ) \end{code} \begin{code} @@ -52,26 +63,42 @@ data StdGen = StdGen Int Int instance RandomGen StdGen where - next = rand1 - split = splitStdGen + next = stdNext + split = stdSplit +#ifdef __HUGS__ +instance Show StdGen where + showsPrec p (StdGen s1 s2) = + showsPrec p s1 . + showChar ' ' . + showsPrec p s2 +#else instance Show StdGen where showsPrec p (StdGen s1 s2) = showSignedInt p s1 . showSpace . showSignedInt p s2 +#endif instance Read StdGen where - readsPrec p = \ r -> + readsPrec _p = \ r -> case try_read r of r@[_] -> r - _ -> [(unsafePerformIO mkStdRNG,r)] -- because it shouldn't ever fail. + _ -> [stdFromString r] -- because it shouldn't ever fail. where try_read r = do (s1, r1) <- readDec (dropWhile isSpace r) (s2, r2) <- readDec (dropWhile isSpace r1) return (StdGen s1 s2, r2) +{- + If we cannot unravel the StdGen from a string, create + one based on the string given. +-} +stdFromString :: String -> (StdGen, String) +stdFromString s = (mkStdGen num, rest) + where (cs, rest) = splitAt 6 s + num = foldl (\a x -> x + 3 * a) 1 (map ord cs) \end{code} \begin{code} @@ -86,32 +113,32 @@ mkStdGen s createStdGen :: Integer -> StdGen createStdGen s | s < 0 = createStdGen (-s) - | otherwise = StdGen (toInt (s1+1)) (toInt (s2+1)) + | otherwise = StdGen (fromInteger (s1+1)) (fromInteger (s2+1)) where (q, s1) = s `divMod` 2147483562 s2 = q `mod` 2147483398 \end{code} -\begin{code} +The class definition - see library report for details. --- Q: do all of these merit class membership? +\begin{code} class Random a where - randomR :: RandomGen g => (a,a) -> g -> (a,g) + -- Minimal complete definition: random and randomR random :: RandomGen g => g -> (a, g) + randomR :: RandomGen g => (a,a) -> g -> (a,g) - randomRs :: RandomGen g => (a,a) -> g -> [a] randoms :: RandomGen g => g -> [a] - - randomRIO :: (a,a) -> IO a - randomIO :: IO a - randoms g = x : randoms g' where (x,g') = random g + + randomRs :: RandomGen g => (a,a) -> g -> [a] randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g - + + randomIO :: IO a randomIO = getStdRandom random - randomRIO range = getStdRandom (randomR range) + randomRIO :: (a,a) -> IO a + randomRIO range = getStdRandom (randomR range) \end{code} \begin{code} @@ -148,23 +175,29 @@ instance Random Double where -- hah, so you thought you were saving cycles by using Float? instance Random Float where - randomR (a,b) g = randomIvalDouble (float2Double a, float2Double b) double2Float g - random g = randomIvalDouble (0::Double,1) double2Float g - + random g = randomIvalDouble (0::Double,1) realToFrac g + randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g \end{code} \begin{code} -mkStdRNG :: IO StdGen -mkStdRNG = do +#ifdef __HUGS__ +mkStdRNG :: Integer -> IO StdGen +mkStdRNG o = do + ct <- getCPUTime + return (createStdGen (ct + o)) +#else +mkStdRNG :: Integer -> IO StdGen +mkStdRNG o = do ct <- getCPUTime (TOD sec _) <- getClockTime - return (createStdGen (sec * 12345 + ct)) + return (createStdGen (sec * 12345 + ct + o)) +#endif 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 (v `mod` (k+1)), rng') + | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng') where k = h - l + 1 b = 2147483561 @@ -175,7 +208,7 @@ randomIvalInteger (l,h) rng let (x,g') = next g in - f (n-1) (fromInt x + acc * b) g' + f (n-1) (fromIntegral x + acc * b) g' randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g) randomIvalDouble (l,h) fromDouble rng @@ -185,18 +218,20 @@ randomIvalDouble (l,h) fromDouble rng (x, rng') -> let scaled_x = - fromDouble l + - fromDouble (h-l) * - (fromIntegral (x::Int) * 4.6566130638969828e-10) - -- magic number stolen from old HBC code (Random.randomDoubles.) + fromDouble ((l+h)/2) + + fromDouble ((h-l) / realToFrac intRange) * + fromIntegral (x::Int) in (scaled_x, rng') +intRange :: Integer +intRange = toInteger (maxBound::Int) - toInteger (minBound::Int) + iLogBase :: Integer -> Integer -> Integer iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b) -rand1 :: StdGen -> (Int, StdGen) -rand1 (StdGen s1 s2) = (z', StdGen s1'' s2'') +stdNext :: StdGen -> (Int, StdGen) +stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'') where z' = if z < 1 then z + 2147483562 else z z = s1'' - s2'' @@ -208,34 +243,51 @@ rand1 (StdGen s1 s2) = (z', StdGen s1'' s2'') s2' = 40692 * (s2 - k' * 52774) - k' * 3791 s2'' = if s2' < 0 then s2' + 2147483399 else s2' -splitStdGen :: StdGen -> (StdGen, StdGen) -splitStdGen std@(StdGen s1 s2) = (std, StdGen new_s1 new_s2) - where - -- simple in the extreme.. - new_s1 - | s1 == 2147483562 = 1 - | otherwise = s1 + 1 +stdSplit :: StdGen -> (StdGen, StdGen) +stdSplit std@(StdGen s1 s2) + = (left, right) + where + -- no statistical foundation for this! + left = StdGen new_s1 t2 + right = StdGen t1 new_s2 - new_s2 - | s2 == 1 = 2147483398 - | otherwise = s2 - 1 + new_s1 | s1 == 2147483562 = 1 + | otherwise = s1 + 1 - - + new_s2 | s2 == 1 = 2147483398 + | otherwise = s2 - 1 + + StdGen t1 t2 = snd (next std) \end{code} \begin{code} -global_rng :: MutableVar RealWorld StdGen +#ifdef __HUGS__ + +setStdGen :: StdGen -> IO () +setStdGen sgen = writeIORef theStdGen sgen + +getStdGen :: IO StdGen +getStdGen = readIORef theStdGen + +theStdGen :: IORef StdGen +theStdGen = unsafePerformIO (newIORef (createStdGen 0)) + +#else + +global_rng :: STRef RealWorld StdGen global_rng = unsafePerformIO $ do - rng <- mkStdRNG - stToIO (newVar rng) + rng <- mkStdRNG 0 + stToIO (newSTRef rng) setStdGen :: StdGen -> IO () -setStdGen sgen = stToIO (writeVar global_rng sgen) +setStdGen sgen = stToIO (writeSTRef global_rng sgen) getStdGen :: IO StdGen -getStdGen = stToIO (readVar global_rng) +getStdGen = stToIO (readSTRef global_rng) + +#endif + newStdGen :: IO StdGen newStdGen = do