[project @ 2001-08-04 06:19:54 by ken]

[ghc-hetmet.git] / ghc / lib / std / Random.lhs

diff --git a/ghc/lib/std/Random.lhs b/ghc/lib/std/Random.lhs
index e6135c2..a6c0055 100644 (file)
--- 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,17 +31,24 @@ module Random
        , newStdGen
        ) where
 
-import CPUTime (getCPUTime)
-import PrelST
-import PrelRead
-import PrelShow
-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}
@@ -56,14 +66,22 @@ instance RandomGen StdGen where
   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
        _   -> [stdFromString r] -- because it shouldn't ever fail.
@@ -95,7 +113,7 @@ 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
@@ -157,18 +175,24 @@ 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}
+#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 + o))
+#endif
 
 randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
 randomIvalInteger (l,h) rng
@@ -184,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 
@@ -219,23 +243,51 @@ stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'')
                s2'  = 40692 * (s2 - k' * 52774) - k' * 3791
                s2'' = if s2' < 0 then s2' + 2147483399 else s2'
 
-stdSplit :: StdGen -> (StdGen, StdGen)
-stdSplit std@(StdGen s1 s2) = (std, unsafePerformIO (mkStdRNG (fromInt s1)))
-       
+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)
 \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 0
-   stToIO (newVar rng)
+   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