diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 5e17be0..ef378aa 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -18,40 +18,43 @@ jobs: matrix: include: ### -- Linux -- - - { cabal: "3.10", os: ubuntu-latest, ghc: "8.0.2" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "8.2.2" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "8.4.4" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "8.6.5" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "8.8.4" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "8.10.7" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "9.0.2" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "9.2.8" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "9.4.8" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "9.6.5" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "9.6.5" } - - { cabal: "3.10", os: ubuntu-latest, ghc: "9.8.2" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "8.0.2" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "8.2.2" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "8.4.4" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "8.6.5" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "8.8.4" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "8.10.7" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "9.0.2" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "9.2.8" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "9.4.8" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "9.6.6" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "9.8.4" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "9.10.1" } + - { cabal: "3.12", os: ubuntu-latest, ghc: "9.12.1" } ## -- Win -- - - { cabal: "3.10", os: windows-latest, ghc: "8.4.4" } - - { cabal: "3.10", os: windows-latest, ghc: "8.6.5" } - - { cabal: "3.10", os: windows-latest, ghc: "8.8.4" } - - { cabal: "3.10", os: windows-latest, ghc: "8.10.7" } - - { cabal: "3.10", os: windows-latest, ghc: "9.0.2" } - - { cabal: "3.10", os: windows-latest, ghc: "9.2.8" } - - { cabal: "3.10", os: windows-latest, ghc: "9.4.8" } - - { cabal: "3.10", os: windows-latest, ghc: "9.6.5" } - - { cabal: "3.10", os: windows-latest, ghc: "9.6.5" } - - { cabal: "3.10", os: windows-latest, ghc: "9.8.2" } + - { cabal: "3.12", os: windows-latest, ghc: "8.4.4" } + - { cabal: "3.12", os: windows-latest, ghc: "8.6.5" } + - { cabal: "3.12", os: windows-latest, ghc: "8.8.4" } + - { cabal: "3.12", os: windows-latest, ghc: "8.10.7" } + - { cabal: "3.12", os: windows-latest, ghc: "9.0.2" } + - { cabal: "3.12", os: windows-latest, ghc: "9.2.8" } + - { cabal: "3.12", os: windows-latest, ghc: "9.4.8" } + - { cabal: "3.12", os: windows-latest, ghc: "9.6.6" } + - { cabal: "3.12", os: windows-latest, ghc: "9.8.4" } + - { cabal: "3.12", os: windows-latest, ghc: "9.10.1" } + - { cabal: "3.12", os: windows-latest, ghc: "9.12.1" } # MacOS - - { cabal: "3.10", os: macOS-13, ghc: "8.4.4" } - - { cabal: "3.10", os: macOS-13, ghc: "8.6.5" } - - { cabal: "3.10", os: macOS-13, ghc: "8.8.4" } - - { cabal: "3.10", os: macOS-13, ghc: "8.10.7" } - - { cabal: "3.10", os: macOS-13, ghc: "9.0.2" } - - { cabal: "3.10", os: macOS-latest, ghc: "9.2.8" } - - { cabal: "3.10", os: macOS-latest, ghc: "9.4.8" } - - { cabal: "3.10", os: macOS-latest, ghc: "9.6.5" } - - { cabal: "3.10", os: macOS-latest, ghc: "9.6.5" } - - { cabal: "3.10", os: macOS-latest, ghc: "9.8.2" } + - { cabal: "3.12", os: macOS-13, ghc: "8.4.4" } + - { cabal: "3.12", os: macOS-13, ghc: "8.6.5" } + - { cabal: "3.12", os: macOS-13, ghc: "8.8.4" } + - { cabal: "3.12", os: macOS-13, ghc: "8.10.7" } + - { cabal: "3.12", os: macOS-13, ghc: "9.0.2" } + - { cabal: "3.12", os: macOS-latest, ghc: "9.2.8" } + - { cabal: "3.12", os: macOS-latest, ghc: "9.4.8" } + - { cabal: "3.12", os: macOS-latest, ghc: "9.6.6" } + - { cabal: "3.12", os: macOS-latest, ghc: "9.8.4" } + - { cabal: "3.12", os: macOS-latest, ghc: "9.10.1" } + - { cabal: "3.12", os: macOS-latest, ghc: "9.12.1" } fail-fast: false steps: diff --git a/System/Random/MWC.hs b/System/Random/MWC.hs index 5cc616b..134bd02 100644 --- a/System/Random/MWC.hs +++ b/System/Random/MWC.hs @@ -158,7 +158,7 @@ module System.Random.MWC #include "MachDeps.h" #endif -import Control.Monad (ap, liftM, unless) +import Control.Monad (unless) import Control.Monad.Primitive (PrimMonad, PrimBase, PrimState, unsafePrimToIO, stToPrim) import Control.Monad.ST (ST,runST) import Data.Bits ((.&.), (.|.), shiftL, shiftR, xor) @@ -310,24 +310,24 @@ instance Variate Word where {-# INLINE uniformR #-} instance (Variate a, Variate b) => Variate (a,b) where - uniform g = (,) `liftM` uniform g `ap` uniform g - uniformR ((x1,y1),(x2,y2)) g = (,) `liftM` uniformR (x1,x2) g `ap` uniformR (y1,y2) g + uniform g = (,) <$> uniform g <*> uniform g + uniformR ((x1,y1),(x2,y2)) g = (,) <$> uniformR (x1,x2) g <*> uniformR (y1,y2) g {-# INLINE uniform #-} {-# INLINE uniformR #-} instance (Variate a, Variate b, Variate c) => Variate (a,b,c) where - uniform g = (,,) `liftM` uniform g `ap` uniform g `ap` uniform g + uniform g = (,,) <$> uniform g <*> uniform g <*> uniform g uniformR ((x1,y1,z1),(x2,y2,z2)) g = - (,,) `liftM` uniformR (x1,x2) g `ap` uniformR (y1,y2) g `ap` uniformR (z1,z2) g + (,,) <$> uniformR (x1,x2) g <*> uniformR (y1,y2) g <*> uniformR (z1,z2) g {-# INLINE uniform #-} {-# INLINE uniformR #-} instance (Variate a, Variate b, Variate c, Variate d) => Variate (a,b,c,d) where - uniform g = (,,,) `liftM` uniform g `ap` uniform g `ap` uniform g - `ap` uniform g + uniform g = (,,,) <$> uniform g <*> uniform g <*> uniform g + <*> uniform g uniformR ((x1,y1,z1,t1),(x2,y2,z2,t2)) g = - (,,,) `liftM` uniformR (x1,x2) g `ap` uniformR (y1,y2) g `ap` - uniformR (z1,z2) g `ap` uniformR (t1,t2) g + (,,,) <$> uniformR (x1,x2) g <*> uniformR (y1,y2) g <*> + uniformR (z1,z2) g <*> uniformR (t1,t2) g {-# INLINE uniform #-} {-# INLINE uniformR #-} @@ -463,14 +463,28 @@ instance (s ~ PrimState m, PrimMonad m) => Random.StatefulGen (Gen s) m where {-# INLINE uniformWord32 #-} uniformWord64 = uniform {-# INLINE uniformWord64 #-} +#if MIN_VERSION_random(1,3,0) + uniformByteArrayM isPinned n g = stToPrim (Random.fillByteArrayST isPinned n (uniform g)) + {-# INLINE uniformByteArrayM #-} +#else uniformShortByteString n g = stToPrim (Random.genShortByteStringST n (uniform g)) {-# INLINE uniformShortByteString #-} +#endif -- | @since 0.15.0.0 instance PrimMonad m => Random.FrozenGen Seed m where type MutableGen Seed m = Gen (PrimState m) - thawGen = restore freezeGen = save +#if MIN_VERSION_random(1,3,0) + modifyGen gen@(Gen mv) f = do + seed <- save gen + case f seed of + (a, Seed v) -> a <$ G.copy mv v + overwriteGen (Gen mv) (Seed v) = G.copy mv v + +instance PrimMonad m => Random.ThawedGen Seed m where +#endif + thawGen = restore -- | Convert vector to 'Seed'. It acts similarly to 'initialize' and -- will accept any vector. If you want to pass seed immediately to @@ -482,12 +496,12 @@ toSeed v = Seed $ I.create $ do { Gen q <- initialize v; return q } -- | Save the state of a 'Gen', for later use by 'restore'. save :: PrimMonad m => Gen (PrimState m) -> m Seed -save (Gen q) = Seed `liftM` G.freeze q +save (Gen q) = Seed <$> G.freeze q {-# INLINE save #-} -- | Create a new 'Gen' that mirrors the state of a saved 'Seed'. restore :: PrimMonad m => Seed -> m (Gen (PrimState m)) -restore (Seed s) = Gen `liftM` G.thaw s +restore (Seed s) = Gen <$> G.thaw s {-# INLINE restore #-} @@ -577,9 +591,9 @@ aa = 1540315826 uniformWord32 :: PrimMonad m => Gen (PrimState m) -> m Word32 -- NOTE [Carry value] uniformWord32 (Gen q) = do - i <- nextIndex `liftM` M.unsafeRead q ioff - c <- fromIntegral `liftM` M.unsafeRead q coff - qi <- fromIntegral `liftM` M.unsafeRead q i + i <- nextIndex <$> M.unsafeRead q ioff + c <- fromIntegral <$> M.unsafeRead q coff + qi <- fromIntegral <$> M.unsafeRead q i let t = aa * qi + c c' = fromIntegral (t `shiftR` 32) x = fromIntegral t + c' @@ -599,11 +613,11 @@ uniform1 f gen = do uniform2 :: PrimMonad m => (Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a uniform2 f (Gen q) = do - i <- nextIndex `liftM` M.unsafeRead q ioff + i <- nextIndex <$> M.unsafeRead q ioff let j = nextIndex i - c <- fromIntegral `liftM` M.unsafeRead q coff - qi <- fromIntegral `liftM` M.unsafeRead q i - qj <- fromIntegral `liftM` M.unsafeRead q j + c <- fromIntegral <$> M.unsafeRead q coff + qi <- fromIntegral <$> M.unsafeRead q i + qj <- fromIntegral <$> M.unsafeRead q j let t = aa * qi + c c' = fromIntegral (t `shiftR` 32) x = fromIntegral t + c' diff --git a/System/Random/MWC/Distributions.hs b/System/Random/MWC/Distributions.hs index 01e7a48..d2eba5a 100644 --- a/System/Random/MWC/Distributions.hs +++ b/System/Random/MWC/Distributions.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE BangPatterns, CPP, GADTs, FlexibleContexts, ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns, GADTs, FlexibleContexts, ScopedTypeVariables #-} -- | -- Module : System.Random.MWC.Distributions -- Copyright : (c) 2012 Bryan O'Sullivan @@ -40,13 +40,9 @@ module System.Random.MWC.Distributions ) where import Prelude hiding (mapM) -import Control.Monad (liftM) import Control.Monad.Primitive (PrimMonad, PrimState) import Data.Bits ((.&.)) import Data.Foldable (foldl') -#if !MIN_VERSION_base(4,8,0) -import Data.Traversable (Traversable) -#endif import Data.Traversable (mapM) import Data.Word (Word32) import System.Random.Stateful (StatefulGen(..),Uniform(..),UniformRange(..),uniformDoublePositive01M) @@ -83,7 +79,7 @@ standard :: StatefulGen g m => g -> m Double standard gen = loop where loop = do - u <- (subtract 1 . (*2)) `liftM` uniformDoublePositive01M gen + u <- subtract 1 . (*2) <$> uniformDoublePositive01M gen ri <- uniformM gen let i = fromIntegral ((ri :: Word32) .&. 127) bi = I.unsafeIndex blocks i @@ -102,8 +98,8 @@ standard gen = loop else loop normalTail neg = tailing where tailing = do - x <- ((/rNorm) . log) `liftM` uniformDoublePositive01M gen - y <- log `liftM` uniformDoublePositive01M gen + x <- (/ rNorm) . log <$> uniformDoublePositive01M gen + y <- log <$> uniformDoublePositive01M gen if y * (-2) < x * x then tailing else return $! if neg then x - rNorm else rNorm - x @@ -257,7 +253,7 @@ bernoulli :: StatefulGen g m -> g -- ^ Generator -> m Bool {-# INLINE bernoulli #-} -bernoulli p gen = ( uniformDoublePositive01M gen -- | Random variate generator for categorical distribution. -- @@ -274,7 +270,7 @@ categorical v gen | G.null v = pkgError "categorical" "empty weights!" | otherwise = do let cv = G.scanl1' (+) v - p <- (G.last cv *) `liftM` uniformDoublePositive01M gen + p <- (G.last cv *) <$> uniformDoublePositive01M gen return $! case G.findIndex (>=p) cv of Just i -> i Nothing -> pkgError "categorical" "bad weights!" diff --git a/System/Random/MWC/SeedSource.hs b/System/Random/MWC/SeedSource.hs index fa4f333..c018999 100644 --- a/System/Random/MWC/SeedSource.hs +++ b/System/Random/MWC/SeedSource.hs @@ -10,7 +10,6 @@ module System.Random.MWC.SeedSource ( , randomSourceName ) where -import Control.Monad (liftM) import Data.Word (Word32,Word64) import Data.Bits (shiftR) import Data.Ratio ((%), numerator) @@ -31,8 +30,8 @@ import System.CPUTime (cpuTimePrecision, getCPUTime) -- Windows system. acquireSeedTime :: IO [Word32] acquireSeedTime = do - c <- (numerator . (% cpuTimePrecision)) `liftM` getCPUTime - t <- toRational `liftM` getPOSIXTime + c <- numerator . (% cpuTimePrecision) <$> getCPUTime + t <- toRational <$> getPOSIXTime let n = fromIntegral (numerator t) :: Word64 return [fromIntegral c, fromIntegral n, fromIntegral (n `shiftR` 32)] diff --git a/changelog.md b/changelog.md index bb35110..15c1340 100644 --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +## Changes in 0.15.2.0 + + * Support for `random-1.3`. + + ## Changes in 0.15.1.0 * Additon of binomial sampler using the rejection sampling method in diff --git a/mwc-random.cabal b/mwc-random.cabal index 3ee8aed..f647fff 100644 --- a/mwc-random.cabal +++ b/mwc-random.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 build-type: Simple name: mwc-random -version: 0.15.1.0 +version: 0.15.2.0 license: BSD-2-Clause license-file: LICENSE copyright: 2009, 2010, 2011 Bryan O'Sullivan @@ -45,9 +45,10 @@ tested-with: || ==9.0.2 || ==9.2.8 || ==9.4.8 - || ==9.6.5 - || ==9.6.5 - || ==9.8.2 + || ==9.6.6 + || ==9.8.4 + || ==9.10.1 + || ==9.12.1 source-repository head @@ -120,9 +121,9 @@ test-suite mwc-prop-tests , QuickCheck >=2.2 , vector >=0.12.1 , tasty >=1.3.1 - , tasty-quickcheck + , tasty-quickcheck >=0.10.2 , tasty-hunit - , random >=1.2 + , random >=1.2 , mtl , math-functions >=0.3.4 @@ -141,7 +142,7 @@ test-suite mwc-doctests build-depends: base -any , mwc-random -any - , doctest >=0.15 && <0.23 + , doctest >=0.15 && <0.24 -- , bytestring , primitive diff --git a/stack.yaml b/stack.yaml index b67891c..6fb02eb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,8 +1,5 @@ -resolver: lts-15.2 +resolver: lts-22.43 packages: - '.' - extra-deps: -- github: idontgetoutmuch/random - commit: 86e06b8902d4d5c32b14b6a5ef44b964280bcc32 -- splitmix-0.1@sha256:d50c4d0801a35be7875a040470c09863342514930c82a7d25780a6c2efc4fda9,5249 +- random-1.3.0@sha256:e5b7016e43a8f4822ebcf8cacaaa737beb62d370b988b5c69e95105d9f0fd582,6004