Avoid KnownNat constraints in favor of using Arithmetic.Types.Nat

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`

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

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,12 +172,17 @@ 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
+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#) #)
 
@@ -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

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

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)