Add pure Haskell implementation (#631)

bytestring used to rely on C functions. This patch adds equivalent
functions implemented in Haskell. The main purpose is for the JavaScript
backend to fully support bytestring.

Pure Haskell implementation can be enabled explicitly with a cabal flag.
It's automatically enabled for the JavaScript platform.

Thanks to Matthew Craven for the thorough review and the many
suggestions.

Co-authored-by: Matthew Craven <[email protected]>
(cherry picked from commit d497f39)

Author: hsyl20

.github/workflows/ci.yml

@@ -167,6 +167,27 @@ jobs:
     - name: Test
       run: cabal test --ghc-options='-fcheck-prim-bounds -fno-ignore-asserts -DHS_BYTESTRING_ASSERTIONS'
 
+  pure-haskell:
+    needs: build
+    runs-on: ubuntu-latest
+    steps:
+    - uses: actions/checkout@v3
+    - uses: haskell/actions/setup@v2
+      id: setup-haskell-cabal
+      with:
+        ghc-version: 'latest'
+    - name: Update cabal package database
+      run: cabal update
+    - uses: actions/cache@v3
+      name: Cache cabal stuff
+      with:
+        path: |
+          ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
+          dist-newstyle
+        key: ${{ runner.os }}-latest-pure-haskell
+    - name: Test
+      run: cabal test -fpure-haskell --ghc-options=-fno-ignore-asserts --enable-tests --test-show-details=direct all
+
   old-gcc:
     needs: build
     runs-on: ubuntu-latest

Data/ByteString.hs

@@ -264,7 +264,6 @@ import Control.Exception        (IOException, catch, finally, assert, throwIO)
 import Control.Monad            (when)
 
 import Foreign.C.String         (CString, CStringLen)
-import Foreign.C.Types          (CSize (CSize), CInt (CInt))
 import Foreign.ForeignPtr       (ForeignPtr, touchForeignPtr)
 import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr)
 import Foreign.Marshal.Alloc    (allocaBytes)
@@ -1562,17 +1561,6 @@ isValidUtf8 (BS ptr len) = accursedUnutterablePerformIO $ unsafeWithForeignPtr p
      else cIsValidUtf8Safe p (fromIntegral len)
   pure $ i /= 0
 
--- We import bytestring_is_valid_utf8 both unsafe and safe. For small inputs
--- we can use the unsafe version to get a bit more performance, but for large
--- inputs the safe version should be used to avoid GC synchronization pauses
--- in multithreaded contexts.
-
-foreign import ccall unsafe "bytestring_is_valid_utf8" cIsValidUtf8
-  :: Ptr Word8 -> CSize -> IO CInt
-
-foreign import ccall safe "bytestring_is_valid_utf8" cIsValidUtf8Safe
-  :: Ptr Word8 -> CSize -> IO CInt
-
 -- | Break a string on a substring, returning a pair of the part of the
 -- string prior to the match, and the rest of the string.
 --

Data/ByteString/Builder/ASCII.hs

@@ -82,9 +82,9 @@ import           Data.ByteString.Builder.Internal (Builder)
 import qualified Data.ByteString.Builder.Prim                   as P
 import qualified Data.ByteString.Builder.Prim.Internal          as P
 import           Data.ByteString.Builder.RealFloat (floatDec, doubleDec)
+import           Data.ByteString.Internal.Type (c_int_dec_padded9, c_long_long_int_dec_padded18)
 
 import           Foreign
-import           Foreign.C.Types
 import           Data.List.NonEmpty (NonEmpty(..))
 
 ------------------------------------------------------------------------------
@@ -311,12 +311,6 @@ integerDec i
                     (q,r) -> fromInteger q : fromInteger r : putB ns
 
 
-foreign import ccall unsafe "static _hs_bytestring_int_dec_padded9"
-    c_int_dec_padded9 :: CInt -> Ptr Word8 -> IO ()
-
-foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec_padded18"
-    c_long_long_int_dec_padded18 :: CLLong -> Ptr Word8 -> IO ()
-
 {-# INLINE intDecPadded #-}
 intDecPadded :: P.BoundedPrim Int
 intDecPadded = P.liftFixedToBounded $ P.caseWordSize_32_64

Data/ByteString/Builder/Prim/ASCII.hs

@@ -77,6 +77,7 @@ module Data.ByteString.Builder.Prim.ASCII
 
     ) where
 
