, 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 PrelNum ( fromInt )
+import PrelShow ( showSignedInt, showSpace )
+import PrelRead ( readDec )
+import PrelIOBase ( unsafePerformIO, stToIO )
+import PrelArr ( MutableVar, newVar, readVar, writeVar )
+import PrelReal ( toInt )
+import CPUTime ( getCPUTime )
+import PrelFloat ( float2Double, double2Float )
+import Time ( getClockTime, ClockTime(..) )
+#endif
+import Char ( isSpace, chr, ord )
\end{code}
\begin{code}
= 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}
\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}
random g = randomR (0::Double,1) g
-- hah, so you thought you were saving cycles by using Float?
+
+#ifdef __HUGS__
+instance Random Float where
+ random g = randomIvalDouble (0::Double,1) realToFrac g
+ randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g
+#else
instance Random Float where
randomR (a,b) g = randomIvalDouble (float2Double a, float2Double b) double2Float g
random g = randomIvalDouble (0::Double,1) double2Float g
+#endif
\end{code}
\begin{code}
-mkStdRNG :: IO StdGen
-mkStdRNG = do
+#ifdef __HUGS__
+mkStdRNG :: Integer -> IO StdGen
+mkStdRNG o = return (createStdGen 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
(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''
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
-
- new_s2
- | s2 == 1 = 2147483398
- | otherwise = s2 - 1
-
-
-
+#ifdef __HUGS__
+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_s1 | s1 == 2147483562 = 1
+ | otherwise = s1 + 1
+
+ new_s2 | s2 == 1 = 2147483398
+ | otherwise = s2 - 1
+
+ StdGen t1 t2 = snd (next std)
+#else
+stdSplit :: StdGen -> (StdGen, StdGen)
+stdSplit std@(StdGen s1 _) = (std, unsafePerformIO (mkStdRNG (fromInt s1)))
+#endif
\end{code}
\begin{code}
+#ifdef __HUGS__
+
+setStdGen :: StdGen -> IO ()
+setStdGen sgen = writeIORef theStdGen sgen
+
+getStdGen :: IO StdGen
+getStdGen = readIORef theStdGen
+
+theStdGen :: IORef StdGen
+theStdGen = primRunST (newIORef (createStdGen 0))
+
+#else
+
global_rng :: MutableVar RealWorld StdGen
global_rng = unsafePerformIO $ do
- rng <- mkStdRNG
+ rng <- mkStdRNG 0
stToIO (newVar rng)
setStdGen :: StdGen -> IO ()
getStdGen :: IO StdGen
getStdGen = stToIO (readVar global_rng)
+#endif
+
+
newStdGen :: IO StdGen
newStdGen = do
rng <- getStdGen
projects / ghc-hetmet.git / blobdiff