From 67994dac54803ff2f2530478bfbd2efb259659fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Buckwalter?= <bjorn@buckwalter.se> Date: Sun, 22 Sep 2019 15:30:38 +0200 Subject: [PATCH 1/6] Move vector `slice` to Partial.hs modules. --- rio/src/RIO/Vector.hs | 1 - rio/src/RIO/Vector/Boxed.hs | 1 - rio/src/RIO/Vector/Boxed/Partial.hs | 1 + rio/src/RIO/Vector/Partial.hs | 1 + rio/src/RIO/Vector/Storable.hs | 1 - rio/src/RIO/Vector/Storable/Partial.hs | 1 + rio/src/RIO/Vector/Unboxed.hs | 1 - rio/src/RIO/Vector/Unboxed/Partial.hs | 1 + 8 files changed, 4 insertions(+), 4 deletions(-) diff --git a/rio/src/RIO/Vector.hs b/rio/src/RIO/Vector.hs index 51cc045..ffc5673 100644 --- a/rio/src/RIO/Vector.hs +++ b/rio/src/RIO/Vector.hs @@ -20,7 +20,6 @@ module RIO.Vector , (Data.Vector.Generic.!?) -- ** Extracting subvectors - , Data.Vector.Generic.slice , Data.Vector.Generic.take , Data.Vector.Generic.drop , Data.Vector.Generic.splitAt diff --git a/rio/src/RIO/Vector/Boxed.hs b/rio/src/RIO/Vector/Boxed.hs index d2ff45a..f185b44 100644 --- a/rio/src/RIO/Vector/Boxed.hs +++ b/rio/src/RIO/Vector/Boxed.hs @@ -21,7 +21,6 @@ module RIO.Vector.Boxed , (Data.Vector.!?) -- ** Extracting subvectors - , Data.Vector.slice , Data.Vector.take , Data.Vector.drop , Data.Vector.splitAt diff --git a/rio/src/RIO/Vector/Boxed/Partial.hs b/rio/src/RIO/Vector/Boxed/Partial.hs index c3663a5..43ba44e 100644 --- a/rio/src/RIO/Vector/Boxed/Partial.hs +++ b/rio/src/RIO/Vector/Boxed/Partial.hs @@ -17,6 +17,7 @@ module RIO.Vector.Boxed.Partial -- ** Extracting subvectors , Data.Vector.init , Data.Vector.tail + , Data.Vector.slice -- * Modifying vectors -- ** Bulk updates diff --git a/rio/src/RIO/Vector/Partial.hs b/rio/src/RIO/Vector/Partial.hs index 11f7df7..41d6608 100644 --- a/rio/src/RIO/Vector/Partial.hs +++ b/rio/src/RIO/Vector/Partial.hs @@ -17,6 +17,7 @@ module RIO.Vector.Partial -- ** Extracting subvectors , Data.Vector.Generic.init , Data.Vector.Generic.tail + , Data.Vector.Generic.slice -- * Modifying vectors -- ** Bulk updates diff --git a/rio/src/RIO/Vector/Storable.hs b/rio/src/RIO/Vector/Storable.hs index cb2a708..7d58a9a 100644 --- a/rio/src/RIO/Vector/Storable.hs +++ b/rio/src/RIO/Vector/Storable.hs @@ -22,7 +22,6 @@ module RIO.Vector.Storable , (Data.Vector.Storable.!?) -- ** Extracting subvectors - , Data.Vector.Storable.slice , Data.Vector.Storable.take , Data.Vector.Storable.drop , Data.Vector.Storable.splitAt diff --git a/rio/src/RIO/Vector/Storable/Partial.hs b/rio/src/RIO/Vector/Storable/Partial.hs index 3e30163..c7920de 100644 --- a/rio/src/RIO/Vector/Storable/Partial.hs +++ b/rio/src/RIO/Vector/Storable/Partial.hs @@ -17,6 +17,7 @@ module RIO.Vector.Storable.Partial -- ** Extracting subvectors , Data.Vector.Storable.init , Data.Vector.Storable.tail + , Data.Vector.Storable.slice -- * Modifying vectors -- ** Bulk updates diff --git a/rio/src/RIO/Vector/Unboxed.hs b/rio/src/RIO/Vector/Unboxed.hs index 9307110..e340406 100644 --- a/rio/src/RIO/Vector/Unboxed.hs +++ b/rio/src/RIO/Vector/Unboxed.hs @@ -22,7 +22,6 @@ module RIO.Vector.Unboxed , (Data.Vector.Unboxed.!?) -- ** Extracting subvectors - , Data.Vector.Unboxed.slice , Data.Vector.Unboxed.take , Data.Vector.Unboxed.drop , Data.Vector.Unboxed.splitAt diff --git a/rio/src/RIO/Vector/Unboxed/Partial.hs b/rio/src/RIO/Vector/Unboxed/Partial.hs index 86a0a8e..796a14e 100644 --- a/rio/src/RIO/Vector/Unboxed/Partial.hs +++ b/rio/src/RIO/Vector/Unboxed/Partial.hs @@ -17,6 +17,7 @@ module RIO.Vector.Unboxed.Partial -- ** Extracting subvectors , Data.Vector.Unboxed.init , Data.Vector.Unboxed.tail + , Data.Vector.Unboxed.slice -- * Modifying vectors -- ** Bulk updates From 1932046beac442b4e2c028d8c0001f2f56f40257 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Buckwalter?= <bjorn@buckwalter.se> Date: Sun, 22 Sep 2019 18:07:18 +0200 Subject: [PATCH 2/6] `sliceMaybe` function and specs. --- rio/src/RIO/Vector.hs | 18 ++++++++++++++++++ rio/src/RIO/Vector/Boxed.hs | 2 ++ rio/src/RIO/Vector/Storable.hs | 2 ++ rio/src/RIO/Vector/Unboxed.hs | 2 ++ rio/test/RIO/VectorSpec.hs | 28 ++++++++++++++++++++++++++++ 5 files changed, 52 insertions(+) create mode 100644 rio/test/RIO/VectorSpec.hs diff --git a/rio/src/RIO/Vector.hs b/rio/src/RIO/Vector.hs index ffc5673..162cf20 100644 --- a/rio/src/RIO/Vector.hs +++ b/rio/src/RIO/Vector.hs @@ -20,6 +20,7 @@ module RIO.Vector , (Data.Vector.Generic.!?) -- ** Extracting subvectors + , sliceMaybe , Data.Vector.Generic.take , Data.Vector.Generic.drop , Data.Vector.Generic.splitAt @@ -256,3 +257,20 @@ module RIO.Vector ) where import qualified Data.Vector.Generic +import Data.Vector.Generic (Vector) +import Control.Monad (guard) + +-- | /O(1)/ Yield a slice of the vector without copying it. If the vector +-- cannot satisfy the specificed slice 'Nothing' is returned. +-- +-- @since 0.1.13.0 +sliceMaybe :: Vector v a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> v a + -> Maybe (v a) +sliceMaybe i n v = do + guard $ i >= 0 + guard $ n >= 0 + guard $ Data.Vector.Generic.length v >= i + n + pure $ Data.Vector.Generic.slice i n v diff --git a/rio/src/RIO/Vector/Boxed.hs b/rio/src/RIO/Vector/Boxed.hs index f185b44..09ddbf3 100644 --- a/rio/src/RIO/Vector/Boxed.hs +++ b/rio/src/RIO/Vector/Boxed.hs @@ -21,6 +21,7 @@ module RIO.Vector.Boxed , (Data.Vector.!?) -- ** Extracting subvectors + , V.sliceMaybe , Data.Vector.take , Data.Vector.drop , Data.Vector.splitAt @@ -221,3 +222,4 @@ module RIO.Vector.Boxed ) where import qualified Data.Vector +import qualified RIO.Vector as V diff --git a/rio/src/RIO/Vector/Storable.hs b/rio/src/RIO/Vector/Storable.hs index 7d58a9a..00733c3 100644 --- a/rio/src/RIO/Vector/Storable.hs +++ b/rio/src/RIO/Vector/Storable.hs @@ -22,6 +22,7 @@ module RIO.Vector.Storable , (Data.Vector.Storable.!?) -- ** Extracting subvectors + , V.sliceMaybe , Data.Vector.Storable.take , Data.Vector.Storable.drop , Data.Vector.Storable.splitAt @@ -187,3 +188,4 @@ module RIO.Vector.Storable ) where import qualified Data.Vector.Storable +import qualified RIO.Vector as V diff --git a/rio/src/RIO/Vector/Unboxed.hs b/rio/src/RIO/Vector/Unboxed.hs index e340406..829cf6e 100644 --- a/rio/src/RIO/Vector/Unboxed.hs +++ b/rio/src/RIO/Vector/Unboxed.hs @@ -22,6 +22,7 @@ module RIO.Vector.Unboxed , (Data.Vector.Unboxed.!?) -- ** Extracting subvectors + , V.sliceMaybe , Data.Vector.Unboxed.take , Data.Vector.Unboxed.drop , Data.Vector.Unboxed.splitAt @@ -210,3 +211,4 @@ module RIO.Vector.Unboxed ) where import qualified Data.Vector.Unboxed +import qualified RIO.Vector as V diff --git a/rio/test/RIO/VectorSpec.hs b/rio/test/RIO/VectorSpec.hs new file mode 100644 index 0000000..d092e7e --- /dev/null +++ b/rio/test/RIO/VectorSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module RIO.VectorSpec where + +import Test.Hspec +import RIO +import qualified RIO.Vector.Boxed as VB + +spec :: Spec +spec = + describe "sliceMaybe" $ do + it "fails on negative index" $ + VB.sliceMaybe (-1) 0 v `shouldBe` Nothing + it "fails on negative slice length" $ + VB.sliceMaybe 0 (-1) v `shouldBe` Nothing + it "fails when index too large" $ + VB.sliceMaybe (VB.length v + 1) 0 v `shouldBe` Nothing + it "fails when slice too large" $ + VB.sliceMaybe 0 (VB.length v + 1) v `shouldBe` Nothing + it "works for all of vector" $ + VB.sliceMaybe 0 (VB.length v) v `shouldBe` Just v + it "works for zero slice length" $ + VB.sliceMaybe 0 0 v `shouldBe` Just mempty + it "works for zero vector" $ + VB.sliceMaybe 0 0 (mempty :: VB.Vector ()) `shouldBe` Just mempty + it "works for end of vector" $ + VB.sliceMaybe (VB.length v) 0 v `shouldBe` Just mempty + where + v = VB.fromList "foobar" From 71922d72e883d8768550d7e81bc1de44dc066de7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Buckwalter?= <bjorn@buckwalter.se> Date: Mon, 23 Sep 2019 01:48:51 +0200 Subject: [PATCH 3/6] `slice` updates in changelog. --- rio/ChangeLog.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rio/ChangeLog.md b/rio/ChangeLog.md index 03e966b..cf87855 100644 --- a/rio/ChangeLog.md +++ b/rio/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for rio +## 0.1.13.0 + +* Move vector `slice` functions to `Partial` modules and add `RIO.Vector.sliceMaybe` function. + ## 0.1.12.0 * Add `logFormat` and `setLogFormat` for `LogOptions`. From 27ed33234a2ad6ede2c0f0d37a06bfe4106074ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Buckwalter?= <bjorn@buckwalter.se> Date: Mon, 23 Sep 2019 10:24:14 +0200 Subject: [PATCH 4/6] Overflow-safe guard for slice upper bound. --- rio/src/RIO/Vector.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rio/src/RIO/Vector.hs b/rio/src/RIO/Vector.hs index 162cf20..efa952b 100644 --- a/rio/src/RIO/Vector.hs +++ b/rio/src/RIO/Vector.hs @@ -272,5 +272,5 @@ sliceMaybe :: Vector v a sliceMaybe i n v = do guard $ i >= 0 guard $ n >= 0 - guard $ Data.Vector.Generic.length v >= i + n + guard $ Data.Vector.Generic.length v - n >= i pure $ Data.Vector.Generic.slice i n v From 0e599574237c271498e7cb3081acdcc0ca603889 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Buckwalter?= <bjorn@buckwalter.se> Date: Mon, 23 Sep 2019 15:51:16 +0200 Subject: [PATCH 5/6] Property testing. Special casing is required due to GHC issue <https://gitlab.haskell.org/ghc/ghc/issues/17233>. --- rio/test/RIO/VectorSpec.hs | 42 ++++++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/rio/test/RIO/VectorSpec.hs b/rio/test/RIO/VectorSpec.hs index d092e7e..5a6b3fa 100644 --- a/rio/test/RIO/VectorSpec.hs +++ b/rio/test/RIO/VectorSpec.hs @@ -2,27 +2,33 @@ module RIO.VectorSpec where import Test.Hspec +import Test.Hspec.QuickCheck (prop) +import qualified Test.QuickCheck as QC import RIO -import qualified RIO.Vector.Boxed as VB +import qualified RIO.Vector as V +import qualified RIO.Vector.Partial as V' spec :: Spec spec = describe "sliceMaybe" $ do - it "fails on negative index" $ - VB.sliceMaybe (-1) 0 v `shouldBe` Nothing - it "fails on negative slice length" $ - VB.sliceMaybe 0 (-1) v `shouldBe` Nothing - it "fails when index too large" $ - VB.sliceMaybe (VB.length v + 1) 0 v `shouldBe` Nothing - it "fails when slice too large" $ - VB.sliceMaybe 0 (VB.length v + 1) v `shouldBe` Nothing - it "works for all of vector" $ - VB.sliceMaybe 0 (VB.length v) v `shouldBe` Just v - it "works for zero slice length" $ - VB.sliceMaybe 0 0 v `shouldBe` Just mempty - it "works for zero vector" $ - VB.sliceMaybe 0 0 (mempty :: VB.Vector ()) `shouldBe` Just mempty - it "works for end of vector" $ - VB.sliceMaybe (VB.length v) 0 v `shouldBe` Just mempty + prop "is consistent with `slice` (pathological cases)" $ + \(QC.Large i) (QC.Large n) v + -> sliceTest i n (V.fromList v) + -- The next property is a subset of the previous one but with + -- significantly greater likelyhood of having "realistic" + -- arguments to `slice`. + prop "is consistent with `slice` (more realistic cases)" $ + \(QC.NonNegative i) (QC.NonNegative n) (QC.NonEmpty v) + -> sliceTest i n (V.fromList v) where - v = VB.fromList "foobar" + sliceTest :: Int -> Int -> Vector Char -> QC.Property + sliceTest i n v = QC.withMaxSuccess 1000 $ case V.sliceMaybe i n v of + Just v' -> V'.slice i n v `shouldBe` v' + Nothing -> do + -- Special case handling for cases when `i+n` overflows. This is + -- required due to <https://gitlab.haskell.org/ghc/ghc/issues/17233>. + -- Once that GHC issue is closed the `when` clause can be removed. + -- (Negative overflow is not an issue as an exception is thrown for + -- negative arguments.) + when (i > 0 && n > 0 && n + i < 0) QC.discard -- `i+n` overflows + evaluate (V'.slice i n v) `shouldThrow` anyException From 8673eb7c7f07530ae9108ec0490f5e277320bc12 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Buckwalter?= <bjorn@buckwalter.se> Date: Mon, 23 Sep 2019 16:50:06 +0200 Subject: [PATCH 6/6] Shim `slice` to protect against overflow. Pending <https://gitlab.haskell.org/ghc/ghc/issues/17233>. --- rio/src/RIO/Vector/Boxed/Partial.hs | 3 ++- rio/src/RIO/Vector/Partial.hs | 22 +++++++++++++++++++++- rio/src/RIO/Vector/Storable/Partial.hs | 3 ++- rio/src/RIO/Vector/Unboxed/Partial.hs | 3 ++- rio/test/RIO/VectorSpec.hs | 9 +-------- 5 files changed, 28 insertions(+), 12 deletions(-) diff --git a/rio/src/RIO/Vector/Boxed/Partial.hs b/rio/src/RIO/Vector/Boxed/Partial.hs index 43ba44e..18e9d5e 100644 --- a/rio/src/RIO/Vector/Boxed/Partial.hs +++ b/rio/src/RIO/Vector/Boxed/Partial.hs @@ -17,7 +17,7 @@ module RIO.Vector.Boxed.Partial -- ** Extracting subvectors , Data.Vector.init , Data.Vector.tail - , Data.Vector.slice + , RIO.Vector.Partial.slice -- Pending <https://gitlab.haskell.org/ghc/ghc/issues/17233> -- * Modifying vectors -- ** Bulk updates @@ -63,3 +63,4 @@ module RIO.Vector.Boxed.Partial ) where import qualified Data.Vector +import qualified RIO.Vector.Partial diff --git a/rio/src/RIO/Vector/Partial.hs b/rio/src/RIO/Vector/Partial.hs index 41d6608..241e3d0 100644 --- a/rio/src/RIO/Vector/Partial.hs +++ b/rio/src/RIO/Vector/Partial.hs @@ -17,7 +17,7 @@ module RIO.Vector.Partial -- ** Extracting subvectors , Data.Vector.Generic.init , Data.Vector.Generic.tail - , Data.Vector.Generic.slice + , slice -- Pending <https://gitlab.haskell.org/ghc/ghc/issues/17233> -- * Modifying vectors -- ** Bulk updates @@ -63,3 +63,23 @@ module RIO.Vector.Partial ) where import qualified Data.Vector.Generic + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Data.Vector.Generic.Vector v a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> v a + -> v a +slice i n v = if i > 0 && n > 0 && i + n < 0 -- `i+n` overflows + -- Special case handling for cases when `i+n` overflows. This is + -- required due to <https://gitlab.haskell.org/ghc/ghc/issues/17233>. + -- Once that GHC issue is closed this function can be replaced by + -- `Data.Vector.Generic.slice`. + -- (Negative overflow is not an issue as an `Date.Vector.Generic.slice` + -- throws an exception is thrown for negative arguments.) + then error $ "slice: invalid slice (" + ++ show i ++ "," + ++ show n ++ "," + ++ show (Data.Vector.Generic.length v) ++ ")" + else Data.Vector.Generic.slice i n v diff --git a/rio/src/RIO/Vector/Storable/Partial.hs b/rio/src/RIO/Vector/Storable/Partial.hs index c7920de..5a48082 100644 --- a/rio/src/RIO/Vector/Storable/Partial.hs +++ b/rio/src/RIO/Vector/Storable/Partial.hs @@ -17,7 +17,7 @@ module RIO.Vector.Storable.Partial -- ** Extracting subvectors , Data.Vector.Storable.init , Data.Vector.Storable.tail - , Data.Vector.Storable.slice + , RIO.Vector.Partial.slice -- Pending <https://gitlab.haskell.org/ghc/ghc/issues/17233> -- * Modifying vectors -- ** Bulk updates @@ -61,3 +61,4 @@ module RIO.Vector.Storable.Partial ) where import qualified Data.Vector.Storable +import qualified RIO.Vector.Partial diff --git a/rio/src/RIO/Vector/Unboxed/Partial.hs b/rio/src/RIO/Vector/Unboxed/Partial.hs index 796a14e..b98f367 100644 --- a/rio/src/RIO/Vector/Unboxed/Partial.hs +++ b/rio/src/RIO/Vector/Unboxed/Partial.hs @@ -17,7 +17,7 @@ module RIO.Vector.Unboxed.Partial -- ** Extracting subvectors , Data.Vector.Unboxed.init , Data.Vector.Unboxed.tail - , Data.Vector.Unboxed.slice + , RIO.Vector.Partial.slice -- Pending <https://gitlab.haskell.org/ghc/ghc/issues/17233> -- * Modifying vectors -- ** Bulk updates @@ -63,3 +63,4 @@ module RIO.Vector.Unboxed.Partial ) where import qualified Data.Vector.Unboxed +import qualified RIO.Vector.Partial diff --git a/rio/test/RIO/VectorSpec.hs b/rio/test/RIO/VectorSpec.hs index 5a6b3fa..c492b4c 100644 --- a/rio/test/RIO/VectorSpec.hs +++ b/rio/test/RIO/VectorSpec.hs @@ -24,11 +24,4 @@ spec = sliceTest :: Int -> Int -> Vector Char -> QC.Property sliceTest i n v = QC.withMaxSuccess 1000 $ case V.sliceMaybe i n v of Just v' -> V'.slice i n v `shouldBe` v' - Nothing -> do - -- Special case handling for cases when `i+n` overflows. This is - -- required due to <https://gitlab.haskell.org/ghc/ghc/issues/17233>. - -- Once that GHC issue is closed the `when` clause can be removed. - -- (Negative overflow is not an issue as an exception is thrown for - -- negative arguments.) - when (i > 0 && n > 0 && n + i < 0) QC.discard -- `i+n` overflows - evaluate (V'.slice i n v) `shouldThrow` anyException + Nothing -> evaluate (V'.slice i n v) `shouldThrow` anyException