diff --git a/random-source.cabal b/random-source.cabal --- a/random-source.cabal +++ b/random-source.cabal @@ -1,8 +1,8 @@ name: random-source -version: 0.3.0.8 +version: 0.3.0.10 stability: provisional -cabal-version: >= 1.6 +cabal-version: >= 1.10 build-type: Simple author: James Cook @@ -48,16 +48,17 @@ Library ghc-options: -Wall hs-source-dirs: src + default-language: Haskell2010 exposed-modules: Data.Random.Source Data.Random.Source.IO - Data.Random.Source.PureMT + Data.Random.Source.RandomGen Data.Random.Source.Std Data.Random.Source.StdGen Data.Random.Internal.Words Data.Random.Internal.Source other-modules: Data.Random.Source.Internal.Prim Data.Random.Source.Internal.TH - + if impl(ghc >= 6.10) -- mwc-random depends on vector, which doesn't build on GHC < 6.10. -- I considered breaking this module out into another package, but I @@ -68,21 +69,21 @@ -- this cabal file is hardly any additional effort. exposed-modules: Data.Random.Source.MWC build-depends: mwc-random - + if flag(mtl2) build-depends: mtl == 2.* cpp-options: -DMTL2 else build-depends: mtl == 1.* - + if flag(base4) build-depends: base >= 4 && <5, syb else build-depends: base >= 3 && <4 - + build-depends: flexible-defaults >= 0.0.0.2, mersenne-random-pure64, - random, + random >= 1.2.0, stateref >= 0.3 && < 0.4, template-haskell, th-extras, diff --git a/src/Data/Random/Source.hs b/src/Data/Random/Source.hs --- a/src/Data/Random/Source.hs +++ b/src/Data/Random/Source.hs @@ -11,7 +11,7 @@ , getRandomDouble , getRandomNByteInteger ) - + , RandomSource ( getRandomWord8From , getRandomWord16From @@ -20,7 +20,7 @@ , getRandomDoubleFrom , getRandomNByteIntegerFrom ) - + , monadRandom, randomSource ) where @@ -30,7 +30,7 @@ import Data.Random.Source.Internal.TH $(randomSource - [d| + [d| instance Monad m => RandomSource m (m Word8) where getRandomWord8From = id |]) diff --git a/src/Data/Random/Source/PureMT.hs b/src/Data/Random/Source/PureMT.hs deleted file mode 100644 --- a/src/Data/Random/Source/PureMT.hs +++ /dev/null @@ -1,162 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell, GADTs #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - --- |This module provides functions useful for implementing new 'MonadRandom' --- and 'RandomSource' instances for state-abstractions containing 'PureMT' --- values (the pure pseudorandom generator provided by the --- mersenne-random-pure64 package), as well as instances for some common --- cases. --- --- A 'PureMT' generator is immutable, so 'PureMT' by itself cannot be a --- 'RandomSource' (if it were, it would always give the same \"random\" --- values). Some form of mutable state must be used, such as an 'IORef', --- 'State' monad, etc.. A few default instances are provided by this module --- along with a more-general function ('getRandomPrimFromMTRef') usable as --- an implementation for new cases users might need. -module Data.Random.Source.PureMT - ( PureMT, newPureMT, pureMT - - , getRandomPrimFromMTRef - ) where - -import Control.Monad.State -import Control.Monad.RWS -import qualified Control.Monad.State.Strict as S -import qualified Control.Monad.RWS.Strict as S -import Data.Random.Internal.Source -import Data.Random.Source.Internal.TH -import Data.StateRef -import System.Random.Mersenne.Pure64 - -{-# INLINE withMTRef #-} -withMTRef :: (Monad m, ModifyRef sr m PureMT) => (PureMT -> (t, PureMT)) -> sr -> m t -withMTRef thing ref = atomicModifyReference ref $ \(!oldMT) -> - case thing oldMT of (!w, !newMT) -> (newMT, w) - -{-# INLINE withMTState #-} -withMTState :: MonadState PureMT m => (PureMT -> (t, PureMT)) -> m t -withMTState thing = do - !mt <- get - let (!ws, !newMt) = thing mt - put newMt - return ws - -#ifndef MTL2 - -$(monadRandom - [d| instance MonadRandom (State PureMT) where - getRandomWord64 = withMTState randomWord64 - getRandomDouble = withMTState randomDouble - |]) - -$(monadRandom - [d| instance MonadRandom (S.State PureMT) where - getRandomWord64 = withMTState randomWord64 - getRandomDouble = withMTState randomDouble - |]) - -$(monadRandom - [d| instance Monoid w => MonadRandom (RWS r w PureMT) where - getRandomWord64 = withMTState randomWord64 - getRandomDouble = withMTState randomDouble - |]) - -$(monadRandom - [d| instance Monoid w => MonadRandom (S.RWS r w PureMT) where - getRandomWord64 = withMTState randomWord64 - getRandomDouble = withMTState randomDouble - |]) - -#endif - -$(randomSource - [d| instance (Monad m1, ModifyRef (Ref m2 PureMT) m1 PureMT) => RandomSource m1 (Ref m2 PureMT) where - getRandomWord64From = withMTRef randomWord64 - getRandomDoubleFrom = withMTRef randomDouble - |]) - -$(monadRandom - [d| instance Monad m => MonadRandom (StateT PureMT m) where - getRandomWord64 = withMTState randomWord64 - getRandomDouble = withMTState randomDouble - |]) - -$(monadRandom - [d| instance Monad m => MonadRandom (S.StateT PureMT m) where - getRandomWord64 = withMTState randomWord64 - getRandomDouble = withMTState randomDouble - |]) - -$(monadRandom - [d| instance (Monad m, Monoid w) => MonadRandom (RWST r w PureMT m) where - getRandomWord64 = withMTState randomWord64 - getRandomDouble = withMTState randomDouble - |]) - -$(monadRandom - [d| instance (Monad m, Monoid w) => MonadRandom (S.RWST r w PureMT m) where - getRandomWord64 = withMTState randomWord64 - getRandomDouble = withMTState randomDouble - |]) - -$(randomSource - [d| instance (MonadIO m) => RandomSource m (IORef PureMT) where - getRandomWord64From = withMTRef randomWord64 - getRandomDoubleFrom = withMTRef randomDouble - |]) - -$(randomSource - [d| instance (Monad m, ModifyRef (STRef s PureMT) m PureMT) => RandomSource m (STRef s PureMT) where - getRandomWord64From = withMTRef randomWord64 - getRandomDoubleFrom = withMTRef randomDouble - |]) - --- Note that this instance is probably a Bad Idea. STM allows random variables --- to interact in spooky quantum-esque ways - One transaction can 'retry' until --- it gets a \"random\" answer it likes, which causes it to selectively consume --- entropy, biasing the supply from which other random variables will draw. --- instance (Monad m, ModifyRef (TVar PureMT) m PureMT) => RandomSource m (TVar PureMT) where --- {-# SPECIALIZE instance RandomSource IO (TVar PureMT) #-} --- {-# SPECIALIZE instance RandomSource STM (TVar PureMT) #-} --- getRandomPrimFrom = getRandomPrimFromMTRef - - --- |Given a mutable reference to a 'PureMT' generator, we can implement --- 'RandomSource' for it in any monad in which the reference can be modified. --- --- Typically this would be used to define a new 'RandomSource' instance for --- some new reference type or new monad in which an existing reference type --- can be modified atomically. As an example, the following instance could --- be used to describe how 'IORef' 'PureMT' can be a 'RandomSource' in the --- 'IO' monad: --- --- > instance RandomSource IO (IORef PureMT) where --- > supportedPrimsFrom _ _ = True --- > getSupportedRandomPrimFrom = getRandomPrimFromMTRef --- --- (note that there is actually a more general instance declared already --- covering this as a a special case, so there's no need to repeat this --- declaration anywhere) --- --- Example usage (using some functions from "Data.Random" in the random-fu --- package): --- --- > main = do --- > src <- newIORef (pureMT 1234) -- OR: newPureMT >>= newIORef --- > x <- runRVar (uniform 0 100) src :: IO Double --- > print x -getRandomPrimFromMTRef :: ModifyRef sr m PureMT => sr -> Prim a -> m a -getRandomPrimFromMTRef ref - = atomicModifyReference' ref - . runState - . getRandomPrim - -atomicModifyReference' :: ModifyRef sr m a => sr -> (a -> (b, a)) -> m b -atomicModifyReference' ref getR = - atomicModifyReference ref (swap' . getR) - where swap' (!a,!b) = (b,a) diff --git a/src/Data/Random/Source/RandomGen.hs b/src/Data/Random/Source/RandomGen.hs new file mode 100644 --- /dev/null +++ b/src/Data/Random/Source/RandomGen.hs @@ -0,0 +1,106 @@ + +{-# LANGUAGE + CPP, + MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, + BangPatterns, RankNTypes, + ScopedTypeVariables + #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- |This module provides functions useful for implementing new 'MonadRandom' +-- and 'RandomSource' instances for state-abstractions containing over 'RandomGen' +-- instance (the type class for pseudorandom generators provided by the System.Random +-- module in the \"random\" package), as well as instances for some common +-- cases. +module Data.Random.Source.RandomGen + ( getRandomPrimFromRandomGenRef + , getRandomPrimFromRandomGenState + ) where + +import Data.Random.Internal.Source +import System.Random +import Control.Monad.State +import Control.Monad.RWS +import qualified Control.Monad.State.Strict as S +import qualified Control.Monad.RWS.Strict as S +import Data.StateRef +import Data.Word + + +instance (Monad m1, RandomGen g, ModifyRef (Ref m2 g) m1 g) => RandomSource m1 (Ref m2 g) where + getRandomPrimFrom = getRandomPrimFromRandomGenRef + +instance (Monad m, RandomGen g, ModifyRef (IORef g) m g) => RandomSource m (IORef g) where + {-# SPECIALIZE instance RandomSource IO (IORef StdGen) #-} + getRandomPrimFrom = getRandomPrimFromRandomGenRef + +-- |Given a mutable reference to a 'RandomGen' generator, we can make a +-- 'RandomSource' usable in any monad in which the reference can be modified. +getRandomPrimFromRandomGenRef :: (Monad m, ModifyRef sr m g, RandomGen g) => + sr -> Prim a -> m a +getRandomPrimFromRandomGenRef ref + = atomicModifyReference' ref + . runState + . getRandomPrimFromRandomGenState + +atomicModifyReference' :: ModifyRef sr m a => sr -> (a -> (b, a)) -> m b +atomicModifyReference' ref getR = + atomicModifyReference ref (swap' . getR) + where swap' (!a,!b) = (b,a) + + +-- |Similarly, @getRandomWordFromRandomGenState x@ can be used in any \"state\" +-- monad in the mtl sense whose state is a 'RandomGen' generator. +-- Additionally, the standard mtl state monads have 'MonadRandom' instances +-- which do precisely that, allowing an easy conversion of 'RVar's and +-- other 'Distribution' instances to \"pure\" random variables. +getRandomPrimFromRandomGenState :: forall g m a. (RandomGen g, MonadState g m) => Prim a -> m a +getRandomPrimFromRandomGenState = genPrim + where + {-# INLINE genPrim #-} + genPrim :: forall t. Prim t -> m t + genPrim PrimWord8 = getThing (randomR (0, 0xff)) (fromIntegral :: Int -> Word8) + genPrim PrimWord16 = getThing (randomR (0, 0xffff)) (fromIntegral :: Int -> Word16) + genPrim PrimWord32 = getThing (randomR (0, 0xffffffff)) (fromInteger) + genPrim PrimWord64 = getThing (randomR (0, 0xffffffffffffffff)) (fromInteger) + genPrim PrimDouble = getThing (randomR (0, 0x000fffffffffffff)) (flip encodeFloat (-52)) + {- not using the Random Double instance for 2 reasons. 1st, it only generates 32 bits of entropy, when + a [0,1) Double has room for 52. Second, it appears there's a bug where it can actually generate a + negative number in the case where randomIvalInteger returns minBound::Int32. -} +-- genPrim PrimDouble = getThing (randomR (0, 1.0)) (id) + genPrim (PrimNByteInteger n) = getThing (randomR (0, iterate (*256) 1 !! n)) id + + {-# INLINE getThing #-} + getThing :: forall b t. (g -> (b, g)) -> (b -> t) -> m t + getThing thing f = do + !oldGen <- get + case thing oldGen of + (!i,!newGen) -> do + put newGen + return (f $! i) + +#ifndef MTL2 +instance RandomGen g => MonadRandom (State g) where + getRandomPrim = getRandomPrimFromRandomGenState + +instance RandomGen g => MonadRandom (S.State g) where + getRandomPrim = getRandomPrimFromRandomGenState + +instance (RandomGen g, Monoid w) => MonadRandom (RWS r w g) where + getRandomPrim = getRandomPrimFromRandomGenState + +instance (RandomGen g, Monoid w) => MonadRandom (S.RWS r w g) where + getRandomPrim = getRandomPrimFromRandomGenState +#endif + +instance (RandomGen g, Monad m) => MonadRandom (StateT g m) where + getRandomPrim = getRandomPrimFromRandomGenState + +instance (RandomGen g, Monad m) => MonadRandom (S.StateT g m) where + getRandomPrim = getRandomPrimFromRandomGenState + +instance (RandomGen g, Monad m, Monoid w) => MonadRandom (RWST r w g m) where + getRandomPrim = getRandomPrimFromRandomGenState + +instance (RandomGen g, Monad m, Monoid w) => MonadRandom (S.RWST r w g m) where + getRandomPrim = getRandomPrimFromRandomGenState diff --git a/src/Data/Random/Source/StdGen.hs b/src/Data/Random/Source/StdGen.hs --- a/src/Data/Random/Source/StdGen.hs +++ b/src/Data/Random/Source/StdGen.hs @@ -1,5 +1,4 @@ {-# LANGUAGE - CPP, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, BangPatterns, RankNTypes, ScopedTypeVariables @@ -15,33 +14,23 @@ ( StdGen , mkStdGen , newStdGen - + , getRandomPrimFromStdGenIO - , getRandomPrimFromRandomGenRef - , getRandomPrimFromRandomGenState + , RandomGen.getRandomPrimFromRandomGenRef + , RandomGen.getRandomPrimFromRandomGenState ) where import Data.Random.Internal.Source +import qualified Data.Random.Source.RandomGen as RandomGen import System.Random import Control.Monad.State -import Control.Monad.RWS import qualified Control.Monad.ST.Strict as S -import qualified Control.Monad.State.Strict as S -import qualified Control.Monad.RWS.Strict as S import Data.StateRef -import Data.Word -instance (Monad m1, ModifyRef (Ref m2 StdGen) m1 StdGen) => RandomSource m1 (Ref m2 StdGen) where - getRandomPrimFrom = getRandomPrimFromRandomGenRef - -instance (Monad m, ModifyRef (IORef StdGen) m StdGen) => RandomSource m (IORef StdGen) where - {-# SPECIALIZE instance RandomSource IO (IORef StdGen) #-} - getRandomPrimFrom = getRandomPrimFromRandomGenRef - -- Note that this instance is probably a Bad Idea. STM allows random variables -- to interact in spooky quantum-esque ways - One transaction can 'retry' until --- it gets a \"random\" answer it likes, which causes it to selectively consume +-- it gets a \"random\" answer it likes, which causes it to selectively consume -- entropy, biasing the supply from which other random variables will draw. -- instance (Monad m, ModifyRef (TVar StdGen) m StdGen) => RandomSource m (TVar StdGen) where -- {-# SPECIALIZE instance RandomSource IO (TVar StdGen) #-} @@ -52,91 +41,22 @@ instance (Monad m, ModifyRef (STRef s StdGen) m StdGen) => RandomSource m (STRef s StdGen) where {-# SPECIALIZE instance RandomSource (ST s) (STRef s StdGen) #-} {-# SPECIALIZE instance RandomSource (S.ST s) (STRef s StdGen) #-} - getRandomPrimFrom = getRandomPrimFromRandomGenRef + getRandomPrimFrom = RandomGen.getRandomPrimFromRandomGenRef getRandomPrimFromStdGenIO :: Prim a -> IO a -getRandomPrimFromStdGenIO +getRandomPrimFromStdGenIO = getStdRandom . runState . getRandomPrim --- |Given a mutable reference to a 'RandomGen' generator, we can make a --- 'RandomSource' usable in any monad in which the reference can be modified. --- --- See "Data.Random.Source.PureMT".'getRandomPrimFromMTRef' for more detailed --- usage hints - this function serves exactly the same purpose except for a --- 'StdGen' generator instead of a 'PureMT' generator. -getRandomPrimFromRandomGenRef :: (Monad m, ModifyRef sr m g, RandomGen g) => - sr -> Prim a -> m a -getRandomPrimFromRandomGenRef ref - = atomicModifyReference' ref - . runState - . getRandomPrimFromRandomGenState - -atomicModifyReference' :: ModifyRef sr m a => sr -> (a -> (b, a)) -> m b -atomicModifyReference' ref getR = - atomicModifyReference ref (swap' . getR) - where swap' (!a,!b) = (b,a) - - -- |Similarly, @getRandomWordFromRandomGenState x@ can be used in any \"state\" -- monad in the mtl sense whose state is a 'RandomGen' generator. -- Additionally, the standard mtl state monads have 'MonadRandom' instances -- which do precisely that, allowing an easy conversion of 'RVar's and -- other 'Distribution' instances to \"pure\" random variables. --- +-- -- Again, see "Data.Random.Source.PureMT".'getRandomPrimFromMTState' for more --- detailed usage hints - this function serves exactly the same purpose except +-- detailed usage hints - this function serves exactly the same purpose except -- for a 'StdGen' generator instead of a 'PureMT' generator. -{-# SPECIALIZE getRandomPrimFromRandomGenState :: Prim a -> State StdGen a #-} -{-# SPECIALIZE getRandomPrimFromRandomGenState :: Monad m => Prim a -> StateT StdGen m a #-} -getRandomPrimFromRandomGenState :: forall g m a. (RandomGen g, MonadState g m) => Prim a -> m a -getRandomPrimFromRandomGenState = genPrim - where - {-# INLINE genPrim #-} - genPrim :: forall t. Prim t -> m t - genPrim PrimWord8 = getThing (randomR (0, 0xff)) (fromIntegral :: Int -> Word8) - genPrim PrimWord16 = getThing (randomR (0, 0xffff)) (fromIntegral :: Int -> Word16) - genPrim PrimWord32 = getThing (randomR (0, 0xffffffff)) (fromInteger) - genPrim PrimWord64 = getThing (randomR (0, 0xffffffffffffffff)) (fromInteger) - genPrim PrimDouble = getThing (randomR (0, 0x000fffffffffffff)) (flip encodeFloat (-52)) - {- not using the Random Double instance for 2 reasons. 1st, it only generates 32 bits of entropy, when - a [0,1) Double has room for 52. Second, it appears there's a bug where it can actually generate a - negative number in the case where randomIvalInteger returns minBound::Int32. -} --- genPrim PrimDouble = getThing (randomR (0, 1.0)) (id) - genPrim (PrimNByteInteger n) = getThing (randomR (0, iterate (*256) 1 !! n)) id - - {-# INLINE getThing #-} - getThing :: forall b t. (g -> (b, g)) -> (b -> t) -> m t - getThing thing f = do - !oldGen <- get - case thing oldGen of - (!i,!newGen) -> do - put newGen - return (f $! i) - -#ifndef MTL2 -instance MonadRandom (State StdGen) where - getRandomPrim = getRandomPrimFromRandomGenState - -instance MonadRandom (S.State StdGen) where - getRandomPrim = getRandomPrimFromRandomGenState - -instance Monoid w => MonadRandom (RWS r w StdGen) where - getRandomPrim = getRandomPrimFromRandomGenState - -instance Monoid w => MonadRandom (S.RWS r w StdGen) where - getRandomPrim = getRandomPrimFromRandomGenState -#endif - -instance Monad m => MonadRandom (StateT StdGen m) where - getRandomPrim = getRandomPrimFromRandomGenState - -instance Monad m => MonadRandom (S.StateT StdGen m) where - getRandomPrim = getRandomPrimFromRandomGenState - -instance (Monad m, Monoid w) => MonadRandom (RWST r w StdGen m) where - getRandomPrim = getRandomPrimFromRandomGenState - -instance (Monad m, Monoid w) => MonadRandom (S.RWST r w StdGen m) where - getRandomPrim = getRandomPrimFromRandomGenState +{-# SPECIALIZE RandomGen.getRandomPrimFromRandomGenState :: Prim a -> State StdGen a #-} +{-# SPECIALIZE RandomGen.getRandomPrimFromRandomGenState :: Monad m => Prim a -> StateT StdGen m a #-}