From a5bbf88e71c8506c64a7d135e1b8bd3c7152e9ed Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Tue, 3 Sep 2019 14:58:03 -0400 Subject: [PATCH] Avoid KnownNat constraints in favor of using Arithmetic.Types.Nat --- bench/Main.hs | 10 ++-- small-bytearray-builder.cabal | 14 +++--- src/Data/ByteArray/Builder.hs | 72 +++++++++++++++------------ src/Data/ByteArray/Builder/Bounded.hs | 57 ++++++++++----------- test/Main.hs | 7 ++- 5 files changed, 85 insertions(+), 75 deletions(-) diff --git a/bench/Main.hs b/bench/Main.hs index 28ef227..65872c4 100644 --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,7 +1,9 @@ +import Data.Primitive (ByteArray) +import Data.Word (Word64) import Gauge (bgroup,bench,whnf) import Gauge.Main (defaultMain) -import Data.Word (Word64) -import Data.Primitive (ByteArray) + +import qualified Arithmetic.Nat as Nat import qualified Data.ByteArray.Builder.Bounded as U import qualified HexWord64 @@ -33,7 +35,7 @@ data Word64s = Word64s encodeHexWord64s :: Word64s -> ByteArray {-# noinline encodeHexWord64s #-} -encodeHexWord64s (Word64s a b c d e f g h) = U.run $ +encodeHexWord64s (Word64s a b c d e f g h) = U.run Nat.constant $ U.word64PaddedUpperHex a `U.append` U.word64PaddedUpperHex b `U.append` U.word64PaddedUpperHex c `U.append` @@ -45,7 +47,7 @@ encodeHexWord64s (Word64s a b c d e f g h) = U.run $ encodeHexWord64sLoop :: Word64s -> ByteArray {-# noinline encodeHexWord64sLoop #-} -encodeHexWord64sLoop (Word64s a b c d e f g h) = U.run $ +encodeHexWord64sLoop (Word64s a b c d e f g h) = U.run Nat.constant $ HexWord64.word64PaddedUpperHex a `U.append` HexWord64.word64PaddedUpperHex b `U.append` HexWord64.word64PaddedUpperHex c `U.append` diff --git a/small-bytearray-builder.cabal b/small-bytearray-builder.cabal index 9d613bd..6373cf7 100644 --- a/small-bytearray-builder.cabal +++ b/small-bytearray-builder.cabal @@ -66,16 +66,17 @@ test-suite test other-modules: HexWord64 build-depends: + , QuickCheck >=2.13.1 && <2.14 , base >=4.12.0.0 && <5 , byteslice , bytestring - , small-bytearray-builder - , QuickCheck >=2.13.1 && <2.14 - , tasty-quickcheck >=0.10.1 && <0.11 - , tasty-hunit >=0.10.0.2 && <0.11 - , tasty >=1.2.3 && <1.3 - , text >=1.2 && <1.3 + , natural-arithmetic , primitive + , small-bytearray-builder + , tasty >=1.2.3 && <1.3 + , tasty-hunit >=0.10.0.2 && <0.11 + , tasty-quickcheck >=0.10.1 && <0.11 + , text >=1.2 && <1.3 , vector benchmark bench @@ -83,6 +84,7 @@ benchmark bench build-depends: , base , gauge >= 0.2.4 + , natural-arithmetic , primitive , small-bytearray-builder ghc-options: -Wall -O2 diff --git a/src/Data/ByteArray/Builder.hs b/src/Data/ByteArray/Builder.hs index ce49b26..9302292 100644 --- a/src/Data/ByteArray/Builder.hs +++ b/src/Data/ByteArray/Builder.hs @@ -51,20 +51,21 @@ module Data.ByteArray.Builder import Control.Monad.Primitive import Control.Monad.ST import Control.Monad.ST.Run (runByteArrayST) -import Data.Bytes.Types -import Data.Primitive -import Data.Int (Int64) -import GHC.Exts -import GHC.ST -import GHC.Word -import GHC.TypeLits (KnownNat,natVal') -import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..)) -import Data.ByteString.Short.Internal (ShortByteString(SBS)) -import Data.Text.Short (ShortText) -import Data.Char (ord) import Data.ByteArray.Builder.Unsafe (Builder(Builder)) import Data.ByteArray.Builder.Unsafe (stringUtf8,cstring) +import Data.ByteString.Short.Internal (ShortByteString(SBS)) +import Data.Bytes.Types (Bytes(Bytes),MutableBytes(MutableBytes)) +import Data.Char (ord) +import Data.Int (Int64) +import Data.Primitive +import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..)) +import Data.Text.Short (ShortText) +import GHC.Exts +import GHC.ST (ST(ST)) +import GHC.Word +import qualified Arithmetic.Nat as Nat +import qualified Arithmetic.Types as Arithmetic import qualified GHC.Exts as Exts import qualified Data.Text.Short as TS import qualified Data.Primitive as PM @@ -171,14 +172,19 @@ construct f = Builder Nothing -> (# s1, (-1#) #) Just (I# n) -> (# s1, n #) --- | Convert a bounded builder to an unbounded one. -fromBounded :: forall n. KnownNat n => Bounded.Builder n -> Builder +-- | Convert a bounded builder to an unbounded one. If the size +-- is a constant, use @Arithmetic.Nat.constant@ as the first argument +-- to let GHC conjure up this value for you. +fromBounded :: + Arithmetic.Nat n + -> Bounded.Builder n + -> Builder {-# inline fromBounded #-} -fromBounded (UnsafeBounded.Builder f) = Builder $ \arr off len s0 -> - case fromIntegral (natVal' (proxy# :: Proxy# n)) of - I# req -> case len >=# req of - 1# -> f arr off s0 - _ -> (# s0, (-1#) #) +fromBounded n (UnsafeBounded.Builder f) = Builder $ \arr off len s0 -> + let !(I# req) = Nat.demote n in + case len >=# req of + 1# -> f arr off s0 + _ -> (# s0, (-1#) #) -- | Create a builder from an unsliced byte sequence. bytearray :: ByteArray -> Builder @@ -251,70 +257,70 @@ shortTextJsonString a = -- This encoding never starts with a zero unless the -- argument was zero. word64Dec :: Word64 -> Builder -word64Dec w = fromBounded (Bounded.word64Dec w) +word64Dec w = fromBounded Nat.constant (Bounded.word64Dec w) -- | Encodes an unsigned 16-bit integer as decimal. -- This encoding never starts with a zero unless the -- argument was zero. word32Dec :: Word32 -> Builder -word32Dec w = fromBounded (Bounded.word32Dec w) +word32Dec w = fromBounded Nat.constant (Bounded.word32Dec w) -- | Encodes an unsigned 16-bit integer as decimal. -- This encoding never starts with a zero unless the -- argument was zero. word16Dec :: Word16 -> Builder -word16Dec w = fromBounded (Bounded.word16Dec w) +word16Dec w = fromBounded Nat.constant (Bounded.word16Dec w) -- | Encode a double-floating-point number, using decimal notation or -- scientific notation depending on the magnitude. This has undefined -- behavior when representing @+inf@, @-inf@, and @NaN@. It will not -- crash, but the generated numbers will be nonsense. doubleDec :: Double -> Builder -doubleDec w = fromBounded (Bounded.doubleDec w) +doubleDec w = fromBounded Nat.constant (Bounded.doubleDec w) -- | Encodes a signed 64-bit integer as decimal. -- This encoding never starts with a zero unless the argument was zero. -- Negative numbers are preceded by a minus sign. Positive numbers -- are not preceded by anything. int64Dec :: Int64 -> Builder -int64Dec w = fromBounded (Bounded.int64Dec w) +int64Dec w = fromBounded Nat.constant (Bounded.int64Dec w) -- | Encode a 64-bit unsigned integer as hexadecimal, zero-padding -- the encoding to 16 digits. This uses uppercase for the alphabetical -- digits. For example, this encodes the number 1022 as @00000000000003FE@. word64PaddedUpperHex :: Word64 -> Builder word64PaddedUpperHex w = - fromBounded (Bounded.word64PaddedUpperHex w) + fromBounded Nat.constant (Bounded.word64PaddedUpperHex w) -- | Encode a 32-bit unsigned integer as hexadecimal, zero-padding -- the encoding to 8 digits. This uses uppercase for the alphabetical -- digits. For example, this encodes the number 1022 as @000003FE@. word32PaddedUpperHex :: Word32 -> Builder word32PaddedUpperHex w = - fromBounded (Bounded.word32PaddedUpperHex w) + fromBounded Nat.constant (Bounded.word32PaddedUpperHex w) -- | Encode a 16-bit unsigned integer as hexadecimal, zero-padding -- the encoding to 4 digits. This uses uppercase for the alphabetical -- digits. For example, this encodes the number 1022 as @03FE@. word16PaddedUpperHex :: Word16 -> Builder word16PaddedUpperHex w = - fromBounded (Bounded.word16PaddedUpperHex w) + fromBounded Nat.constant (Bounded.word16PaddedUpperHex w) -- | Encode a 8-bit unsigned integer as hexadecimal, zero-padding -- the encoding to 2 digits. This uses uppercase for the alphabetical -- digits. For example, this encodes the number 11 as @0B@. word8PaddedUpperHex :: Word8 -> Builder word8PaddedUpperHex w = - fromBounded (Bounded.word8PaddedUpperHex w) + fromBounded Nat.constant (Bounded.word8PaddedUpperHex w) -- | Encode an ASCII char. -- Precondition: Input must be an ASCII character. This is not checked. ascii :: Char -> Builder -ascii c = fromBounded (Bounded.char c) +ascii c = fromBounded Nat.constant (Bounded.char c) -- | Encode an UTF8 char. This only uses as much space as is required. char :: Char -> Builder -char c = fromBounded (Bounded.char c) +char c = fromBounded Nat.constant (Bounded.char c) unST :: ST s a -> State# s -> (# State# s, a #) unST (ST f) = f @@ -326,20 +332,20 @@ shrinkMutableByteArray (MutableByteArray arr) (I# sz) = -- | Requires exactly 8 bytes. Dump the octets of a 64-bit -- word in a big-endian fashion. word64BE :: Word64 -> Builder -word64BE w = fromBounded (Bounded.word64BE w) +word64BE w = fromBounded Nat.constant (Bounded.word64BE w) -- | Requires exactly 4 bytes. Dump the octets of a 32-bit -- word in a big-endian fashion. word32BE :: Word32 -> Builder -word32BE w = fromBounded (Bounded.word32BE w) +word32BE w = fromBounded Nat.constant (Bounded.word32BE w) -- | Requires exactly 2 bytes. Dump the octets of a 16-bit -- word in a big-endian fashion. word16BE :: Word16 -> Builder -word16BE w = fromBounded (Bounded.word16BE w) +word16BE w = fromBounded Nat.constant (Bounded.word16BE w) word8 :: Word8 -> Builder -word8 w = fromBounded (Bounded.word8 w) +word8 w = fromBounded Nat.constant (Bounded.word8 w) -- ShortText is already UTF-8 encoded. This is a no-op. shortTextToByteArray :: ShortText -> ByteArray diff --git a/src/Data/ByteArray/Builder/Bounded.hs b/src/Data/ByteArray/Builder/Bounded.hs index 5db8a12..d4bcb52 100644 --- a/src/Data/ByteArray/Builder/Bounded.hs +++ b/src/Data/ByteArray/Builder/Bounded.hs @@ -1,14 +1,14 @@ -{-# language KindSignatures #-} -{-# language ScopedTypeVariables #-} {-# language BangPatterns #-} -{-# language MagicHash #-} {-# language BinaryLiterals #-} -{-# language UnboxedTuples #-} -{-# language RankNTypes #-} -{-# language LambdaCase #-} -{-# language TypeOperators #-} {-# language DataKinds #-} +{-# language KindSignatures #-} +{-# language LambdaCase #-} +{-# language MagicHash #-} +{-# language RankNTypes #-} +{-# language ScopedTypeVariables #-} {-# language TypeApplications #-} +{-# language TypeOperators #-} +{-# language UnboxedTuples #-} -- | The functions in this module are explict in the amount of bytes they require. module Data.ByteArray.Builder.Bounded @@ -44,35 +44,35 @@ module Data.ByteArray.Builder.Bounded , doubleDec ) where +import Arithmetic.Types (type (<=), type (:=:)) import Control.Monad.Primitive import Control.Monad.ST import Data.Bits +import Data.ByteArray.Builder.Bounded.Unsafe (Builder(..)) import Data.Char (ord) import Data.Primitive -import GHC.Exts -import GHC.ST (ST(ST)) -import GHC.Word (Word8(W8#),Word16(W16#),Word32(W32#),Word64(W64#)) -import GHC.Int (Int64(I64#)) -import GHC.TypeLits (KnownNat,type (+),natVal') import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..)) -import Arithmetic.Types (type (<=), type (:=:)) -import Data.ByteArray.Builder.Bounded.Unsafe (Builder(..)) +import GHC.Exts +import GHC.Int (Int64(I64#)) +import GHC.ST (ST(ST)) +import GHC.TypeLits (type (+)) +import GHC.Word (Word8(W8#),Word16(W16#),Word32(W32#),Word64(W64#)) +import qualified Arithmetic.Types as Arithmetic +import qualified Arithmetic.Nat as Nat import qualified Data.ByteArray.Builder.Bounded.Unsafe as Unsafe import qualified Data.Primitive as PM --- Used internally. -knownNat :: KnownNat n => Proxy# n -> Int -{-# inline knownNat #-} -knownNat p = fromIntegral (natVal' p) - --- | Execute the bounded builder. -run :: forall n. KnownNat n - => Builder n -- ^ Builder +-- | Execute the bounded builder. If the size is a constant, +-- use @Arithmetic.Nat.constant@ as the first argument to let +-- GHC conjure up this value for you. +run :: + Arithmetic.Nat n + -> Builder n -- ^ Builder -> ByteArray {-# inline run #-} -run b = runST $ do - arr <- newByteArray (knownNat (proxy# :: Proxy# n)) +run n b = runST $ do + arr <- newByteArray (Nat.demote n) len <- Unsafe.pasteST b arr 0 shrinkMutableByteArray arr len unsafeFreezeByteArray arr @@ -80,16 +80,17 @@ run b = runST $ do -- | Paste the builder into the byte array starting at offset zero. -- This reallocates the byte array if it cannot accomodate the builder, -- growing it by the minimum amount necessary. -pasteGrowST :: forall n s. KnownNat n - => Builder n +pasteGrowST :: + Arithmetic.Nat n + -> Builder n -> MutableByteArrayOffset s -- ^ Initial buffer, used linearly. Do not reuse this argument. -> ST s (MutableByteArrayOffset s) -- ^ Final buffer that accomodated the builder. {-# inline pasteGrowST #-} -pasteGrowST b !(MutableByteArrayOffset{array=arr0,offset=off0}) = do +pasteGrowST n b !(MutableByteArrayOffset{array=arr0,offset=off0}) = do sz0 <- PM.getSizeofMutableByteArray arr0 - let req = knownNat (proxy# :: Proxy# n) + let req = Nat.demote n let sz1 = off0 + req if sz1 <= sz0 then do diff --git a/test/Main.hs b/test/Main.hs index 37b2cb0..6a2e6f8 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -9,12 +9,12 @@ import Data.ByteArray.Builder import Data.Word import Data.Char (ord) import Data.Primitive (ByteArray) -import Debug.Trace import Test.Tasty (defaultMain,testGroup,TestTree) import Test.QuickCheck ((===)) import Text.Printf (printf) import Test.Tasty.HUnit ((@=?)) +import qualified Arithmetic.Nat as Nat import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy.Char8 as LB @@ -24,7 +24,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Vector as V import qualified GHC.Exts as Exts -import qualified Test.QuickCheck as QC import qualified Test.Tasty.HUnit as THU import qualified Test.Tasty.QuickCheck as TQC @@ -95,8 +94,8 @@ tests = testGroup "Tests" , testGroup "alternate" [ TQC.testProperty "HexWord64" $ \x y -> run 1 - ( fromBounded (HexWord64.word64PaddedUpperHex x) - <> fromBounded (HexWord64.word64PaddedUpperHex y) + ( fromBounded Nat.constant (HexWord64.word64PaddedUpperHex x) + <> fromBounded Nat.constant (HexWord64.word64PaddedUpperHex y) ) === pack (showWord64PaddedUpperHex x <> showWord64PaddedUpperHex y)