diff --git a/doctest/DoctestDriver.hs b/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} +#else +module Main where + +import qualified System.IO as IO + +main :: IO () +main = IO.putStrLn "WARNING: doctest will not run on GHC versions earlier than 8.4.4" +#endif diff --git a/hw-prim.cabal b/hw-prim.cabal --- a/hw-prim.cabal +++ b/hw-prim.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-prim -version: 0.6.2.39 +version: 0.6.2.40 synopsis: Primitive functions and data types description: Primitive functions and data types. category: Data @@ -10,10 +10,10 @@ bug-reports: https://github.com/haskell-works/hw-prim/issues author: John Ky maintainer: newhoggy@gmail.com -copyright: 2016-2019 John Ky +copyright: 2016-2020 John Ky license: BSD-3-Clause license-file: LICENSE -tested-with: GHC == 8.8.1, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2 +tested-with: GHC == 8.8.2, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2 build-type: Simple extra-source-files: README.md @@ -26,33 +26,37 @@ manual: False default: False -common base { build-depends: base >= 4 && < 5 } +common base { build-depends: base >= 4 && < 5 } -common QuickCheck { build-depends: QuickCheck >= 2.10 && < 2.14 } -common bytestring { build-depends: bytestring >= 0.9 && < 0.11 } -common criterion { build-depends: criterion >= 1.2 && < 1.6 } -common deepseq { build-depends: deepseq >= 1.4 && < 1.5 } -common directory { build-depends: directory >= 1.2 && < 1.4 } -common exceptions { build-depends: exceptions >= 0.8 && < 0.11 } -common ghc-prim { build-depends: ghc-prim >= 0.5 && < 0.6 } -common hedgehog { build-depends: hedgehog >= 1.0 && < 1.1 } -common hspec { build-depends: hspec >= 2.4 && < 2.8 } -common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } -common mmap { build-depends: mmap >= 0.5 && < 0.6 } -common semigroups { build-depends: semigroups >= 0.8.4 && < 0.20 } -common transformers { build-depends: transformers >= 0.4 && < 0.6 } -common vector { build-depends: vector >= 0.12 && < 0.13 } -common unliftio-core { build-depends: unliftio-core >= 0.1.2.0 && < 0.2 } +common QuickCheck { build-depends: QuickCheck >= 2.10 && < 2.14 } +common bytestring { build-depends: bytestring >= 0.9 && < 0.11 } +common criterion { build-depends: criterion >= 1.2 && < 1.6 } +common deepseq { build-depends: deepseq >= 1.4 && < 1.5 } +common directory { build-depends: directory >= 1.2 && < 1.4 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } +common exceptions { build-depends: exceptions >= 0.8 && < 0.11 } +common ghc-prim { build-depends: ghc-prim >= 0.5 && < 0.6 } +common hedgehog { build-depends: hedgehog >= 1.0 && < 1.1 } +common hspec { build-depends: hspec >= 2.4 && < 2.8 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } +common mmap { build-depends: mmap >= 0.5 && < 0.6 } +common semigroups { build-depends: semigroups >= 0.8.4 && < 0.20 } +common transformers { build-depends: transformers >= 0.4 && < 0.6 } +common vector { build-depends: vector >= 0.12 && < 0.13 } +common unliftio-core { build-depends: unliftio-core >= 0.1.2.0 && < 0.2 } -common common +common hw-prim + build-depends: hw-prim + +common config default-language: Haskell2010 ghc-options: -Wall -O2 -msse4.2 if flag(bounds-checking-enabled) cpp-options: -DBOUNDS_CHECKING_ENABLED library - import: base - , common + import: base, config , bytestring , deepseq , ghc-prim @@ -112,8 +116,7 @@ hs-source-dirs: src test-suite hw-prim-test - import: base - , common + import: base, config , QuickCheck , bytestring , directory @@ -121,6 +124,7 @@ , hedgehog , hspec , hw-hspec-hedgehog + , hw-prim , mmap , semigroups , transformers @@ -137,25 +141,32 @@ HaskellWorks.Data.Vector.AsVector8nsSpec HaskellWorks.Data.Vector.AsVector8sSpec HaskellWorks.Data.Vector.StorableSpec - Paths_hw_prim - autogen-modules: Paths_hw_prim - build-depends: hw-prim hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-tool-depends: hspec-discover:hspec-discover benchmark bench - import: base - , common + import: base, config , bytestring , criterion + , hw-prim , mmap , semigroups , transformers , vector type: exitcode-stdio-1.0 main-is: Main.hs - other-modules: Paths_hw_prim hs-source-dirs: bench build-depends: hw-prim - autogen-modules: Paths_hw_prim + +test-suite doctest + import: base, config + , doctest + , doctest-discover + , hw-prim + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: DoctestDriver.hs + HS-Source-Dirs: doctest + build-tool-depends: doctest-discover:doctest-discover diff --git a/src/HaskellWorks/Data/Vector/Storable.hs b/src/HaskellWorks/Data/Vector/Storable.hs --- a/src/HaskellWorks/Data/Vector/Storable.hs +++ b/src/HaskellWorks/Data/Vector/Storable.hs @@ -10,6 +10,7 @@ , constructSI , construct2N , construct64UnzipN + , unzipFromListN2 ) where import Control.Monad.ST (ST, runST) @@ -18,7 +19,7 @@ import Data.Word import Foreign.ForeignPtr import HaskellWorks.Data.Vector.AsVector8 -import Prelude hiding (foldMap) +import Prelude hiding (abs, foldMap) import qualified Data.ByteString as BS import qualified Data.Vector.Generic as DVG @@ -126,3 +127,25 @@ DVSM.set (DVSM.take ibl ibmv) 0 DVSM.set (DVSM.take bpl bpmv) 0 return (DVSM.length (DVSM.drop ibl ibmv), DVSM.length (DVSM.drop bpl bpmv)) + +unzipFromListN2 :: (Storable a, Storable b) => Int -> [(a, b)] -> (DVS.Vector a, DVS.Vector b) +unzipFromListN2 n abs = runST $ do + mas <- DVSM.unsafeNew n + mbs <- DVSM.unsafeNew n + len <- go 0 mas mbs abs + as <- DVG.unsafeFreeze (DVSM.take len mas) + bs <- DVG.unsafeFreeze (DVSM.take len mbs) + return (as, bs) + where go :: (Storable c, Storable d) + => Int + -> DVSM.MVector s c + -> DVSM.MVector s d + -> [(c, d)] + -> ST s Int + go i _ _ [] = return i + go i mvc mvd ((c, d):cds) = if i < n + then do + DVSM.write mvc i c + DVSM.write mvd i d + go (i + 1) mvc mvd cds + else return i diff --git a/test/HaskellWorks/Data/ByteStringSpec.hs b/test/HaskellWorks/Data/ByteStringSpec.hs --- a/test/HaskellWorks/Data/ByteStringSpec.hs +++ b/test/HaskellWorks/Data/ByteStringSpec.hs @@ -13,7 +13,7 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.ByteStringSpec" $ do @@ -50,4 +50,3 @@ it "rechunk creates correctly sized segments" $ requireProperty $ do ws <- forAll $ G.list (R.linear 0 (LBSI.defaultChunkSize `div` 4)) (G.word64 R.constantBounded) fold (BS.toByteStrings ws) === BS.toByteString ws - diff --git a/test/HaskellWorks/Data/FoldableSpec.hs b/test/HaskellWorks/Data/FoldableSpec.hs --- a/test/HaskellWorks/Data/FoldableSpec.hs +++ b/test/HaskellWorks/Data/FoldableSpec.hs @@ -13,13 +13,13 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.FoldableSpec" $ do it "foldFirst" $ requireProperty $ do - as <- forAll $ G.list (R.linear 0 10) (G.int (R.constantBounded)) + as <- forAll $ G.list (R.linear 0 10) (G.int R.constantBounded) foldFirst as === listToMaybe as it "foldLast" $ requireProperty $ do - as <- forAll $ G.list (R.linear 0 10) (G.int (R.constantBounded)) + as <- forAll $ G.list (R.linear 0 10) (G.int R.constantBounded) foldLast as === listToMaybe (reverse as) diff --git a/test/HaskellWorks/Data/FromByteStringSpec.hs b/test/HaskellWorks/Data/FromByteStringSpec.hs --- a/test/HaskellWorks/Data/FromByteStringSpec.hs +++ b/test/HaskellWorks/Data/FromByteStringSpec.hs @@ -11,7 +11,7 @@ import qualified Data.ByteString as BS import qualified Data.Vector.Storable as DVS -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.FromByteStringSpec" $ do diff --git a/test/HaskellWorks/Data/FromForeignRegionSpec.hs b/test/HaskellWorks/Data/FromForeignRegionSpec.hs --- a/test/HaskellWorks/Data/FromForeignRegionSpec.hs +++ b/test/HaskellWorks/Data/FromForeignRegionSpec.hs @@ -21,7 +21,7 @@ import qualified System.Directory as IO import qualified System.IO as IO -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.FromForeignRegionSpec" $ do diff --git a/test/HaskellWorks/Data/SearchSpec.hs b/test/HaskellWorks/Data/SearchSpec.hs --- a/test/HaskellWorks/Data/SearchSpec.hs +++ b/test/HaskellWorks/Data/SearchSpec.hs @@ -5,7 +5,7 @@ import HaskellWorks.Data.Search import Test.Hspec -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.SearchSpec" $ do diff --git a/test/HaskellWorks/Data/Vector/AsVector64nsSpec.hs b/test/HaskellWorks/Data/Vector/AsVector64nsSpec.hs --- a/test/HaskellWorks/Data/Vector/AsVector64nsSpec.hs +++ b/test/HaskellWorks/Data/Vector/AsVector64nsSpec.hs @@ -17,7 +17,7 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Vector.AsVector64nsSpec" $ do diff --git a/test/HaskellWorks/Data/Vector/AsVector64sSpec.hs b/test/HaskellWorks/Data/Vector/AsVector64sSpec.hs --- a/test/HaskellWorks/Data/Vector/AsVector64sSpec.hs +++ b/test/HaskellWorks/Data/Vector/AsVector64sSpec.hs @@ -17,7 +17,7 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Vector.AsVector64sSpec" $ do diff --git a/test/HaskellWorks/Data/Vector/AsVector8nsSpec.hs b/test/HaskellWorks/Data/Vector/AsVector8nsSpec.hs --- a/test/HaskellWorks/Data/Vector/AsVector8nsSpec.hs +++ b/test/HaskellWorks/Data/Vector/AsVector8nsSpec.hs @@ -17,7 +17,7 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Vector.AsVector8nsSpec" $ do diff --git a/test/HaskellWorks/Data/Vector/AsVector8sSpec.hs b/test/HaskellWorks/Data/Vector/AsVector8sSpec.hs --- a/test/HaskellWorks/Data/Vector/AsVector8sSpec.hs +++ b/test/HaskellWorks/Data/Vector/AsVector8sSpec.hs @@ -17,7 +17,7 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Vector.AsVector8sSpec" $ do diff --git a/test/HaskellWorks/Data/Vector/StorableSpec.hs b/test/HaskellWorks/Data/Vector/StorableSpec.hs --- a/test/HaskellWorks/Data/Vector/StorableSpec.hs +++ b/test/HaskellWorks/Data/Vector/StorableSpec.hs @@ -6,11 +6,11 @@ ( spec ) where -import Control.Monad.ST (ST) -import Data.Vector.Storable (Storable) -import HaskellWorks.Data.Vector.Storable (construct64UnzipN) +import Control.Monad.ST (ST) +import Data.Vector.Storable (Storable) import HaskellWorks.Hspec.Hedgehog import Hedgehog +import Prelude hiding (abs) import Test.Hspec import qualified Data.ByteString as BS @@ -22,7 +22,7 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Vector.StorableSpec" $ do @@ -51,11 +51,23 @@ al <- forAll $ pure $ BS.length (mconcat ass) bl <- forAll $ pure $ BS.length (mconcat bss) len <- forAll $ pure $ al + bl - let res = construct64UnzipN len (zip ass bss) + let res = DVS.construct64UnzipN len (zip ass bss) let ra = BS.toByteString (fst res) let rb = BS.toByteString (snd res) ra === BS.padded ((BS.length as + 7) `div` 8 * 8) as rb === BS.padded ((BS.length bs + 7) `div` 8 * 8) bs + it "unzipFromListN2" $ requireProperty $ do + abs <- forAll $ G.list (R.linear 0 8) $ (,) + <$> G.word8 R.constantBounded + <*> G.word8 R.constantBounded + len <- forAll $ G.int (R.linear 0 8) + as <- forAll $ pure $ fmap fst abs + bs <- forAll $ pure $ fmap snd abs + (va, vb) <- forAll $ pure $ DVS.unzipFromListN2 len abs + let eva = DVS.fromList (take len as) + let evb = DVS.fromList (take len bs) + va === eva + vb === evb dupList :: [a] -> [a] dupList (a:as) = (a:a:dupList as)