Initial commit. The library includes a simple Builder, a Semigroup instance, primitives for running the builder, and a function for decimal-encoding a 64-bit word. There is also a test suite to confirm that it works.
This commit is contained in:
commit
0d63fbc60d
7 changed files with 247 additions and 0 deletions
27
.gitignore
vendored
Normal file
27
.gitignore
vendored
Normal file
|
@ -0,0 +1,27 @@
|
||||||
|
dist
|
||||||
|
dist-*
|
||||||
|
cabal-dev
|
||||||
|
*.o
|
||||||
|
*.hi
|
||||||
|
*.chi
|
||||||
|
*.chs.h
|
||||||
|
*.dyn_o
|
||||||
|
*.dyn_hi
|
||||||
|
.hpc
|
||||||
|
.hsenv
|
||||||
|
.cabal-sandbox/
|
||||||
|
cabal.sandbox.config
|
||||||
|
*.prof
|
||||||
|
*.aux
|
||||||
|
*.hp
|
||||||
|
*.eventlog
|
||||||
|
.stack-work/
|
||||||
|
cabal.project.local
|
||||||
|
cabal.project.local~
|
||||||
|
.HTF/
|
||||||
|
.ghc.environment.*
|
||||||
|
stack.yaml
|
||||||
|
*.swm
|
||||||
|
*.swo
|
||||||
|
*.swp
|
||||||
|
test_results/**
|
5
CHANGELOG.md
Normal file
5
CHANGELOG.md
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
# Revision history for small-bytearray-builder
|
||||||
|
|
||||||
|
## 0.1.0.0 -- YYYY-mm-dd
|
||||||
|
|
||||||
|
* First version. Released on an unsuspecting world.
|
30
LICENSE
Normal file
30
LICENSE
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
Copyright (c) 2019, Andrew Martin
|
||||||
|
|
||||||
|
All rights reserved.
|
||||||
|
|
||||||
|
Redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
* Redistributions of source code must retain the above copyright
|
||||||
|
notice, this list of conditions and the following disclaimer.
|
||||||
|
|
||||||
|
* Redistributions in binary form must reproduce the above
|
||||||
|
copyright notice, this list of conditions and the following
|
||||||
|
disclaimer in the documentation and/or other materials provided
|
||||||
|
with the distribution.
|
||||||
|
|
||||||
|
* Neither the name of Andrew Martin nor the names of other
|
||||||
|
contributors may be used to endorse or promote products derived
|
||||||
|
from this software without specific prior written permission.
|
||||||
|
|
||||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||||
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||||
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||||
|
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||||
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||||
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||||
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||||
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||||
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
2
Setup.hs
Normal file
2
Setup.hs
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
import Distribution.Simple
|
||||||
|
main = defaultMain
|
40
small-bytearray-builder.cabal
Normal file
40
small-bytearray-builder.cabal
Normal file
|
@ -0,0 +1,40 @@
|
||||||
|
cabal-version: 2.2
|
||||||
|
name: small-bytearray-builder
|
||||||
|
version: 0.1.0.0
|
||||||
|
-- synopsis:
|
||||||
|
-- description:
|
||||||
|
homepage: https://github.com/andrewthad/small-bytearray-builder
|
||||||
|
-- bug-reports:
|
||||||
|
license: BSD-3-Clause
|
||||||
|
license-file: LICENSE
|
||||||
|
author: Andrew Martin
|
||||||
|
maintainer: andrew.thaddeus@gmail.com
|
||||||
|
copyright: 2019 Andrew Martin
|
||||||
|
category: Data
|
||||||
|
extra-source-files: CHANGELOG.md
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules:
|
||||||
|
Data.ByteArray.Builder.Small
|
||||||
|
-- other-modules:
|
||||||
|
-- other-extensions:
|
||||||
|
build-depends:
|
||||||
|
base >=4.12.0.0 && <5
|
||||||
|
, primitive >=0.7 && <0.8
|
||||||
|
, byteslice >=0.1 && <0.2
|
||||||
|
ghc-options: -Wall -O2 -ddump-to-file -ddump-simpl
|
||||||
|
hs-source-dirs: src
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite test
|
||||||
|
default-language: Haskell2010
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
hs-source-dirs: test
|
||||||
|
main-is: Main.hs
|
||||||
|
build-depends:
|
||||||
|
base >=4.12.0.0 && <5
|
||||||
|
, small-bytearray-builder
|
||||||
|
, QuickCheck >=2.13.1 && <2.14
|
||||||
|
, tasty-quickcheck >=0.10.1 && <0.11
|
||||||
|
, tasty >=1.2.3 && <1.3
|
||||||
|
, primitive
|
115
src/Data/ByteArray/Builder/Small.hs
Normal file
115
src/Data/ByteArray/Builder/Small.hs
Normal file
|
@ -0,0 +1,115 @@
|
||||||
|
{-# language ScopedTypeVariables #-}
|
||||||
|
{-# language BangPatterns #-}
|
||||||
|
{-# language MagicHash #-}
|
||||||
|
{-# language UnboxedTuples #-}
|
||||||
|
{-# language RankNTypes #-}
|
||||||
|
{-# language LambdaCase #-}
|
||||||
|
|
||||||
|
module Data.ByteArray.Builder.Small
|
||||||
|
( -- * Unsafe Primitives
|
||||||
|
Builder(..)
|
||||||
|
, construct
|
||||||
|
-- * Evaluation
|
||||||
|
, run
|
||||||
|
, pasteST
|
||||||
|
-- * Numbers
|
||||||
|
, word64Dec
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Primitive
|
||||||
|
import Data.Char (ord)
|
||||||
|
import Data.Primitive
|
||||||
|
import GHC.Exts
|
||||||
|
import GHC.Word
|
||||||
|
import Data.Bytes.Types
|
||||||
|
import GHC.ST
|
||||||
|
|
||||||
|
-- | An unmaterialized sequence of bytes that may be pasted
|
||||||
|
-- into a mutable byte array.
|
||||||
|
newtype Builder = Builder
|
||||||
|
(forall s. MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #))
|
||||||
|
|
||||||
|
instance Semigroup Builder where
|
||||||
|
{-# inline (<>) #-}
|
||||||
|
Builder f <> Builder g = Builder $ \arr off0 len0 s0 -> case f arr off0 len0 s0 of
|
||||||
|
(# s1, r #) -> case r /=# (-1#) of
|
||||||
|
1# -> g arr r (len0 +# (off0 -# r)) s1
|
||||||
|
_ -> (# s1, (-1#) #)
|
||||||
|
|
||||||
|
-- | Run a builder. An accurate size hint is important for good performance.
|
||||||
|
run ::
|
||||||
|
Int -- ^ Hint for upper bound on size
|
||||||
|
-> Builder -- ^ Builder
|
||||||
|
-> ByteArray
|
||||||
|
run hint b = runST $ do
|
||||||
|
let go !n = do
|
||||||
|
arr <- newByteArray n
|
||||||
|
pasteST b (MutableBytes arr 0 n) >>= \case
|
||||||
|
Nothing -> go (n + 64)
|
||||||
|
Just len -> do
|
||||||
|
shrinkMutableByteArray arr len
|
||||||
|
unsafeFreezeByteArray arr
|
||||||
|
go hint
|
||||||
|
|
||||||
|
pasteST :: Builder -> MutableBytes s -> ST s (Maybe Int)
|
||||||
|
{-# inline pasteST #-}
|
||||||
|
pasteST (Builder f) (MutableBytes (MutableByteArray arr) (I# off) (I# len)) =
|
||||||
|
ST $ \s0 -> case f arr off len s0 of
|
||||||
|
(# s1, r #) -> if isTrue# (r /=# (-1#))
|
||||||
|
then (# s1, Just (I# r) #)
|
||||||
|
else (# s1, Nothing #)
|
||||||
|
|
||||||
|
construct :: (forall s. MutableBytes s -> ST s (Maybe Int)) -> Builder
|
||||||
|
construct f = Builder
|
||||||
|
$ \arr off len s0 ->
|
||||||
|
case unST (f (MutableBytes (MutableByteArray arr) (I# off) (I# len))) s0 of
|
||||||
|
(# s1, m #) -> case m of
|
||||||
|
Nothing -> (# s1, (-1#) #)
|
||||||
|
Just (I# n) -> (# s1, n #)
|
||||||
|
|
||||||
|
word64Dec :: Word64 -> Builder
|
||||||
|
word64Dec (W64# w) = word64Dec# w
|
||||||
|
|
||||||
|
word64Dec# :: Word# -> Builder
|
||||||
|
{-# noinline word64Dec# #-}
|
||||||
|
word64Dec# w# = construct $ \(MutableBytes arr off0 len) -> if len >= 19
|
||||||
|
then if w /= 0
|
||||||
|
then do
|
||||||
|
let go off x = if x > 0
|
||||||
|
then do
|
||||||
|
let (y,z) = quotRem x 10
|
||||||
|
writeByteArray arr off (fromIntegral (z + 0x30) :: Word8)
|
||||||
|
go (off + 1) y
|
||||||
|
else do
|
||||||
|
reverseBytes arr off0 (off - 1)
|
||||||
|
pure (Just off)
|
||||||
|
go off0 w
|
||||||
|
else do
|
||||||
|
writeByteArray arr off0 (c2w '0')
|
||||||
|
pure (Just (off0 + 1))
|
||||||
|
else pure Nothing
|
||||||
|
where
|
||||||
|
w = W64# w#
|
||||||
|
|
||||||
|
reverseBytes :: MutableByteArray s -> Int -> Int -> ST s ()
|
||||||
|
{-# inline reverseBytes #-}
|
||||||
|
reverseBytes arr begin end = go begin end where
|
||||||
|
go ixA ixB = if ixA < ixB
|
||||||
|
then do
|
||||||
|
a :: Word8 <- readByteArray arr ixA
|
||||||
|
b :: Word8 <- readByteArray arr ixB
|
||||||
|
writeByteArray arr ixA b
|
||||||
|
writeByteArray arr ixB a
|
||||||
|
go (ixA + 1) (ixB - 1)
|
||||||
|
else pure ()
|
||||||
|
|
||||||
|
c2w :: Char -> Word8
|
||||||
|
c2w = fromIntegral . ord
|
||||||
|
|
||||||
|
unST :: ST s a -> State# s -> (# State# s, a #)
|
||||||
|
unST (ST f) = f
|
||||||
|
|
||||||
|
shrinkMutableByteArray :: MutableByteArray s -> Int -> ST s ()
|
||||||
|
shrinkMutableByteArray (MutableByteArray arr) (I# sz) =
|
||||||
|
primitive_ (shrinkMutableByteArray# arr sz)
|
||||||
|
|
28
test/Main.hs
Normal file
28
test/Main.hs
Normal file
|
@ -0,0 +1,28 @@
|
||||||
|
{-# language TypeApplications #-}
|
||||||
|
|
||||||
|
import Data.ByteArray.Builder.Small
|
||||||
|
import Data.Word
|
||||||
|
import Data.Char (ord)
|
||||||
|
import Data.Primitive (ByteArray)
|
||||||
|
import Test.Tasty (defaultMain,testGroup,TestTree)
|
||||||
|
import Test.QuickCheck ((===))
|
||||||
|
import qualified Test.Tasty.QuickCheck as TQC
|
||||||
|
import qualified Test.QuickCheck as QC
|
||||||
|
import qualified GHC.Exts as Exts
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = defaultMain tests
|
||||||
|
|
||||||
|
tests :: TestTree
|
||||||
|
tests = testGroup "Tests"
|
||||||
|
[ TQC.testProperty "word64Dec" $ \w ->
|
||||||
|
run 1 (word64Dec w) === pack (show w)
|
||||||
|
, TQC.testProperty "word64Dec-x3" $ \x y z ->
|
||||||
|
run 1 (word64Dec x <> word64Dec y <> word64Dec z)
|
||||||
|
===
|
||||||
|
pack (show x ++ show y ++ show z)
|
||||||
|
]
|
||||||
|
|
||||||
|
pack :: String -> ByteArray
|
||||||
|
pack = Exts.fromList . map (fromIntegral @Int @Word8 . ord)
|
||||||
|
|
Loading…
Add table
Reference in a new issue