diff --git a/library/Ptr/Prelude.hs b/library/Ptr/Prelude.hs --- a/library/Ptr/Prelude.hs +++ b/library/Ptr/Prelude.hs @@ -74,7 +74,7 @@ import GHC.IO.Exception as Exports import GHC.OverloadedLabels as Exports import Numeric as Exports -import StrictList as Exports (List (..)) +import StrictList as Exports (StrictList) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose) diff --git a/library/Ptr/Read.hs b/library/Ptr/Read.hs --- a/library/Ptr/Read.hs +++ b/library/Ptr/Read.hs @@ -23,6 +23,7 @@ import Ptr.Prelude hiding (Read) import qualified Ptr.Util.ByteString as ByteString import qualified Ptr.Util.Word8Predicates as Word8Predicates +import qualified StrictList -- | -- Deserializer highly optimized for reading from pointers. @@ -134,7 +135,7 @@ Int -> Read ByteString byteString totalNeededSize = - Read (collectChunks totalNeededSize Nil) + Read (collectChunks totalNeededSize StrictList.Nil) where collectChunks neededSize chunks startPtr endPtr = let nextPtr = plusPtr startPtr neededSize @@ -149,13 +150,13 @@ let lastChunkLength = minusPtr endPtr startPtr !chunk = ByteString.fromPtr lastChunkLength startPtr newNeededSize = neededSize - lastChunkLength - newChunks = Cons chunk chunks + newChunks = StrictList.Cons chunk chunks loop = collectChunks newNeededSize newChunks in return (UnfinishedStatus (Read loop)) byteStringWhile :: (Word8 -> Bool) -> Read ByteString byteStringWhile predicate = - Read (collectChunks 0 Nil) + Read (collectChunks 0 StrictList.Nil) where collectChunks totalLength chunks startPtr endPtr = populateChunk startPtr @@ -182,7 +183,7 @@ newTotalLength = totalLength + chunkLength newChunks = - Cons chunk chunks + StrictList.Cons chunk chunks in return (UnfinishedStatus (Read (collectChunks newTotalLength newChunks))) foldlWhile' :: (Word8 -> Bool) -> (acc -> Word8 -> acc) -> acc -> Read acc diff --git a/library/Ptr/Receive/Core.hs b/library/Ptr/Receive/Core.hs --- a/library/Ptr/Receive/Core.hs +++ b/library/Ptr/Receive/Core.hs @@ -10,37 +10,37 @@ then -- Buffer is empty, we need to fetch right away fetchMany fetch bufferFP bufferStateRef chunkSize howMany destination else -- We still have something in the buffer, so we'll read from it first - withForeignPtr bufferFP $ \bufferPtr -> - let amountInBuffer = end - offset - in if amountInBuffer >= howMany - then -- Buffer contains all we need, so we don't need to fetch at all - do - copyBytes destination (plusPtr bufferPtr offset) howMany - writeIORef bufferStateRef (offset + howMany, end) - return (Right ()) - else do - copyBytes destination (plusPtr bufferPtr offset) amountInBuffer - fetchMany fetch bufferFP bufferStateRef chunkSize (howMany - amountInBuffer) (plusPtr destination amountInBuffer) + withForeignPtr bufferFP $ \bufferPtr -> + let amountInBuffer = end - offset + in if amountInBuffer >= howMany + then -- Buffer contains all we need, so we don't need to fetch at all + do + copyBytes destination (plusPtr bufferPtr offset) howMany + writeIORef bufferStateRef (offset + howMany, end) + return (Right ()) + else do + copyBytes destination (plusPtr bufferPtr offset) amountInBuffer + fetchMany fetch bufferFP bufferStateRef chunkSize (howMany - amountInBuffer) (plusPtr destination amountInBuffer) fetchMany :: (Ptr Word8 -> Int -> IO (Either Text Int)) -> ForeignPtr Word8 -> IORef (Int, Int) -> Int -> Int -> Ptr Word8 -> IO (Either Text ()) fetchMany fetch bufferFP bufferStateRef chunkSize remaining destination = if remaining >= chunkSize then -- Circumvent the buffer and write to destination directly - fetchingSome destination chunkSize $ \amountFetched -> - if amountFetched == remaining - then -- We've fetched all we've wanted, time to stop - do - writeIORef bufferStateRef (0, 0) - return (Right ()) - else -- Go on and get some more - fetchMany fetch bufferFP bufferStateRef chunkSize (remaining - amountFetched) (plusPtr destination amountFetched) + fetchingSome destination chunkSize $ \amountFetched -> + if amountFetched == remaining + then -- We've fetched all we've wanted, time to stop + do + writeIORef bufferStateRef (0, 0) + return (Right ()) + else -- Go on and get some more + fetchMany fetch bufferFP bufferStateRef chunkSize (remaining - amountFetched) (plusPtr destination amountFetched) else -- Write to buffer first and then stream a part of it to the destination - withForeignPtr bufferFP $ \bufferPtr -> - fetchingSome bufferPtr chunkSize $ \amountFetched -> - do - copyBytes destination bufferPtr remaining - writeIORef bufferStateRef (remaining, amountFetched) - return (Right ()) + withForeignPtr bufferFP $ \bufferPtr -> + fetchingSome bufferPtr chunkSize $ \amountFetched -> + do + copyBytes destination bufferPtr remaining + writeIORef bufferStateRef (remaining, amountFetched) + return (Right ()) where fetchingSome destination amount handle = do @@ -59,25 +59,25 @@ let amountInBuffer = end - offset in if amountInBuffer >= howMany then -- We have enough bytes in the buffer, so need not to allocate anything and can directly decode from the buffer - withForeignPtr bufferFP $ \bufferPtr -> - do - peekd <- peek bufferPtr - writeIORef bufferStateRef (offset + howMany, end) - return (Right peekd) + withForeignPtr bufferFP $ \bufferPtr -> + do + peekd <- peek bufferPtr + writeIORef bufferStateRef (offset + howMany, end) + return (Right peekd) else -- We have to allocate a temporary space to prefetch the data into - allocaBytes howMany $ \tmpPtr -> - do - writeResult <- - if end == offset - then -- Buffer is empty, we need to fetch right away - fetchMany fetch bufferFP bufferStateRef chunkSize howMany tmpPtr - else -- We still have something in the buffer, so we'll read from it first - withForeignPtr bufferFP $ \bufferPtr -> - do - copyBytes tmpPtr (plusPtr bufferPtr offset) amountInBuffer - fetchMany fetch bufferFP bufferStateRef chunkSize (howMany - amountInBuffer) (plusPtr tmpPtr amountInBuffer) - case writeResult of - Right () -> do - peekd <- peek tmpPtr - return (Right peekd) - Left msg -> return (Left msg) + allocaBytes howMany $ \tmpPtr -> + do + writeResult <- + if end == offset + then -- Buffer is empty, we need to fetch right away + fetchMany fetch bufferFP bufferStateRef chunkSize howMany tmpPtr + else -- We still have something in the buffer, so we'll read from it first + withForeignPtr bufferFP $ \bufferPtr -> + do + copyBytes tmpPtr (plusPtr bufferPtr offset) amountInBuffer + fetchMany fetch bufferFP bufferStateRef chunkSize (howMany - amountInBuffer) (plusPtr tmpPtr amountInBuffer) + case writeResult of + Right () -> do + peekd <- peek tmpPtr + return (Right peekd) + Left msg -> return (Left msg) diff --git a/library/Ptr/Util/ByteString.hs b/library/Ptr/Util/ByteString.hs --- a/library/Ptr/Util/ByteString.hs +++ b/library/Ptr/Util/ByteString.hs @@ -10,7 +10,7 @@ -- __Warning:__ -- -- It is your responsibility to ensure that the size is correct. -fromReverseStrictList :: Int -> List ByteString -> ByteString +fromReverseStrictList :: Int -> StrictList ByteString -> ByteString fromReverseStrictList size chunks = unsafeCreate size (\ptr -> loop (plusPtr ptr size) chunks) where @@ -25,7 +25,7 @@ StrictList.Nil -> return () -fromReverseStrictListWithHead :: ByteString -> Int -> List ByteString -> ByteString +fromReverseStrictListWithHead :: ByteString -> Int -> StrictList ByteString -> ByteString fromReverseStrictListWithHead head sizeInTail tail = if sizeInTail == 0 then head diff --git a/ptr.cabal b/ptr.cabal --- a/ptr.cabal +++ b/ptr.cabal @@ -1,28 +1,26 @@ cabal-version: 3.0 -name: ptr -version: 0.16.8.7 -category: Ptr, Data -synopsis: Experimental abstractions for operations on pointers +name: ptr +version: 0.16.8.8 +category: Ptr, Data +synopsis: Experimental abstractions for operations on pointers description: Collection of experimental abstractions over pointer operations. -homepage: https://github.com/nikita-volkov/ptr -bug-reports: https://github.com/nikita-volkov/ptr/issues -author: Nikita Volkov -maintainer: Nikita Volkov -copyright: (c) 2017, Nikita Volkov -license: MIT -license-file: LICENSE +homepage: https://github.com/nikita-volkov/ptr +bug-reports: https://github.com/nikita-volkov/ptr/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2017, Nikita Volkov +license: MIT +license-file: LICENSE source-repository head - type: git + type: git location: https://github.com/nikita-volkov/ptr library - hs-source-dirs: library + hs-source-dirs: library default-extensions: - NoImplicitPrelude - NoMonomorphismRestriction Arrows BangPatterns BlockArguments @@ -45,6 +43,8 @@ MagicHash MultiParamTypeClasses MultiWayIf + NoImplicitPrelude + NoMonomorphismRestriction OverloadedStrings ParallelListComp PatternGuards @@ -61,7 +61,7 @@ TypeOperators UnboxedTuples - default-language: Haskell2010 + default-language: Haskell2010 exposed-modules: Ptr.ByteString Ptr.IO @@ -84,23 +84,25 @@ Ptr.Util.Word8Predicates build-depends: - , base >=4.11 && <5 - , bytestring >=0.10 && <0.13 - , contravariant >=1.3 && <2 - , profunctors >=5.1 && <6 - , strict-list >=0.1.5 && <0.2 - , text >=1 && <3 - , time >=1 && <2 - , vector >=0.12 && <0.14 + base >=4.11 && <5, + bytestring >=0.10 && <0.13, + contravariant >=1.3 && <2, + profunctors >=5.1 && <6, + strict-list >=1 && <1.1, + text >=1 && <3, + time >=1 && <2, + vector >=0.12 && <0.14, test-suite tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: Main.hs - ghc-options: -O2 -threaded -with-rtsopts=-N + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Main.hs + ghc-options: + -O2 + -threaded + -with-rtsopts=-N + default-extensions: - NoImplicitPrelude - NoMonomorphismRestriction Arrows BangPatterns BlockArguments @@ -123,6 +125,8 @@ MagicHash MultiParamTypeClasses MultiWayIf + NoImplicitPrelude + NoMonomorphismRestriction OverloadedStrings ParallelListComp PatternGuards @@ -139,25 +143,27 @@ TypeOperators UnboxedTuples - default-language: Haskell2010 + default-language: Haskell2010 build-depends: - , cereal >=0.5.8 && <0.6 - , ptr - , QuickCheck >=2.8.1 && <3 - , quickcheck-instances >=0.3.11 && <0.4 - , rerebase <2 - , tasty >=0.12 && <2 - , tasty-hunit >=0.9 && <0.11 - , tasty-quickcheck >=0.9 && <0.12 + QuickCheck >=2.8.1 && <3, + cereal >=0.5.8 && <0.6, + ptr, + quickcheck-instances >=0.3.11 && <0.4, + rerebase <2, + tasty >=0.12 && <2, + tasty-hunit >=0.9 && <0.11, + tasty-quickcheck >=0.9 && <0.12, benchmark bench - type: exitcode-stdio-1.0 - hs-source-dirs: bench - main-is: Main.hs - ghc-options: -O2 -threaded -with-rtsopts=-N + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Main.hs + ghc-options: + -O2 + -threaded + -with-rtsopts=-N + default-extensions: - NoImplicitPrelude - NoMonomorphismRestriction Arrows BangPatterns BlockArguments @@ -180,6 +186,8 @@ MagicHash MultiParamTypeClasses MultiWayIf + NoImplicitPrelude + NoMonomorphismRestriction OverloadedStrings ParallelListComp PatternGuards @@ -196,9 +204,9 @@ TypeOperators UnboxedTuples - default-language: Haskell2010 + default-language: Haskell2010 build-depends: - , cereal >=0.5.8 && <0.6 - , criterion ^>=1.6 - , ptr - , rerebase >=1.10.0.1 && <2 + cereal >=0.5.8 && <0.6, + criterion ^>=1.6, + ptr, + rerebase >=1.10.0.1 && <2,