diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,13 @@ +* Changes in 0.3.0.11: Revert 0.3.0.10 changes (which accidentally removed the Random.Source.PureMT module and added an overlapping instance). + +* Changes in 0.3.0.8: Add MonadRandom instance for MWC generator and RWS transformer. + +* Changes in 0.3.0.6: Fixed overzealous fix in 0.3.0.5. The people responsible for sacking the people who have been sacked, etc., have been sacked. + +* Changes in 0.3.0.5: Renamed some internal modules and accidentally some external ones too. Whoops. Please don't use this version, it will only end in tears. + +* Changes in 0.3.0.4: Fixed a typo that broke building with MTL-1 + +* Changes in 0.3.0.3: Fixes for GHC's deprecation of Foreign.unsafePerformIO + +* Changes in 0.3.0.2: Fixes for GHC 7.2.*'s crazy Template Haskell changes. diff --git a/random-source.cabal b/random-source.cabal --- a/random-source.cabal +++ b/random-source.cabal @@ -1,5 +1,5 @@ name: random-source -version: 0.3.0.10 +version: 0.3.0.11 stability: provisional cabal-version: >= 1.10 @@ -18,22 +18,11 @@ \"completing\" partial implementations, making it easy to define new entropy sources in a way that is naturally forward-compatible. - . - Changes in 0.3.0.6: Fixed overzealous fix in 0.3.0.5. The people responsible for sacking the people who have been sacked, etc., have been sacked. - . - Changes in 0.3.0.5: Renamed some internal modules and accidentally some external ones too. Whoops. Please don't use this version, it will only end in tears. - . - Changes in 0.3.0.4: Fixed a typo that broke building - with MTL-1 - . - Changes in 0.3.0.3: Fixes for GHC's deprecation - of Foreign.unsafePerformIO - . - Changes in 0.3.0.2: Fixes for GHC 7.2.*'s crazy - Template Haskell changes. tested-with: GHC == 7.4.2, GHC == 7.6.1 +extra-source-files: changelog.md + source-repository head type: git location: https://github.com/mokus0/random-fu.git @@ -51,14 +40,14 @@ default-language: Haskell2010 exposed-modules: Data.Random.Source Data.Random.Source.IO - Data.Random.Source.RandomGen + Data.Random.Source.PureMT 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 @@ -69,21 +58,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 >= 1.2.0, + random >= 1.2.0 && < 1.3, 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 new file mode 100644 --- /dev/null +++ b/src/Data/Random/Source/PureMT.hs @@ -0,0 +1,162 @@ +{-# 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 deleted file mode 100644 --- a/src/Data/Random/Source/RandomGen.hs +++ /dev/null @@ -1,106 +0,0 @@ - -{-# 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,4 +1,5 @@ {-# LANGUAGE + CPP, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, BangPatterns, RankNTypes, ScopedTypeVariables @@ -14,23 +15,33 @@ ( StdGen , mkStdGen , newStdGen - + , getRandomPrimFromStdGenIO - , RandomGen.getRandomPrimFromRandomGenRef - , RandomGen.getRandomPrimFromRandomGenState + , getRandomPrimFromRandomGenRef + , 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) #-} @@ -41,22 +52,91 @@ 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 = RandomGen.getRandomPrimFromRandomGenRef + getRandomPrimFrom = 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 RandomGen.getRandomPrimFromRandomGenState :: Prim a -> State StdGen a #-} -{-# SPECIALIZE RandomGen.getRandomPrimFromRandomGenState :: Monad m => Prim a -> StateT StdGen m a #-} +{-# 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