base16 0.2.0.0 → 0.2.0.1
raw patch · 8 files changed
+38/−450 lines, 8 filesdep +primitivePVP ok
version bump matches the API change (PVP)
Dependencies added: primitive
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- base16.cabal +2/−4
- src/Data/ByteString/Base16/Internal/Head.hs +4/−19
- src/Data/ByteString/Base16/Internal/Tables.hs +0/−55
- src/Data/ByteString/Base16/Internal/Utils.hs +0/−35
- src/Data/ByteString/Base16/Internal/W16/Loop.hs +28/−30
- src/Data/ByteString/Base16/Internal/W32/Loop.hs +0/−138
- src/Data/ByteString/Base16/Internal/W64/Loop.hs +0/−169
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for base16 +## 0.2.0.1++* Improved performance. Decode and encode are now 3.5x-5x the next best lib.+ ## 0.2.0 * Add lenient decoders
base16.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: base16-version: 0.2.0.0+version: 0.2.0.1 synopsis: RFC 4648-compliant Base16 encodings/decodings description: RFC 4648-compliant Base16 encodings and decodings.@@ -36,15 +36,13 @@ other-modules: Data.ByteString.Base16.Internal.Head- Data.ByteString.Base16.Internal.Tables Data.ByteString.Base16.Internal.Utils Data.ByteString.Base16.Internal.W16.Loop- Data.ByteString.Base16.Internal.W32.Loop- Data.ByteString.Base16.Internal.W64.Loop build-depends: base >=4.10 && <5 , bytestring ^>=0.10+ , primitive , text ^>=1.2 hs-source-dirs: src
src/Data/ByteString/Base16/Internal/Head.hs view
@@ -14,14 +14,7 @@ import Data.ByteString (empty) import Data.ByteString.Internal-import Data.ByteString.Base16.Internal.Tables-#if WORD_SIZE_IN_BITS == 32-import Data.ByteString.Base16.Internal.W32.Loop-#elif WORD_SIZE_IN_BITS >= 64-import Data.ByteString.Base16.Internal.W64.Loop-#else import Data.ByteString.Base16.Internal.W16.Loop-#endif import Data.Text (Text) import Foreign.Ptr@@ -52,15 +45,11 @@ | otherwise = unsafeDupablePerformIO $ do dfp <- mallocPlainForeignPtrBytes q withForeignPtr dfp $ \dptr ->- withForeignPtr dtableHi $ \hi ->- withForeignPtr dtableLo $ \lo -> withForeignPtr sfp $ \sptr -> decodeLoop dfp- hi- lo- (castPtr dptr)- (castPtr (plusPtr sptr soff))+ dptr+ (plusPtr sptr soff) (plusPtr sptr (soff + slen)) 0 where@@ -72,15 +61,11 @@ | otherwise = unsafeDupablePerformIO $ do dfp <- mallocPlainForeignPtrBytes dlen withForeignPtr dfp $ \dptr ->- withForeignPtr dtableHi $ \hi ->- withForeignPtr dtableLo $ \lo -> withForeignPtr sfp $ \sptr -> lenientLoop dfp- hi- lo- (castPtr dptr)- (castPtr (plusPtr sptr soff))+ dptr+ (plusPtr sptr soff) (plusPtr sptr (soff + slen)) 0 where
− src/Data/ByteString/Base16/Internal/Tables.hs
@@ -1,55 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE TypeApplications #-}-module Data.ByteString.Base16.Internal.Tables-( dtableHi-, dtableLo-) where---import Data.ByteString.Base16.Internal.Utils--import GHC.ForeignPtr-import GHC.Word--dtableHi :: ForeignPtr Word8-dtableHi = writeNPlainForeignPtrBytes @Word8 256- [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0x00,0x10,0x20,0x30,0x40,0x50,0x60,0x70,0x80,0x90,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xa0,0xb0,0xc0,0xd0,0xe0,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xa0,0xb0,0xc0,0xd0,0xe0,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- ]-{-# NOINLINE dtableHi #-}--dtableLo :: ForeignPtr Word8-dtableLo = writeNPlainForeignPtrBytes @Word8 256- [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0x0a,0x0b,0x0c,0x0d,0x0e,0x0f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0x0a,0x0b,0x0c,0x0d,0x0e,0x0f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff- ]-{-# NOINLINE dtableLo #-}
src/Data/ByteString/Base16/Internal/Utils.hs view
@@ -2,56 +2,21 @@ {-# LANGUAGE MagicHash #-} module Data.ByteString.Base16.Internal.Utils ( aix-, w32-, w64 , reChunk-, writeNPlainForeignPtrBytes ) where import Data.ByteString (ByteString) import qualified Data.ByteString as B -import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable- import GHC.Exts-import GHC.ForeignPtr import GHC.Word -import System.IO.Unsafe - -- | Read 'Word8' index off alphabet addr -- aix :: Word8 -> Addr# -> Word8 aix (W8# i) alpha = W8# (indexWord8OffAddr# alpha (word2Int# i)) {-# INLINE aix #-}--w32 :: Word8 -> Word32-w32 = fromIntegral-{-# INLINE w32 #-}--w64 :: Word8 -> Word64-w64 = fromIntegral-{-# INLINE w64 #-}---- | Allocate and fill @n@ bytes with some data----writeNPlainForeignPtrBytes- :: ( Storable a- , Storable b- )- => Int- -> [a]- -> ForeignPtr b-writeNPlainForeignPtrBytes !n as = unsafeDupablePerformIO $ do- fp <- mallocPlainForeignPtrBytes n- withForeignPtr fp $ \p -> go p as- return (castForeignPtr fp)- where- go !_ [] = return ()- go !p (x:xs) = poke p x >> go (plusPtr p 1) xs -- | Form a list of chunks, and rechunk the list of bytestrings -- into length multiples of 2
src/Data/ByteString/Base16/Internal/W16/Loop.hs view
@@ -38,28 +38,21 @@ -- | Hex encoding inner loop optimized for 16-bit architectures -- innerLoop- :: Ptr Word16+ :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () innerLoop !dptr !sptr !end = go dptr sptr where- lix !a = aix (fromIntegral a .&. 0x0f) alphabet- {-# INLINE lix #-}-- !alphabet = "0123456789abcdef"#+ !hex = "0123456789abcdef"# go !dst !src | src == end = return () | otherwise = do !t <- peek src - let !a = fromIntegral (lix (unsafeShiftR t 4))- !b = fromIntegral (lix t)-- let !w = a .|. (unsafeShiftL b 8)-- poke dst w+ poke dst (aix (unsafeShiftR t 4) hex)+ poke (plusPtr dst 1) (aix (t .&. 0x0f) hex) go (plusPtr dst 2) (plusPtr src 1) {-# INLINE innerLoop #-}@@ -71,25 +64,26 @@ -> Ptr Word8 -> Ptr Word8 -> Ptr Word8- -> Ptr Word8- -> Ptr Word8 -> Int -> IO (Either Text ByteString)-decodeLoop !dfp !hi !lo !dptr !sptr !end !nn = go dptr sptr nn+decodeLoop !dfp !dptr !sptr !end !nn = go dptr sptr nn where err !src = return . Left . T.pack $ "invalid character at offset: " ++ show (src `minusPtr` sptr) + !lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++ !hi = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#+ go !dst !src !n | src == end = return (Right (PS dfp 0 n)) | otherwise = do !x <- peek @Word8 src !y <- peek @Word8 (plusPtr src 1) - !a <- peekByteOff hi (fromIntegral x)- !b <- peekByteOff lo (fromIntegral y)-+ let !a = aix x hi+ !b = aix y lo if | a == 0xff -> err src | b == 0xff -> err (plusPtr src 1)@@ -107,31 +101,35 @@ -> Ptr Word8 -> Ptr Word8 -> Ptr Word8- -> Ptr Word8- -> Ptr Word8 -> Int -> IO ByteString-lenientLoop !dfp !hi !lo !dptr !sptr !end !nn = goHi dptr sptr nn+lenientLoop !dfp !dptr !sptr !end !nn = goHi dptr sptr nn where+ !lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++ !hi = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#+ goHi !dst !src !n | src == end = return (PS dfp 0 n) | otherwise = do !x <- peek @Word8 src- !a <- peekByteOff hi (fromIntegral x) - if- | a == 0xff -> goHi dst (plusPtr src 1) n- | otherwise -> goLo dst (plusPtr src 1) a n+ let !a = aix x hi + if a == 0xff+ then goHi dst (plusPtr src 1) n+ else goLo dst (plusPtr src 1) a n+ goLo !dst !src !a !n | src == end = return (PS dfp 0 n) | otherwise = do !y <- peek @Word8 src- !b <- peekByteOff lo (fromIntegral y) - if- | b == 0xff -> goLo dst (plusPtr src 1) a n- | otherwise -> do- poke dst (a .|. b)- goHi (plusPtr dst 1) (plusPtr src 1) (n + 1)+ let !b = aix y lo++ if b == 0xff+ then goLo dst (plusPtr src 1) a n+ else do+ poke dst (a .|. b)+ goHi (plusPtr dst 1) (plusPtr src 1) (n + 1) {-# LANGUAGE lenientLoop #-}
− src/Data/ByteString/Base16/Internal/W32/Loop.hs
@@ -1,138 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE TypeApplications #-}--- |--- Module : Data.ByteString.Base16.Internal.W32.Loop--- Copyright : (c) 2020 Emily Pillmore--- License : BSD-style------ Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable------ Encoding loop optimized for 'Word32' architectures----module Data.ByteString.Base16.Internal.W32.Loop-( innerLoop-, decodeLoop-, lenientLoop-) where---import Data.Bits-import Data.ByteString.Internal-import Data.ByteString.Base16.Internal.Utils-import qualified Data.ByteString.Base16.Internal.W16.Loop as W16-import Data.Text (Text)-import qualified Data.Text as T--import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable--import GHC.Word----- | Hex encoding inner loop optimized for 32-bit architectures----innerLoop- :: Ptr Word32- -> Ptr Word16- -> Ptr Word8- -> IO ()-innerLoop !dptr !sptr !end = go dptr sptr- where- lix !a = aix (fromIntegral a .&. 0x0f) alphabet- {-# INLINE lix #-}-- !alphabet = "0123456789abcdef"#-- go !dst !src- | plusPtr src 3 >= end =- W16.innerLoop (castPtr dst) (castPtr src) end- | otherwise = do-#ifdef WORDS_BIGENDIAN- !t <- peek src-#else- !t <- byteSwap16 <$> peek @Word16 src-#endif- let !a = unsafeShiftR t 12- !b = unsafeShiftR t 8- !c = unsafeShiftR t 4-- let !w = w32 (lix a)- !x = w32 (lix b)- !y = w32 (lix c)- !z = w32 (lix t)-- let !xx = w- .|. (unsafeShiftL x 8)- .|. (unsafeShiftL y 16)- .|. (unsafeShiftL z 24)-- poke @Word32 dst xx-- go (plusPtr dst 4) (plusPtr src 2)-{-# INLINE innerLoop #-}---- | Hex decoding loop optimized for 32-bit architectures----decodeLoop- :: ForeignPtr Word8- -> Ptr Word8- -> Ptr Word8- -> Ptr Word16- -> Ptr Word32- -> Ptr Word8- -> Int- -> IO (Either Text ByteString)-decodeLoop !dfp !hi !lo !dptr !sptr !end !nn = go dptr sptr nn- where- err !src = return . Left . T.pack- $ "invalid character at offset: "- ++ show (src `minusPtr` sptr)-- go !dst !src !n- | plusPtr src 3 >= end =- W16.decodeLoop dfp hi lo (castPtr dst) (castPtr src) end n- | otherwise = do-#ifdef WORDS_BIGENDIAN- !t <- peek @Word32 src-#else- !t <- byteSwap32 <$> peek @Word32 src-#endif- let !w = fromIntegral ((unsafeShiftR t 24) .&. 0xff)- !x = fromIntegral ((unsafeShiftR t 16) .&. 0xff)- !y = fromIntegral ((unsafeShiftR t 8) .&. 0xff)- !z = (fromIntegral (t .&. 0xff))-- !a <- peekByteOff @Word8 hi w- !b <- peekByteOff @Word8 lo x- !c <- peekByteOff @Word8 hi y- !d <- peekByteOff @Word8 lo z-- let !zz = fromIntegral (a .|. b)- .|. (unsafeShiftL (fromIntegral (c .|. d)) 8)- if- | a == 0xff -> err src- | b == 0xff -> err (plusPtr src 1)- | c == 0xff -> err (plusPtr src 2)- | d == 0xff -> err (plusPtr src 3)- | otherwise -> do- poke @Word16 dst zz- go (plusPtr dst 2) (plusPtr src 4) (n + 2)-{-# INLINE decodeLoop #-}--lenientLoop- :: ForeignPtr Word8- -> Ptr Word8- -> Ptr Word8- -> Ptr Word8- -> Ptr Word8- -> Ptr Word8- -> Int- -> IO ByteString-lenientLoop !dfp !hi !lo !dptr !sptr !end !nn =- W16.lenientLoop dfp hi lo dptr sptr end nn
− src/Data/ByteString/Base16/Internal/W64/Loop.hs
@@ -1,169 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE TypeApplications #-}--- |--- Module : Data.ByteString.Base16.Internal.W64.Loop--- Copyright : (c) 2020 Emily Pillmore--- License : BSD-style------ Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable------ Encoding loop optimized for 'Word64' architectures----module Data.ByteString.Base16.Internal.W64.Loop-( innerLoop-, decodeLoop-, lenientLoop-) where---import Data.Bits-import Data.ByteString.Internal-import Data.ByteString.Base16.Internal.Utils-import qualified Data.ByteString.Base16.Internal.W32.Loop as W32-import Data.Text (Text)-import qualified Data.Text as T--import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable--import GHC.Word----- | Hex encoding inner loop optimized for 64-bit architectures----innerLoop- :: Ptr Word64- -> Ptr Word32- -> Ptr Word8- -> IO ()-innerLoop !dptr !sptr !end = go dptr sptr- where- lix !a = aix (fromIntegral a .&. 0x0f) alphabet- {-# INLINE lix #-}-- !alphabet = "0123456789abcdef"#-- go !dst !src- | plusPtr src 7 >= end =- W32.innerLoop (castPtr dst) (castPtr src) end- | otherwise = do-#ifdef WORDS_BIGENDIAN- !t <- peek src-#else- !t <- byteSwap32 <$> peek @Word32 src-#endif- let !a = unsafeShiftR t 28- !b = unsafeShiftR t 24- !c = unsafeShiftR t 20- !d = unsafeShiftR t 16- !e = unsafeShiftR t 12- !f = unsafeShiftR t 8- !g = unsafeShiftR t 4-- let !p = w64 (lix a)- !q = w64 (lix b)- !r = w64 (lix c)- !s = w64 (lix d)- !w = w64 (lix e)- !x = w64 (lix f)- !y = w64 (lix g)- !z = w64 (lix t)-- let !xx = p- .|. (unsafeShiftL q 8)- .|. (unsafeShiftL r 16)- .|. (unsafeShiftL s 24)-- !yy = w- .|. (unsafeShiftL x 8)- .|. (unsafeShiftL y 16)- .|. (unsafeShiftL z 24)-- let !zz = xx .|. unsafeShiftL yy 32-- poke dst zz-- go (plusPtr dst 8) (plusPtr src 4)-{-# INLINE innerLoop #-}----- | Hex decoding loop optimized for 64-bit architectures----decodeLoop- :: ForeignPtr Word8- -> Ptr Word8- -> Ptr Word8- -> Ptr Word32- -> Ptr Word64- -> Ptr Word8- -> Int- -> IO (Either Text ByteString)-decodeLoop !dfp !hi !lo !dptr !sptr !end !nn = go dptr sptr nn- where- err !src = return . Left . T.pack- $ "invalid character at offset: "- ++ show (src `minusPtr` sptr)-- go !dst !src !n- | plusPtr src 7 >= end =- W32.decodeLoop dfp hi lo (castPtr dst) (castPtr src) end n- | otherwise = do-#ifdef WORDS_BIGENDIAN- !tt <- peek @Word64 src-#else- !tt <- byteSwap64 <$> peek @Word64 src-#endif- let !s = fromIntegral ((unsafeShiftR tt 56) .&. 0xff)- !t = fromIntegral ((unsafeShiftR tt 48) .&. 0xff)- !u = fromIntegral ((unsafeShiftR tt 40) .&. 0xff)- !v = fromIntegral ((unsafeShiftR tt 32) .&. 0xff)- !w = fromIntegral ((unsafeShiftR tt 24) .&. 0xff)- !x = fromIntegral ((unsafeShiftR tt 16) .&. 0xff)- !y = fromIntegral ((unsafeShiftR tt 8) .&. 0xff)- !z = fromIntegral (tt .&. 0xff)-- !a <- peekByteOff @Word8 hi s- !b <- peekByteOff @Word8 lo t- !c <- peekByteOff @Word8 hi u- !d <- peekByteOff @Word8 lo v- !e <- peekByteOff @Word8 hi w- !f <- peekByteOff @Word8 lo x- !g <- peekByteOff @Word8 hi y- !h <- peekByteOff @Word8 lo z-- let !zz = fromIntegral (a .|. b)- .|. (unsafeShiftL (fromIntegral (c .|. d)) 8)- .|. (unsafeShiftL (fromIntegral (e .|. f)) 16)- .|. (unsafeShiftL (fromIntegral (g .|. h)) 24)-- if- | a == 0xff -> err src- | b == 0xff -> err (plusPtr src 1)- | c == 0xff -> err (plusPtr src 2)- | d == 0xff -> err (plusPtr src 3)- | e == 0xff -> err (plusPtr src 4)- | f == 0xff -> err (plusPtr src 5)- | g == 0xff -> err (plusPtr src 6)- | h == 0xff -> err (plusPtr src 7)- | otherwise -> do- poke @Word32 dst zz- go (plusPtr dst 4) (plusPtr src 8) (n + 4)-{-# INLINE decodeLoop #-}--lenientLoop- :: ForeignPtr Word8- -> Ptr Word8- -> Ptr Word8- -> Ptr Word8- -> Ptr Word8- -> Ptr Word8- -> Int- -> IO ByteString-lenientLoop !dfp !hi !lo !dptr !sptr !end !nn =- W32.lenientLoop dfp hi lo dptr sptr end nn