On Sat, Jul 10, 2010 at 7:09 PM, Bryan O'Sullivan <b...@serpentine.com>wrote:

> If you could shed any light, I'd be most grateful, as this has me a bit
> confounded.
>

As a further data point, the attached patch replaces uses of PrimMonad with
ST, and speeds performance back to 0.015 seconds, so it's clearly the use of
primitive, and not the switch from uvector to vector, that causes the
performance loss.
diff -rN -u old-mwc-random/System/Random/MWC.hs new-mwc-random/System/Random/MWC.hs
--- old-mwc-random/System/Random/MWC.hs	2010-07-10 19:36:14.143420542 +0100
+++ new-mwc-random/System/Random/MWC.hs	2010-07-10 19:36:14.145419774 +0100
@@ -95,7 +95,7 @@
     -- To generate a 'Float' variate with a range of [0,1), subtract
     -- 2**(-33).  To do the same with 'Double' variates, subtract
     -- 2**(-53).
-    uniform :: (PrimMonad m) => Gen (PrimState m) -> m a
+    uniform :: Gen s -> ST s a
 
 -- Thanks to Duncan Coutts for finding the pattern below for
 -- strong-arming GHC 6.10's inliner into behaving itself.  This makes
@@ -224,7 +224,7 @@
 coff = 257
 
 -- | Create a generator for variates using a fixed seed.
-create :: PrimMonad m => m (Gen (PrimState m))
+create :: ST s (Gen s)
 create = initialize defaultSeed
 {-# INLINE create #-}
 
@@ -242,7 +242,7 @@
 -- If a seed contains fewer than 256 elements, it is first used
 -- verbatim, then its elements are 'xor'ed against elements of the
 -- default seed until 256 elements are reached.
-initialize :: PrimMonad m => I.Vector Word32 -> m (Gen (PrimState m))
+initialize :: I.Vector Word32 -> ST s (Gen s)
 initialize seed = do
     q <- M.unsafeNew 258
     fill q
@@ -281,7 +281,7 @@
 -- | Using the current time as a seed, perform an action that uses a
 -- random variate generator.  This is a horrible fallback for Windows
 -- systems.
-withTime :: (PrimMonad m) => (Gen (PrimState m) -> m a) -> IO a
+withTime :: (Gen s -> ST s a) -> IO a
 withTime act = do
   c <- (numerator . (%cpuTimePrecision)) `liftM` getCPUTime
   t <- toRational `liftM` getPOSIXTime
@@ -297,7 +297,7 @@
 -- Cryptographic API as a source of random numbers (it uses the system
 -- clock instead). As a result, the sequences it generates may not be
 -- highly independent.
-withSystemRandom :: PrimMonad m => (Gen (PrimState m) -> m a) -> IO a
+withSystemRandom :: (Gen s -> ST s a) -> IO a
 withSystemRandom act = tryRandom `catch` \(_::IOException) -> do
     seen <- atomicModifyIORef warned ((,) True)
     unless seen $ do
@@ -330,7 +330,7 @@
 nextIndex i = fromIntegral j
     where j = fromIntegral (i+1) :: Word8
 
-uniformWord32 :: PrimMonad m => Gen (PrimState m) -> m Word32
+uniformWord32 :: Gen s -> ST s Word32
 uniformWord32 (Gen q) = do
   let a = 809430660 :: Word64
   i <- nextIndex `liftM` M.unsafeRead q ioff
@@ -344,13 +344,13 @@
   return t32
 {-# INLINE uniformWord32 #-}
 
-uniform1 :: PrimMonad m => (Word32 -> a) -> Gen (PrimState m) -> m a
+uniform1 :: (Word32 -> a) -> Gen s -> ST s a
 uniform1 f gen = do
   i <- uniformWord32 gen
   return $! f i
 {-# INLINE uniform1 #-}
 
-uniform2 :: PrimMonad m => (Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
+uniform2 :: (Word32 -> Word32 -> a) -> Gen s -> ST s a
 uniform2 f (Gen q) = do
   let a = 809430660 :: Word64
   i <- nextIndex `liftM` M.unsafeRead q ioff
@@ -373,8 +373,8 @@
 -- | Generate a vector of pseudo-random variates.  This is not
 -- necessarily faster than invoking 'uniform' repeatedly in a loop,
 -- but it may be more convenient to use in some situations.
-uniformVector :: (PrimMonad m, Variate a)
-             => Gen (PrimState m) -> Int -> m (I.Vector a)
+uniformVector :: (Variate a)
+             => Gen s -> Int -> ST s (I.Vector a)
 uniformVector gen n = do
   mu <- M.unsafeNew n
   let go !i | i < n     = uniform gen >>= M.unsafeWrite mu i >> go (i+1)
@@ -390,7 +390,7 @@
 -- Compared to the ziggurat algorithm usually used, this is slower,
 -- but generates more independent variates that pass stringent tests
 -- of randomness.
-normal :: PrimMonad m => Gen (PrimState m) -> m Double
+normal :: Gen s -> ST s Double
 normal gen = loop
   where
     loop = do
_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

Reply via email to