Merge ec33eb3 into b7f0e6c

haskell · Jul 1, 2021 · 57908f2 · 57908f2
2 parents b7f0e6c + ec33eb3
commit 57908f2
Show file tree

Hide file tree

Showing 8 changed files with 67 additions and 72 deletions.
diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml
@@ -12,12 +12,24 @@ jobs:
   build-cabal:
     name: CI-cabal
     runs-on: ubuntu-latest
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          # Linux
+          - { cabal: "3.4", os: ubuntu-latest,  ghc: "7.10.3" }
+          - { cabal: "3.4", os: ubuntu-latest,  ghc: "8.0.2"  }
+          - { cabal: "3.4", os: ubuntu-latest,  ghc: "8.2.2"  }
+          - { cabal: "3.4", os: ubuntu-latest,  ghc: "latest" }
+          # MacOS
+          - { cabal: "3.4", os: macOS-latest,   ghc: "latest" }
     steps:
     - uses: actions/checkout@v2
     - uses: actions/setup-haskell@v1
       id: setup-haskell-cabal
       with:
-        ghc-version: 'latest'
+        ghc-version: ${{ matrix.ghc }}
+        cabal-version: ${{ matrix.cabal }}
     - name: Update cabal package database
       run: cabal update
     - uses: actions/cache@v2
@@ -32,38 +44,34 @@ jobs:
         cabal sdist -z -o .
         cabal get random-*.tar.gz
         cd random-*/
-        cabal test all
+        if [ ${{matrix.ghc}} = 7.10.3 ]; then
+          EXTRA_FLAGS=--ghc-option="-optl-no-pie"
+        fi
+        echo $EXTRA_FLAGS
+        cabal $EXTRA_FLAGS configure --haddock-all --enable-tests --enable-benchmarks --benchmark-option=-l
+        cabal $EXTRA_FLAGS build all --write-ghc-environment-files=always
   build-stack:
     name: CI-stack
     runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false
       matrix:
         os: [ubuntu-latest]
-        resolver: [nightly, lts-17, lts-16, lts-14, lts-12, lts-11, lts-9, lts-6]
+        resolver: [nightly, lts-18, lts-16, lts-14, lts-12]
         include:
-          - resolver: lts-6
-            ghc: 7.10.3
-            stack-yaml: stack-really-old.yaml
-          - resolver: lts-9
-            ghc: 8.0.2
-            stack-yaml: stack-really-old.yaml
-          - resolver: lts-11
-            ghc: 8.2.2
-            stack-yaml: stack-old.yaml
           - resolver: lts-12
             ghc: 8.4.4
             stack-yaml: stack-old.yaml
           - resolver: lts-14
             stack-yaml: stack-coveralls.yaml
           - resolver: lts-16
             ghc: 8.8.4
-            stack-yaml: stack.yaml
-          - resolver: lts-17
+            stack-yaml: stack-old.yaml
+          - resolver: lts-18
             ghc: 8.10.4
             stack-yaml: stack.yaml
           - resolver: nightly
-            stack-yaml: stack-nightly.yaml
+            stack-yaml: stack.yaml
           # Latest stable for MacOS: ghc-8.8.4
           - resolver: lts-16
             os: macos-latest

diff --git a/bench/Main.hs b/bench/Main.hs
@@ -13,6 +13,9 @@ import Foreign.C.Types
 import Numeric.Natural (Natural)
 import System.Random.SplitMix as SM
 import Test.Tasty.Bench
+import Control.Monad.Primitive
+import Data.Primitive.PrimArray
+import Data.Primitive.Types
 
 import System.Random.Stateful
 
@@ -25,6 +28,7 @@ main = do
       genLengths =
         -- create 5000 small lengths that are needed for ShortByteString generation
         runStateGen (mkStdGen 2020) $ \g -> replicateM 5000 (uniformRM (16 + 1, 16 + 7) g)