+import Data.ByteString.Internal.Type
 import Data.ByteString.Builder.Prim.Binary
 import Data.ByteString.Builder.Prim.Internal
 import Data.ByteString.Builder.Prim.Internal.Floating
@@ -86,7 +87,6 @@ import Data.ByteString.Utils.UnalignedWrite
 import Data.Char (ord)
 
 import Foreign
-import Foreign.C.Types
 
 -- | Encode the least 7-bits of a 'Char' using the ASCII encoding.
 {-# INLINE char7 #-}
@@ -101,12 +101,6 @@ char7 = (\c -> fromIntegral $ ord c .&. 0x7f) >$< word8
 -- Signed integers
 ------------------
 
-foreign import ccall unsafe "static _hs_bytestring_int_dec" c_int_dec
-    :: CInt -> Ptr Word8 -> IO (Ptr Word8)
-
-foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec" c_long_long_int_dec
-    :: CLLong -> Ptr Word8 -> IO (Ptr Word8)
-
 {-# INLINE encodeIntDecimal #-}
 encodeIntDecimal :: Integral a => Int -> BoundedPrim a
 encodeIntDecimal bound = boundedPrim bound $ c_int_dec . fromIntegral
@@ -143,12 +137,6 @@ intDec = caseWordSize_32_64
 -- Unsigned integers
 --------------------
 
-foreign import ccall unsafe "static _hs_bytestring_uint_dec" c_uint_dec
-    :: CUInt -> Ptr Word8 -> IO (Ptr Word8)
-
-foreign import ccall unsafe "static _hs_bytestring_long_long_uint_dec" c_long_long_uint_dec
-    :: CULLong -> Ptr Word8 -> IO (Ptr Word8)
-
 {-# INLINE encodeWordDecimal #-}
 encodeWordDecimal :: Integral a => Int -> BoundedPrim a
 encodeWordDecimal bound = boundedPrim bound $ c_uint_dec . fromIntegral
@@ -187,12 +175,6 @@ wordDec = caseWordSize_32_64
 -- without lead
 ---------------
 
-foreign import ccall unsafe "static _hs_bytestring_uint_hex" c_uint_hex
-    :: CUInt -> Ptr Word8 -> IO (Ptr Word8)
-
-foreign import ccall unsafe "static _hs_bytestring_long_long_uint_hex" c_long_long_uint_hex
-    :: CULLong -> Ptr Word8 -> IO (Ptr Word8)
-
 {-# INLINE encodeWordHex #-}
 encodeWordHex :: forall a. (Storable a, Integral a) => BoundedPrim a
 encodeWordHex =

Data/ByteString/Builder/Prim/Internal/Base16.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE MagicHash #-}
+{-# LANGUAGE CPP #-}
 -- |
 -- Copyright   : (c) 2011 Simon Meier
 -- License     : BSD3-style (see LICENSE)
@@ -22,23 +23,33 @@ module Data.ByteString.Builder.Prim.Internal.Base16 (
   ) where
 
 import Foreign
-import Foreign.C.Types
 import GHC.Exts (Addr#, Ptr(..))
+#if PURE_HASKELL
+import qualified Data.ByteString.Internal.Pure as Pure
+#else
+import Foreign.C.Types
+#endif
 
 -- Creating the encoding table
 ------------------------------
 
 -- | An encoding table for Base16 encoding.
 data EncodingTable = EncodingTable Addr#
 
-foreign import ccall "&hs_bytestring_lower_hex_table"
-  c_lower_hex_table :: Ptr CChar
-
 -- | The encoding table for hexadecimal values with lower-case characters;
 -- e.g., deadbeef.
 lowerTable :: EncodingTable
-lowerTable = case c_lower_hex_table of
-  Ptr p# -> EncodingTable p#
+lowerTable =
+#if PURE_HASKELL
+  case Pure.lower_hex_table of
+    Ptr p# -> EncodingTable p#
+#else
+  case c_lower_hex_table of
+    Ptr p# -> EncodingTable p#
+
+foreign import ccall "&hs_bytestring_lower_hex_table"
+  c_lower_hex_table :: Ptr CChar
+#endif
 
 -- | Encode an octet as 16bit word comprising both encoded nibbles ordered
 -- according to the host endianness. Writing these 16bit to memory will write