Remove remaining uses of FFI under -fpure-haskell

.gitignore

@@ -10,3 +10,4 @@ cabal.sandbox.config
 dist-newstyle/
 cabal.project.local*
 .nvimrc
+.ghc.environment*

Data/ByteString/Builder/ASCII.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE Trustworthy #-}
-
 {-# OPTIONS_HADDOCK not-home #-}
 
 -- | Copyright : (c) 2010 - 2011 Simon Meier

Data/ByteString/Builder/Prim/ASCII.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface #-}
-{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 -- | Copyright   : (c) 2010 Jasper Van der Jeugt
 --                 (c) 2010 - 2011 Simon Meier
 -- License       : BSD3-style (see LICENSE)
@@ -82,7 +81,7 @@ import Data.ByteString.Builder.Prim.Binary
 import Data.ByteString.Builder.Prim.Internal
 import Data.ByteString.Builder.Prim.Internal.Floating
 import Data.ByteString.Builder.Prim.Internal.Base16
-import Data.ByteString.Utils.UnalignedWrite
+import Data.ByteString.Utils.UnalignedAccess
 
 import Data.Char (ord)
 

Data/ByteString/Builder/Prim/Binary.hs

@@ -1,12 +1,7 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Trustworthy #-}
 
 {-# LANGUAGE TypeApplications #-}
 
-#include "MachDeps.h"
-#include "bytestring-cpp-macros.h"
-
-
 -- | Copyright   : (c) 2010-2011 Simon Meier
 -- License       : BSD3-style (see LICENSE)
 --
@@ -61,7 +56,8 @@ module Data.ByteString.Builder.Prim.Binary (
 
 import Data.ByteString.Builder.Prim.Internal
 import Data.ByteString.Builder.Prim.Internal.Floating
-import Data.ByteString.Utils.UnalignedWrite
+import Data.ByteString.Utils.ByteOrder
+import Data.ByteString.Utils.UnalignedAccess
 
 import Foreign
 
@@ -86,59 +82,35 @@ word8 = fixedPrim 1 (flip poke) -- Word8 is always aligned
 -- | Encoding 'Word16's in big endian format.
 {-# INLINE word16BE #-}
 word16BE :: FixedPrim Word16
-#ifdef WORDS_BIGENDIAN
-word16BE = word16Host
-#else
-word16BE = byteSwap16 >$< word16Host
-#endif
+word16BE = whenLittleEndian byteSwap16 >$< word16Host
 
 -- | Encoding 'Word16's in little endian format.
 {-# INLINE word16LE #-}
 word16LE :: FixedPrim Word16
-#ifdef WORDS_BIGENDIAN
-word16LE = byteSwap16 >$< word16Host
-#else
-word16LE = word16Host
-#endif
+word16LE = whenBigEndian byteSwap16 >$< word16Host
 
 -- | Encoding 'Word32's in big endian format.
 {-# INLINE word32BE #-}
 word32BE :: FixedPrim Word32
-#ifdef WORDS_BIGENDIAN
-word32BE = word32Host
-#else
-word32BE = byteSwap32 >$< word32Host
-#endif
+word32BE = whenLittleEndian byteSwap32 >$< word32Host
 
 -- | Encoding 'Word32's in little endian format.
 {-# INLINE word32LE #-}
 word32LE :: FixedPrim Word32
-#ifdef WORDS_BIGENDIAN
-word32LE = byteSwap32 >$< word32Host
-#else
-word32LE = word32Host
-#endif
+word32LE = whenBigEndian byteSwap32 >$< word32Host
 
 -- on a little endian machine:
 -- word32LE w32 = fixedPrim 4 (\w p -> poke (castPtr p) w32)
 
 -- | Encoding 'Word64's in big endian format.
 {-# INLINE word64BE #-}
 word64BE :: FixedPrim Word64
-#ifdef WORDS_BIGENDIAN
-word64BE = word64Host
-#else
-word64BE = byteSwap64 >$< word64Host
-#endif
+word64BE = whenLittleEndian byteSwap64 >$< word64Host
 
 -- | Encoding 'Word64's in little endian format.
 {-# INLINE word64LE #-}
 word64LE :: FixedPrim Word64
-#ifdef WORDS_BIGENDIAN
-word64LE = byteSwap64 >$< word64Host
-#else
-word64LE = word64Host
-#endif
+word64LE = whenBigEndian byteSwap64 >$< word64Host
 
 
 -- | Encode a single native machine 'Word'. The 'Word's is encoded in host order,

Data/ByteString/Builder/RealFloat/Internal.hs

@@ -72,7 +72,8 @@ import Data.Bits (Bits(..), FiniteBits(..))
 import Data.ByteString.Internal (c2w)
 import Data.ByteString.Builder.Prim.Internal (BoundedPrim, boundedPrim)
 import Data.ByteString.Builder.RealFloat.TableGenerator
-import Data.ByteString.Utils.UnalignedWrite
+import Data.ByteString.Utils.ByteOrder
+import Data.ByteString.Utils.UnalignedAccess
 #if PURE_HASKELL
 import qualified Data.ByteString.Internal.Pure as Pure
 #else
@@ -408,25 +409,23 @@ wrapped f (I# w) = I# (f w)
 #if WORD_SIZE_IN_BITS == 32
 -- | Packs 2 32-bit system words (hi, lo) into a Word64
 packWord64 :: Word# -> Word# -> Word64#
-packWord64 hi lo =
-#if defined(WORDS_BIGENDIAN)
+packWord64 hi lo = case hostByteOrder of
+  BigEndian ->
     ((wordToWord64# lo) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# hi)
-#else
+  LittleEndian ->
     ((wordToWord64# hi) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# lo)
-#endif
 
 -- | Unpacks a Word64 into 2 32-bit words (hi, lo)
 unpackWord64 :: Word64# -> (# Word#, Word# #)
-unpackWord64 w =
-#if defined(WORDS_BIGENDIAN)
+unpackWord64 w = case hostByteOrder of
+  BigEndian ->
     (# word64ToWord# w
      , word64ToWord# (w `uncheckedShiftRL64#` 32#)
      #)
-#else
+  LittleEndian ->
     (# word64ToWord# (w `uncheckedShiftRL64#` 32#)
      , word64ToWord# w
      #)
-#endif
 
 -- | Adds 2 Word64's with 32-bit addition and manual carrying
 plusWord64 :: Word64# -> Word64# -> Word64#
@@ -731,21 +730,19 @@ getWord128At (Ptr arr) (I# i) = let
 
 -- | Packs 2 bytes [lsb, msb] into 16-bit word
 packWord16 :: Word# -> Word# -> Word#
-packWord16 l h =
-#if defined(WORDS_BIGENDIAN)
+packWord16 l h = case hostByteOrder of
+  BigEndian ->
     (h `uncheckedShiftL#` 8#) `or#` l
-#else
+  LittleEndian ->
     (l `uncheckedShiftL#` 8#) `or#` h
-#endif
 
 -- | Unpacks a 16-bit word into 2 bytes [lsb, msb]
 unpackWord16 :: Word# -> (# Word#, Word# #)
-unpackWord16 w =
-#if defined(WORDS_BIGENDIAN)
+unpackWord16 w = case hostByteOrder of
+  BigEndian ->
     (# w `and#` 0xff##, w `uncheckedShiftRL#` 8# #)
-#else
+  LittleEndian ->
     (# w `uncheckedShiftRL#` 8#, w `and#` 0xff## #)
-#endif
 
 
 -- | Static array of 2-digit pairs 00..99 for faster ascii rendering

Data/ByteString/Internal/Pure.hs

@@ -7,8 +7,12 @@
 
 -- | Haskell implementation of C bits
 module Data.ByteString.Internal.Pure
-  ( -- * fpstring.c
-    intersperse
+  ( -- * standard string.h functions
+    strlen
+  , memchr
+  , memcmp
+    -- * fpstring.c
+  , intersperse
   , countOcc
   , countOccBA
   , reverseBytes
@@ -38,13 +42,65 @@ import GHC.Int                  (Int8(..))
 
 import Data.Bits                (Bits(..), shiftR, (.&.))
 import Data.Word
-import Foreign.Ptr              (plusPtr)
+import Foreign.Ptr              (plusPtr, nullPtr)
 import Foreign.Storable         (Storable(..))
 import Control.Monad            (when)
 import Control.Exception        (assert)
 
+import Data.ByteString.Utils.ByteOrder
+import Data.ByteString.Utils.UnalignedAccess
+
+----------------------------------------------------------------
+-- Haskell versions of standard functions in string.h
+----------------------------------------------------------------
+
+strlen :: Ptr Word8 -> IO Int
+strlen = go 0 where
+  go :: Int -> Ptr Word8 -> IO Int
+  go !acc !p = do
+    c <- peek p
+    if | c == 0 -> pure acc
+       | nextAcc <- acc + 1
+       , nextAcc >= 0 -> go nextAcc (p `plusPtr` 1)
+       | otherwise -> errorWithoutStackTrace
+           "bytestring: strlen: String length does not fit in a Haskell Int"
+
+memchr :: Ptr Word8 -> Word8 -> Int -> IO (Ptr Word8)
+memchr !p !target !len
+  | len == 0 = pure nullPtr
+  | otherwise = assert (len > 0) $ do
+      c <- peek p
+      if c == target
+        then pure p
+        else memchr (p `plusPtr` 1) target (len - 1)
+
+memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int
+memcmp !p1 !p2 !len
+  | len >= 8 = do
+      w1 <- unalignedReadU64 p1
+      w2 <- unalignedReadU64 p2
+      let toBigEndian = whenLittleEndian byteSwap64
+      if | w1 == w2
+           -> memcmp (p1 `plusPtr` 8) (p2 `plusPtr` 8) (len - 8)
+         | toBigEndian w1 < toBigEndian w2
+           -> pure (0-1)
+         | otherwise -> pure 1
+  | otherwise = memcmp1 p1 p2 len
+
+-- | Like 'memcmp', but definitely scans one byte at a time
+memcmp1 :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int
+memcmp1 !p1 !p2 !len
+  | len == 0 = pure 0
+  | otherwise = assert (len > 0) $ do
+      c1 <- peek p1
+      c2 <- peek p2
+      if | c1 == c2 -> memcmp1 (p1 `plusPtr` 1) (p2 `plusPtr` 1) (len - 1)
+         | c1 < c2   -> pure (0-1)
+         | otherwise -> pure 1
+
+
 ----------------------------------------------------------------
--- Haskell version of functions in fpstring.c
+-- Haskell versions of functions in fpstring.c
 ----------------------------------------------------------------
 
 -- | duplicate a string, interspersing the character through the elements of the
@@ -232,7 +288,7 @@ isValidUtf8' idx !len = go 0
 
 
 ----------------------------------------------------------------
--- Haskell version of functions in itoa.c
+-- Haskell versions of functions in itoa.c
 ----------------------------------------------------------------
 
 

Data/ByteString/Internal/Type.hs

@@ -1,11 +1,16 @@
-{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}
-{-# LANGUAGE UnliftedFFITypes, MagicHash,
-            UnboxedTuples #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Unsafe #-}
+
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE ViewPatterns #-}
+
 {-# OPTIONS_HADDOCK not-home #-}
 
 -- |
@@ -129,11 +134,12 @@
 import qualified Data.List as List
 
 import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr)
-import Foreign.Ptr              (Ptr, FunPtr, plusPtr)
+import Foreign.Ptr              (Ptr, FunPtr, plusPtr, castPtr)
 import Foreign.Storable         (Storable(..))
 import Foreign.C.Types
 import Foreign.C.String         (CString)
 import Foreign.Marshal.Utils
+import Foreign.Marshal.Alloc    (finalizerFree)
 
 #if PURE_HASKELL
 import qualified Data.ByteString.Internal.Pure as Pure
@@ -1104,24 +1110,42 @@
 -- Standard C functions
 --
 
+memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
+memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
+{-# DEPRECATED memset "Use Foreign.Marshal.Utils.fillBytes instead" #-}
+-- | deprecated since @bytestring-0.11.5.0@
+memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
+
+#if !PURE_HASKELL
+
 foreign import ccall unsafe "string.h strlen" c_strlen
     :: CString -> IO CSize
 
-foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer
-    :: FunPtr (Ptr Word8 -> IO ())
-
 foreign import ccall unsafe "string.h memchr" c_memchr
     :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
-
-memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
 memchr p w sz = c_memchr p (fromIntegral w) sz
 
 foreign import ccall unsafe "string.h memcmp" c_memcmp
     :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
-
-memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
 memcmp p q s = c_memcmp p q (fromIntegral s)
 
+foreign import ccall unsafe "string.h memset" c_memset
+    :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
+memset p w sz = c_memset p (fromIntegral w) sz
+
+#else
+
+c_strlen :: CString -> IO CSize
+c_strlen p = checkedCast <$!> Pure.strlen (castPtr p)
+
+memchr p w len = Pure.memchr p w (checkedCast len)
+
+memcmp p q s = checkedCast <$!> Pure.memcmp p q s
+
+memset p w len = p <$ fillBytes p w (checkedCast len)
+
+#endif
+
 {-# DEPRECATED memcpy "Use Foreign.Marshal.Utils.copyBytes instead" #-}
 -- | deprecated since @bytestring-0.11.5.0@
 memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
@@ -1131,13 +1155,10 @@
 memcpyFp fp fq s = unsafeWithForeignPtr fp $ \p ->
                      unsafeWithForeignPtr fq $ \q -> copyBytes p q s
 
-foreign import ccall unsafe "string.h memset" c_memset
-    :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
+c_free_finalizer :: FunPtr (Ptr Word8 -> IO ())
+c_free_finalizer = finalizerFree
+
 
-{-# DEPRECATED memset "Use Foreign.Marshal.Utils.fillBytes instead" #-}
--- | deprecated since @bytestring-0.11.5.0@
-memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
-memset p w sz = c_memset p (fromIntegral w) sz
 
 -- ---------------------------------------------------------------------
 --

Data/ByteString/Short/Internal.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE DeriveDataTypeable       #-}
 {-# LANGUAGE DeriveGeneric            #-}
 {-# LANGUAGE DeriveLift               #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase               #-}
 {-# LANGUAGE MagicHash                #-}