diff --git a/Control/Monad/ST/Trans/Internal.hs b/Control/Monad/ST/Trans/Internal.hs --- a/Control/Monad/ST/Trans/Internal.hs +++ b/Control/Monad/ST/Trans/Internal.hs @@ -145,6 +145,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -157,6 +161,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -169,6 +177,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -181,6 +193,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -193,6 +209,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -205,6 +225,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -217,6 +241,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -229,6 +257,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -241,6 +273,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -253,6 +289,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -265,6 +305,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -277,6 +321,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -289,6 +337,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -301,6 +353,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -313,6 +369,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -325,6 +385,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} @@ -337,6 +401,10 @@ getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) + {-# INLINE newArray_ #-} + newArray_ arrBounds = liftST (newArray_ arrBounds) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} diff --git a/STMonadTrans.cabal b/STMonadTrans.cabal --- a/STMonadTrans.cabal +++ b/STMonadTrans.cabal @@ -1,5 +1,5 @@ name: STMonadTrans -version: 0.4.4 +version: 0.4.5 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -7,18 +7,27 @@ maintainer: josef.svenningsson@gmail.com category: Monads build-type: Simple -Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 synopsis: A monad transformer version of the ST monad -description: +description: A monad transformer version of the ST monad Warning! This monad transformer should not be used with monads that - can contain multiple answers, like the list monad. The reason is that + can contain multiple answers, like the list monad. The reason is that the state token will be duplicated across the different answers and this causes Bad Things to happen (such as loss of referential transparency). Safe monads include the monads State, Reader, Writer, Maybe and combinations of their corresponding monad transformers. +Tested-With: GHC == 7.6.3 + , GHC == 7.8.4 + , GHC == 7.10.3 + , GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.3 + extra-source-files: changelog.md @@ -32,16 +41,16 @@ library default-language: Haskell2010 build-depends: base >= 4.6 - + if flag(splitBase) - build-depends: base >= 3, base < 5, mtl, array + build-depends: base >= 3, base < 5, mtl >= 1.1, array else build-depends: base < 3 if impl(ghc < 8.0) build-depends: fail - exposed-modules: + exposed-modules: Control.Monad.ST.Trans, Control.Monad.ST.Trans.Internal default-extensions: CPP, MagicHash, UnboxedTuples, Rank2Types, @@ -56,8 +65,9 @@ hs-source-dirs: test main-is: Main.hs build-depends: base >= 4 && < 5 - , tasty >= 0.11.0.4 && < 1.3 + , tasty >= 0.11.0.4 && < 1.5 , tasty-quickcheck >= 0.8.4 && < 0.11 , tasty-hunit >= 0.9.2 && < 0.11 - , transformers >= 0.4 && < 0.6 + , transformers >= 0.2 && < 0.6 , STMonadTrans + , array diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +0.4.5 + + * Don't use default class methods in any MArray (STUArray s) instance. Thanks to Henri Jones + * Allow tasty up to and including 1.4 + 0.4.4 * Fix compilation for GHC 8.8.1. Thanks to Andrés Sicard-Ramírez. diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -7,6 +7,7 @@ import Control.Monad.ST.Trans import Control.Monad.Trans.Class import Control.Monad (guard) +import Data.Array.ST (STUArray, freeze, newArray, newArray_, readArray, thaw, writeArray) props :: TestTree props = testGroup "Properties" [ @@ -20,26 +21,57 @@ \x y -> runSTT (do ref <- newSTRef x writeSTRef ref y readSTRef ref) == Just (y :: Int), - testProperty "newSTArray makes correct Arrays" $ - \t e -> 0 <= t ==> - runSTT (newSTArray (0,t) e >>= freezeSTArray) == - Just (listArray (0,t) (repeat e) :: Array Int Int), - testProperty "writeSTArray overwrite" $ - \t e y -> 0 <= t ==> - runSTT (do arr <- newSTArray (0,t) e - mapM_ (\i -> writeSTArray arr i y) [0..t] - freezeSTArray arr) == - Just (listArray (0,t) (repeat y) :: Array Int Int), - testProperty "thawSTArray . freezeSTArray == id" $ - \l -> let a = listArray (0,length l - 1) l in - runSTT (thawSTArray a >>= freezeSTArray) == Just (a :: Array Int Int), - testProperty "writeSTArray . thawSTArray == update a" $ - \l i e -> let a = listArray (0, length l - 1) l in - 0 <= i && i < length l ==> - runSTT (do stArr <- thawSTArray a - writeSTArray stArr i e - freezeSTArray stArr) == - Just (a // [(i,e)] :: Array Int Int) ] + testGroup "STArray" [ + testProperty "newSTArray makes correct Arrays" $ + \t e -> 0 <= t ==> + runSTT (newSTArray (0,t) e >>= freezeSTArray) == + Just (listArray (0,t) (repeat e) :: Array Int Int), + testProperty "writeSTArray overwrite" $ + \t e y -> 0 <= t ==> + runSTT (do arr <- newSTArray (0,t) e + mapM_ (\i -> writeSTArray arr i y) [0..t] + freezeSTArray arr) == + Just (listArray (0,t) (repeat y) :: Array Int Int), + testProperty "thawSTArray . freezeSTArray == id" $ + \l -> let a = listArray (0,length l - 1) l in + runSTT (thawSTArray a >>= freezeSTArray) == Just (a :: Array Int Int), + testProperty "writeSTArray . thawSTArray == update a" $ + \l i e -> let a = listArray (0, length l - 1) l in + 0 <= i && i < length l ==> + runSTT (do stArr <- thawSTArray a + writeSTArray stArr i e + freezeSTArray stArr) == + Just (a // [(i,e)] :: Array Int Int) ], + testGroup "STUArray" [ + testProperty "newArray makes correct Arrays" $ + \t e -> 0 <= t ==> + runSTT (do stuArr <- newArray (0,t) e :: STT s Maybe (STUArray s Int Int) + freeze stuArr) == + Just (listArray (0,t) (repeat e) :: Array Int Int), + testProperty "writeArray overwrite" $ + \t e y -> 0 <= t ==> + runSTT (do stuArr <- newArray (0,t) e :: STT s Maybe (STUArray s Int Int) + mapM_ (\i -> writeArray stuArr i y) [0..t] + freeze stuArr) == + Just (listArray (0,t) (repeat y) :: Array Int Int), + testProperty "thaw . freeze == id" $ + \l -> let a = listArray (0,length l - 1) l in + runSTT (do stuArr <- thaw a :: STT s Maybe (STUArray s Int Int) + freeze stuArr) == + Just (a :: Array Int Int), + testProperty "writeArray . thawArray == update a" $ + \l i e -> let a = listArray (0, length l - 1) l in + 0 <= i && i < length l ==> + runSTT (do stuArr <- thaw a :: STT s Maybe (STUArray s Int Int) + writeArray stuArr i e + freeze stuArr) == + Just (a // [(i,e)] :: Array Int Int), + testProperty "writeArray overwrite uninitialised array" $ + \t e -> 0 <= t ==> + runSTT (do stuArr <- newArray_ (0,t) :: STT s Maybe (STUArray s Int Int) + mapM_ (\i -> writeArray stuArr i e) [0..t] + freeze stuArr) == + Just (listArray (0,t) (repeat e) :: Array Int Int) ] ] unitTests :: TestTree unitTests = testGroup "Unit Tests" [