+  setStdGen $ mkStdGen seed
   defaultMain
     [ bgroup "baseline"
       [ env (pure $ SM.mkSMGen $ fromIntegral seed) $ \smGen ->
@@ -195,43 +199,45 @@ main = do
           ]
         , bgroup "floating"
           [ bgroup "IO"
-            [ env (pure (mkStdGen seed)) $ \gen ->
-                bench "uniformFloat01M" $ nfIO (runStateGenT gen (replicateM_ sz . uniformFloat01M))
-            , env (pure (mkStdGen seed)) $ \gen ->
+            [ env ((,) <$> getStdGen <*> newAlignedPinnedPrimArray sz) $ \ ~(gen, ma) ->
+                bench "uniformFloat01M" $
+                nfIO (runStateGenT gen (fillMutablePrimArrayM uniformFloat01M ma))
+            , env ((,) <$> getStdGen <*> newAlignedPinnedPrimArray sz) $ \ ~(gen, ma) ->
                 bench "uniformFloatPositive01M" $
-                nfIO (runStateGenT gen (replicateM_ sz . uniformFloatPositive01M))
-            , env (pure (mkStdGen seed)) $ \gen ->
-                bench "uniformDouble01M" $ nfIO (runStateGenT gen (replicateM_ sz . uniformDouble01M))
-            , env (pure (mkStdGen seed)) $ \gen ->
+                nfIO (runStateGenT gen (fillMutablePrimArrayM uniformFloatPositive01M ma))
+            , env ((,) <$> getStdGen <*> newAlignedPinnedPrimArray sz) $ \ ~(gen, ma) ->
+                bench "uniformDouble01M" $
+                nfIO (runStateGenT gen (fillMutablePrimArrayM uniformDouble01M ma))
+            , env ((,) <$> getStdGen <*> newAlignedPinnedPrimArray sz) $ \ ~(gen, ma) ->
                 bench "uniformDoublePositive01M" $
-                nfIO (runStateGenT gen (replicateM_ sz . uniformDoublePositive01M))
+                nfIO (runStateGenT gen (fillMutablePrimArrayM uniformDoublePositive01M ma))
             ]
           , bgroup "State"
-            [ env (pure (mkStdGen seed)) $
+            [ env getStdGen $
                 bench "uniformFloat01M" . nf (`runStateGen` (replicateM_ sz . uniformFloat01M))
-            , env (pure (mkStdGen seed)) $
+            , env getStdGen $
                 bench "uniformFloatPositive01M" .
                 nf (`runStateGen` (replicateM_ sz . uniformFloatPositive01M))
-            , env (pure (mkStdGen seed)) $
+            , env getStdGen $
                 bench "uniformDouble01M" . nf (`runStateGen` (replicateM_ sz . uniformDouble01M))
-            , env (pure (mkStdGen seed)) $
+            , env getStdGen $
                 bench "uniformDoublePositive01M" .
                 nf (`runStateGen` (replicateM_ sz . uniformDoublePositive01M))
             ]
           , bgroup "pure"
-            [ env (pure (mkStdGen seed)) $ \gen ->
+            [ env getStdGen $ \gen ->
                 bench "uniformFloat01M" $ nf
                 (genMany (runState $ uniformFloat01M (StateGenM :: StateGenM StdGen)) gen)
                 sz
-            , env (pure (mkStdGen seed)) $ \gen ->
+            , env getStdGen $ \gen ->
                 bench "uniformFloatPositive01M" $ nf
                 (genMany (runState $ uniformFloatPositive01M (StateGenM :: StateGenM StdGen)) gen)
                 sz
-            , env (pure (mkStdGen seed)) $ \gen ->
+            , env getStdGen $ \gen ->
                 bench "uniformDouble01M" $ nf
                 (genMany (runState $ uniformDouble01M (StateGenM :: StateGenM StdGen)) gen)
                 sz
-            , env (pure (mkStdGen seed)) $ \gen ->
+            , env getStdGen $ \gen ->
                 bench "uniformDoublePositive01M" $ nf
                 (genMany (runState $ uniformDoublePositive01M (StateGenM :: StateGenM StdGen)) gen)
                 sz
@@ -302,7 +308,7 @@ pureBench ::
   -> Proxy a
   -> Benchmark
 pureBench f sz px =
-  env (pure (mkStdGen seed)) $ \gen ->
+  env getStdGen $ \gen ->
     bench (showsTypeRep (typeRep px) "") $ whnf (genMany f gen) sz
 {-# INLINE pureBench #-}
 
@@ -313,3 +319,18 @@ genMany f g0 n = go 0 $ f g0
     go i (!y, !g)
       | i < n = go (i + 1) $ f g
       | otherwise = y
+
+
+fillMutablePrimArrayM ::
+     (Prim a, PrimMonad m)
+  => (gen -> m a)
+  -> MutablePrimArray (PrimState m) a
+  -> gen
+  -> m (PrimArray a)
+fillMutablePrimArrayM f ma g = do
+  n <- getSizeofMutablePrimArray ma
+  let go i
+        | i < n = f g >>= writePrimArray ma i >> go (i + 1)
+        | otherwise = pure ()
+  go 0
+  unsafeFreezePrimArray ma
diff --git a/random.cabal b/random.cabal
@@ -209,6 +209,7 @@ benchmark bench
     build-depends:
         base -any,
         mtl,
+        primitive >= 0.7.1,
         random -any,
         splitmix >=0.1 && <0.2,
         tasty-bench
diff --git a/stack-coveralls.yaml b/stack-coveralls.yaml
@@ -8,3 +8,4 @@ extra-deps:
 - tasty-bench-0.2.3@sha256:daa2221a1b1c65990633a51236f1cb4a52cba8ef0f0731f653e712a8bab07616,1319
 - inspection-testing-0.4.5.0@sha256:938e7ce2ef42033071a5e60198c6e19ab61c411f5879b85821247a504f131768,8058
 - tasty-inspection-testing-0.1@sha256:9c5e76345168fd3a59b43d305eebf8df3c792ce324c66bbdee45b54aa7d2c0ad,1214
+- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
diff --git a/stack-nightly.yaml b/stack-nightly.yaml
diff --git a/stack-old.yaml b/stack-old.yaml
@@ -1,4 +1,4 @@
-resolver: lts-11.22
+resolver: lts-12.26
 packages:
 - .
 extra-deps:
@@ -14,3 +14,4 @@ extra-deps:
 - tasty-bench-0.2.3@sha256:daa2221a1b1c65990633a51236f1cb4a52cba8ef0f0731f653e712a8bab07616,1319
 - inspection-testing-0.4.5.0@sha256:938e7ce2ef42033071a5e60198c6e19ab61c411f5879b85821247a504f131768,8058
 - tasty-inspection-testing-0.1@sha256:9c5e76345168fd3a59b43d305eebf8df3c792ce324c66bbdee45b54aa7d2c0ad,1214
+- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
diff --git a/stack-really-old.yaml b/stack-really-old.yaml
diff --git a/stack.yaml b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-16.31
+resolver: lts-18.0
 packages:
 - .
 extra-deps:
@@ -8,3 +8,4 @@ extra-deps:
 - tasty-bench-0.2.5@sha256:4f00fdafc3aba6e48366a3684c427618d98c0b1b130cd9cab35c9498796c9a65,1497
 - inspection-testing-0.4.5.0@sha256:938e7ce2ef42033071a5e60198c6e19ab61c411f5879b85821247a504f131768,8058
 - tasty-inspection-testing-0.1@sha256:9c5e76345168fd3a59b43d305eebf8df3c792ce324c66bbdee45b54aa7d2c0ad,1214
+- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728