ppad-base16 0.2.1 → 0.3.0
raw patch · 5 files changed
+360/−260 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG +5/−0
- cbits/base16_arm.c +143/−0
- lib/Data/ByteString/Base16.hs +126/−259
- lib/Data/ByteString/Base16/Arm.hs +70/−0
- ppad-base16.cabal +16/−1
CHANGELOG view
@@ -1,5 +1,10 @@ # Changelog +- 0.3.0 (2026-05-16)+ * Features order-of-magnitude performance improvements in both+ encoding and decoding, especially on ARM platforms where NEON+ intrinsics are available.+ - 0.2.1 (2025-12-28) * Adds an 'llvm' build flag and is now tested with GHC 9.10.3.
+ cbits/base16_arm.c view
@@ -0,0 +1,143 @@+#include <stddef.h>+#include <stdint.h>++#if defined(__aarch64__)++#include <arm_neon.h>++/* lowercase ASCII hex character for each nibble value 0..15 */+static const uint8_t hex_lut[16] = {+ '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f'+};++/*+ * Encode 'l' input bytes at 'src' into 2*l ASCII hex bytes at 'dst'.+ *+ * NEON kernel processes 16 input bytes per iteration:+ * - vshrq_n_u8 / vandq_u8 split the high and low nibbles+ * - vqtbl1q_u8 looks up each nibble in 'hex_lut' (the tbl instr)+ * - vst2q_u8 stores the two char vectors interleaved, producing+ * [h0 l0 h1 l1 ... h15 l15] which is exactly the hex output+ *+ * A scalar tail finishes the final (l mod 16) bytes.+ */+void base16_encode_arm(const uint8_t *src, uint8_t *dst, size_t l) {+ uint8x16_t lut = vld1q_u8(hex_lut);+ uint8x16_t mask_lo = vdupq_n_u8(0x0f);+ size_t i = 0;++ for (; i + 16 <= l; i += 16) {+ uint8x16_t in = vld1q_u8(src + i);+ uint8x16_t hi = vshrq_n_u8(in, 4);+ uint8x16_t lo = vandq_u8(in, mask_lo);+ uint8x16x2_t pair = { { vqtbl1q_u8(lut, hi),+ vqtbl1q_u8(lut, lo) } };+ vst2q_u8(dst + 2 * i, pair);+ }++ for (; i < l; i++) {+ uint8_t b = src[i];+ dst[2 * i] = hex_lut[b >> 4];+ dst[2 * i + 1] = hex_lut[b & 0x0f];+ }+}++/*+ * Convert 16 ASCII hex chars to nibble values (0..15) in 'nib'.+ * Each lane of 'bad' is set to 0xff if the corresponding input is+ * not a valid hex digit ('0'..'9', 'a'..'f', 'A'..'F'), 0x00 if it+ * is. Case-insensitive.+ */+static inline void ascii_to_nibble(uint8x16_t c,+ uint8x16_t *nib,+ uint8x16_t *bad) {+ uint8x16_t is_digit = vandq_u8(vcgeq_u8(c, vdupq_n_u8('0')),+ vcleq_u8(c, vdupq_n_u8('9')));+ uint8x16_t is_lower = vandq_u8(vcgeq_u8(c, vdupq_n_u8('a')),+ vcleq_u8(c, vdupq_n_u8('f')));+ uint8x16_t is_upper = vandq_u8(vcgeq_u8(c, vdupq_n_u8('A')),+ vcleq_u8(c, vdupq_n_u8('F')));++ /* offset to subtract from c: '0' (0x30), 'a'-10 (0x57), 'A'-10+ * (0x37); zero in lanes that aren't valid hex (the resulting+ * nibble in those lanes is garbage but 'bad' flags them). */+ uint8x16_t off = vorrq_u8(+ vandq_u8(is_digit, vdupq_n_u8(0x30)),+ vorrq_u8(+ vandq_u8(is_lower, vdupq_n_u8(0x57)),+ vandq_u8(is_upper, vdupq_n_u8(0x37))));++ *nib = vsubq_u8(c, off);+ *bad = vmvnq_u8(vorrq_u8(is_digit, vorrq_u8(is_lower, is_upper)));+}++static inline uint8_t scalar_nib(uint8_t c) {+ if (c >= '0' && c <= '9') return (uint8_t)(c - '0');+ if (c >= 'a' && c <= 'f') return (uint8_t)(c - 'a' + 10);+ if (c >= 'A' && c <= 'F') return (uint8_t)(c - 'A' + 10);+ return 0x80; /* invalid sentinel */+}++/*+ * Decode 2*outlen hex chars at 'src' into 'outlen' bytes at 'dst'.+ * Returns 1 on success, 0 if any invalid hex char was seen (in which+ * case the contents of 'dst' are unspecified).+ *+ * NEON kernel processes 32 input chars per iteration:+ * - vld2q_u8 deinterleaves into a vector of high-nibble chars and a+ * vector of low-nibble chars+ * - ascii_to_nibble validates and converts each char to its nibble+ * - vshlq_n_u8 + vorrq_u8 packs nibble pairs into output bytes+ * - the per-iteration 'bad' masks are OR-accumulated; we reduce+ * once at the end with vmaxvq_u8+ *+ * A scalar tail finishes the final (outlen mod 16) output bytes.+ */+int base16_decode_arm(const uint8_t *src, uint8_t *dst, size_t outlen) {+ uint8x16_t bad = vdupq_n_u8(0);+ size_t i = 0;++ for (; i + 16 <= outlen; i += 16) {+ uint8x16x2_t pair = vld2q_u8(src + 2 * i);+ uint8x16_t nib_hi, nib_lo, bad_hi, bad_lo;+ ascii_to_nibble(pair.val[0], &nib_hi, &bad_hi);+ ascii_to_nibble(pair.val[1], &nib_lo, &bad_lo);+ uint8x16_t byte = vorrq_u8(vshlq_n_u8(nib_hi, 4), nib_lo);+ vst1q_u8(dst + i, byte);+ bad = vorrq_u8(bad, vorrq_u8(bad_hi, bad_lo));+ }++ uint8_t tail_bad = 0;+ for (; i < outlen; i++) {+ uint8_t n0 = scalar_nib(src[2 * i]);+ uint8_t n1 = scalar_nib(src[2 * i + 1]);+ tail_bad |= (n0 | n1) & 0x80;+ dst[i] = (uint8_t)((n0 << 4) | (n1 & 0x0f));+ }++ return (vmaxvq_u8(bad) == 0) && (tail_bad == 0);+}++int base16_arm_available(void) {+ return 1;+}++#else++/* stubs for non-aarch64 builds; never reached because dispatch is+ * gated on 'base16_arm_available' returning 0 */++void base16_encode_arm(const uint8_t *src, uint8_t *dst, size_t l) {+ (void)src; (void)dst; (void)l;+}++int base16_decode_arm(const uint8_t *src, uint8_t *dst, size_t outlen) {+ (void)src; (void)dst; (void)outlen;+ return 0;+}++int base16_arm_available(void) {+ return 0;+}++#endif
lib/Data/ByteString/Base16.hs view
@@ -1,7 +1,5 @@ {-# OPTIONS_HADDOCK prune #-}-{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE OverloadedStrings #-} -- |@@ -20,285 +18,154 @@ import qualified Data.Bits as B import Data.Bits ((.&.), (.|.)) import qualified Data.ByteString as BS-import qualified Data.ByteString.Builder as BSB-import qualified Data.ByteString.Builder.Extra as BE+import qualified Data.ByteString.Base16.Arm as Arm import qualified Data.ByteString.Internal as BI-import qualified Data.ByteString.Unsafe as BU import Data.Word (Word8, Word16)--to_strict :: BSB.Builder -> BS.ByteString-to_strict = BS.toStrict . BSB.toLazyByteString-{-# INLINE to_strict #-}--to_strict_small :: BSB.Builder -> BS.ByteString-to_strict_small = BS.toStrict- . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty-{-# INLINE to_strict_small #-}+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Foreign.Storable (peekElemOff, pokeElemOff)+import System.IO.Unsafe (unsafeDupablePerformIO) fi :: (Num a, Integral b) => b -> a fi = fromIntegral {-# INLINE fi #-} -hex_charset :: BS.ByteString-hex_charset = "0123456789abcdef"+-- 512-byte table. Bytes [2k] and [2k+1] are the two lowercase ASCII+-- hex characters representing the value k. All-ASCII content means+-- the bytestring 'IsString' rule rewrites this to 'unsafePackAddress'+-- and the bytes live in static rodata.+enc_tab :: BS.ByteString+enc_tab =+ "000102030405060708090a0b0c0d0e0f\+ \101112131415161718191a1b1c1d1e1f\+ \202122232425262728292a2b2c2d2e2f\+ \303132333435363738393a3b3c3d3e3f\+ \404142434445464748494a4b4c4d4e4f\+ \505152535455565758595a5b5c5d5e5f\+ \606162636465666768696a6b6c6d6e6f\+ \707172737475767778797a7b7c7d7e7f\+ \808182838485868788898a8b8c8d8e8f\+ \909192939495969798999a9b9c9d9e9f\+ \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\+ \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\+ \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\+ \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\+ \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\+ \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"+{-# NOINLINE enc_tab #-} -expand_w8 :: Word8 -> Word16-expand_w8 b =- let !hi = BU.unsafeIndex hex_charset (fi b `B.shiftR` 4)- !lo = BU.unsafeIndex hex_charset (fi b .&. 0b00001111)- in fi hi `B.shiftL` 8- .|. fi lo-{-# INLINE expand_w8 #-}+-- 256-byte table. Index by an ASCII byte to obtain its nibble; valid+-- hex chars ('0'..'9', 'a'..'f', 'A'..'F') map to 0x10..0x1f, every+-- other byte maps to 0x20.+--+-- The encoding is chosen so the literal is strictly ASCII and contains+-- no embedded NUL, which is what the bytestring 'IsString' rule needs+-- to rewrite it into 'unsafePackAddress' (cf. 'enc_tab') — the bytes+-- end up in static rodata, with no CAF allocation.+--+-- The 0x20 sentinel is distinguished by bit 5; no value 0x10..0x1f+-- carries that bit, so 'decode' OR-folds every lookup into an+-- accumulator and tests 'acc .&. 0x20 == 0' once at the end. The+-- output byte is '(n0 `shiftL` 4) .|. (n1 .&. 0x0f)': in 'Word8' the+-- shift naturally drops bit 4, and the mask isolates the low nibble.+dec_tab :: BS.ByteString+dec_tab =+ "\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x20\x20\x20\x20\x20\x20\+ \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20"+{-# NOINLINE dec_tab #-} -- | Encode a base256 'ByteString' as base16. --+-- Uses ARM NEON extensions when available, otherwise a pure+-- Haskell scalar loop.+-- -- >>> encode "hello world" -- "68656c6c6f20776f726c64" encode :: BS.ByteString -> BS.ByteString-encode bs@(BI.PS _ _ l)- | l < 64 = to_strict_small loop- | otherwise = to_strict loop- where- -- writing as few words as possible requires performing some length- -- checks up front- loop- | l `rem` 4 == 0 =- go64 bs- | (l - 3) `rem` 4 == 0 = case BS.splitAt (l - 3) bs of- (chunk, etc) ->- go64 chunk- <> go32 (BU.unsafeTake 2 etc)- <> go16 (BU.unsafeDrop 2 etc)- | (l - 2) `rem` 4 == 0 = case BS.splitAt (l - 2) bs of- (chunk, etc) ->- go64 chunk- <> go32 etc- | (l - 1) `rem` 4 == 0 = case BS.splitAt (l - 1) bs of- (chunk, etc) ->- go64 chunk- <> go16 etc-- | l `rem` 2 == 0 =- go32 bs- | (l - 1) `rem` 2 == 0 = case BS.splitAt (l - 1) bs of- (chunk, etc) ->- go32 chunk- <> go16 etc-- | otherwise =- go16 bs-- go64 b = case BS.splitAt 4 b of- (chunk, etc)- | BS.null chunk -> mempty- | otherwise ->- let !w16_0 = expand_w8 (BU.unsafeIndex chunk 0)- !w16_1 = expand_w8 (BU.unsafeIndex chunk 1)- !w16_2 = expand_w8 (BU.unsafeIndex chunk 2)- !w16_3 = expand_w8 (BU.unsafeIndex chunk 3)-- !w64 = fi w16_0 `B.shiftL` 48- .|. fi w16_1 `B.shiftL` 32- .|. fi w16_2 `B.shiftL` 16- .|. fi w16_3-- in BSB.word64BE w64 <> go64 etc-- go32 b = case BS.splitAt 2 b of- (chunk, etc)- | BS.null chunk -> mempty- | otherwise ->- let !w16_0 = expand_w8 (BU.unsafeIndex chunk 0)- !w16_1 = expand_w8 (BU.unsafeIndex chunk 1)-- !w32 = fi w16_0 `B.shiftL` 16- .|. fi w16_1-- in BSB.word32BE w32 <> go32 etc-- go16 b = case BS.uncons b of- Nothing -> mempty- Just (h, t) ->- let !w16 = expand_w8 h- in BSB.word16BE w16 <> go16 t---- word8 hex character to word4-word4 :: Word8 -> Maybe Word8-word4 c- | c > 47 && c < 58 = pure $! c - 48 -- 0-9- | c > 64 && c < 71 = pure $! c - 55 -- A-F- | c > 96 && c < 103 = pure $! c - 87 -- a-f- | otherwise = Nothing-{-# INLINE word4 #-}+encode bs+ | Arm.base16_arm_available = Arm.encode bs+ | otherwise = encode_scalar bs+{-# INLINABLE encode #-} -- | Decode a base16 'ByteString' to base256. ----- Invalid inputs (including odd-length inputs) will produce--- 'Nothing'.+-- Uses ARM NEON extensions when available, otherwise a pure+-- Haskell scalar loop. Invalid inputs (including odd-length+-- inputs) will produce 'Nothing'. -- -- >>> decode "68656c6c6f20776f726c64" -- Just "hello world" -- >>> decode "068656c6c6f20776f726c64" -- odd-length -- Nothing decode :: BS.ByteString -> Maybe BS.ByteString-decode bs@(BI.PS _ _ l)- | B.testBit l 0 = Nothing- | l `quot` 2 < 128 = fmap to_strict_small loop- | otherwise = fmap to_strict loop- where- -- same story, but we need more checks- loop- | l `rem` 16 == 0 =- go64 mempty bs- | (l - 2) `rem` 16 == 0 = case BS.splitAt (l - 2) bs of- (chunk, etc) -> do- b0 <- go64 mempty chunk- go8 b0 etc- | (l - 4) `rem` 16 == 0 = case BS.splitAt (l - 4) bs of- (chunk, etc) -> do- b0 <- go64 mempty chunk- go16 b0 etc- | (l - 6) `rem` 16 == 0 = case BS.splitAt (l - 6) bs of- (chunk, etc) -> do- b0 <- go64 mempty chunk- b1 <- go16 b0 (BU.unsafeTake 4 etc)- go8 b1 (BU.unsafeDrop 4 etc)- | (l - 8) `rem` 16 == 0 = case BS.splitAt (l - 8) bs of- (chunk, etc) -> do- b0 <- go64 mempty chunk- go32 b0 etc- | (l - 10) `rem` 16 == 0 = case BS.splitAt (l - 10) bs of- (chunk, etc) -> do- b0 <- go64 mempty chunk- b1 <- go32 b0 (BU.unsafeTake 8 etc)- go8 b1 (BU.unsafeDrop 8 etc)- | (l - 12) `rem` 16 == 0 = case BS.splitAt (l - 12) bs of- (chunk, etc) -> do- b0 <- go64 mempty chunk- b1 <- go32 b0 (BU.unsafeTake 8 etc)- go16 b1 (BU.unsafeDrop 8 etc)- | (l - 14) `rem` 16 == 0 = case BS.splitAt (l - 14) bs of- (chunk, etc) -> do- b0 <- go64 mempty chunk- b1 <- go32 b0 (BU.unsafeTake 8 etc)- b2 <- go16 b1 (BU.unsafeTake 4 (BU.unsafeDrop 8 etc))- go8 b2 (BU.unsafeDrop 12 etc)-- | l `rem` 8 == 0 =- go32 mempty bs- | (l - 2) `rem` 8 == 0 = case BS.splitAt (l - 2) bs of- (chunk, etc) -> do- b0 <- go32 mempty chunk- go8 b0 etc- | (l - 4) `rem` 8 == 0 = case BS.splitAt (l - 4) bs of- (chunk, etc) -> do- b0 <- go32 mempty chunk- go16 b0 etc- | (l - 6) `rem` 8 == 0 = case BS.splitAt (l - 6) bs of- (chunk, etc) -> do- b0 <- go32 mempty chunk- b1 <- go16 b0 (BU.unsafeTake 4 etc)- go8 b1 (BU.unsafeDrop 4 etc)-- | l `rem` 4 == 0 =- go16 mempty bs- | (l - 2) `rem` 4 == 0 = case BS.splitAt (l - 2) bs of- (chunk, etc) -> do- b0 <- go16 mempty chunk- go8 b0 etc-- | otherwise =- go8 mempty bs-- go64 acc b = case BS.splitAt 16 b of- (chunk, etc)- | BS.null chunk -> pure acc- | otherwise -> do- !w4_00 <- word4 (BU.unsafeIndex chunk 00)- !w4_01 <- word4 (BU.unsafeIndex chunk 01)- !w4_02 <- word4 (BU.unsafeIndex chunk 02)- !w4_03 <- word4 (BU.unsafeIndex chunk 03)- !w4_04 <- word4 (BU.unsafeIndex chunk 04)- !w4_05 <- word4 (BU.unsafeIndex chunk 05)- !w4_06 <- word4 (BU.unsafeIndex chunk 06)- !w4_07 <- word4 (BU.unsafeIndex chunk 07)- !w4_08 <- word4 (BU.unsafeIndex chunk 08)- !w4_09 <- word4 (BU.unsafeIndex chunk 09)- !w4_10 <- word4 (BU.unsafeIndex chunk 10)- !w4_11 <- word4 (BU.unsafeIndex chunk 11)- !w4_12 <- word4 (BU.unsafeIndex chunk 12)- !w4_13 <- word4 (BU.unsafeIndex chunk 13)- !w4_14 <- word4 (BU.unsafeIndex chunk 14)- !w4_15 <- word4 (BU.unsafeIndex chunk 15)-- let !w64 = fi w4_00 `B.shiftL` 60- .|. fi w4_01 `B.shiftL` 56- .|. fi w4_02 `B.shiftL` 52- .|. fi w4_03 `B.shiftL` 48- .|. fi w4_04 `B.shiftL` 44- .|. fi w4_05 `B.shiftL` 40- .|. fi w4_06 `B.shiftL` 36- .|. fi w4_07 `B.shiftL` 32- .|. fi w4_08 `B.shiftL` 28- .|. fi w4_09 `B.shiftL` 24- .|. fi w4_10 `B.shiftL` 20- .|. fi w4_11 `B.shiftL` 16- .|. fi w4_12 `B.shiftL` 12- .|. fi w4_13 `B.shiftL` 08- .|. fi w4_14 `B.shiftL` 04- .|. fi w4_15-- go64 (acc <> BSB.word64BE w64) etc-- go32 acc b = case BS.splitAt 8 b of- (chunk, etc)- | BS.null chunk -> pure acc- | otherwise -> do- !w4_00 <- word4 (BU.unsafeIndex chunk 00)- !w4_01 <- word4 (BU.unsafeIndex chunk 01)- !w4_02 <- word4 (BU.unsafeIndex chunk 02)- !w4_03 <- word4 (BU.unsafeIndex chunk 03)- !w4_04 <- word4 (BU.unsafeIndex chunk 04)- !w4_05 <- word4 (BU.unsafeIndex chunk 05)- !w4_06 <- word4 (BU.unsafeIndex chunk 06)- !w4_07 <- word4 (BU.unsafeIndex chunk 07)-- let !w32 = fi w4_00 `B.shiftL` 28- .|. fi w4_01 `B.shiftL` 24- .|. fi w4_02 `B.shiftL` 20- .|. fi w4_03 `B.shiftL` 16- .|. fi w4_04 `B.shiftL` 12- .|. fi w4_05 `B.shiftL` 08- .|. fi w4_06 `B.shiftL` 04- .|. fi w4_07-- go32 (acc <> BSB.word32BE w32) etc-- go16 acc b = case BS.splitAt 4 b of- (chunk, etc)- | BS.null chunk -> pure acc- | otherwise -> do- !w4_00 <- word4 (BU.unsafeIndex chunk 00)- !w4_01 <- word4 (BU.unsafeIndex chunk 01)- !w4_02 <- word4 (BU.unsafeIndex chunk 02)- !w4_03 <- word4 (BU.unsafeIndex chunk 03)-- let !w16 = fi w4_00 `B.shiftL` 12- .|. fi w4_01 `B.shiftL` 08- .|. fi w4_02 `B.shiftL` 04- .|. fi w4_03-- go16 (acc <> BSB.word16BE w16) etc-- go8 acc b = case BS.splitAt 2 b of- (chunk, etc)- | BS.null chunk -> pure acc- | otherwise -> do- !w4_00 <- word4 (BU.unsafeIndex chunk 00)- !w4_01 <- word4 (BU.unsafeIndex chunk 01)-- let !w8 = fi w4_00 `B.shiftL` 04- .|. fi w4_01+decode bs+ | Arm.base16_arm_available = Arm.decode bs+ | otherwise = decode_scalar bs+{-# INLINABLE decode #-} - go8 (acc <> BSB.word8 w8) etc+encode_scalar :: BS.ByteString -> BS.ByteString+encode_scalar (BI.PS sfp soff l) =+ case enc_tab of+ BI.PS tfp toff _ ->+ BI.unsafeCreate (l `B.shiftL` 1) $ \dst ->+ withForeignPtr sfp $ \sp0 ->+ withForeignPtr tfp $ \tp0 -> do+ -- read 'enc_tab' and write 'dst' as 'Word16' pairs. The+ -- two-byte block at 'enc_tab[2*b]' and the two-byte block+ -- at 'dst[2*i]' share the same byte layout in memory, so+ -- this is endianness-safe: we never inspect the numerical+ -- value of the 'Word16', we just shuffle 16 bits between+ -- two locations.+ let !sp = sp0 `plusPtr` soff :: Ptr Word8+ !tp = tp0 `plusPtr` toff :: Ptr Word16+ !dp = castPtr dst :: Ptr Word16+ loop !i+ | i == l = pure ()+ | otherwise = do+ b <- peekElemOff sp i+ w <- peekElemOff tp (fi b)+ pokeElemOff dp i (w :: Word16)+ loop (i + 1)+ loop 0 +decode_scalar :: BS.ByteString -> Maybe BS.ByteString+decode_scalar (BI.PS sfp soff l)+ | B.testBit l 0 = Nothing+ | otherwise = case dec_tab of+ BI.PS tfp toff _ -> unsafeDupablePerformIO $ do+ let !n = l `B.shiftR` 1+ fp <- BI.mallocByteString n+ ok <- withForeignPtr fp $ \dst ->+ withForeignPtr sfp $ \sp0 ->+ withForeignPtr tfp $ \tp0 -> do+ let !sp = sp0 `plusPtr` soff :: Ptr Word8+ !tp = tp0 `plusPtr` toff :: Ptr Word8+ loop !i !acc+ | i == n =+ pure $! acc .&. 0x20 == 0+ | otherwise = do+ let !o = i `B.shiftL` 1+ c0 <- peekElemOff sp o+ c1 <- peekElemOff sp (o + 1)+ n0 <- peekElemOff tp (fi c0)+ n1 <- peekElemOff tp (fi c1)+ let !b = (n0 `B.shiftL` 4)+ .|. (n1 .&. 0x0f)+ pokeElemOff dst i b+ loop (i + 1) (acc .|. n0 .|. n1)+ loop 0 0+ pure $! if ok then Just (BI.PS fp 0 n) else Nothing
+ lib/Data/ByteString/Base16/Arm.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module: Data.ByteString.Base16.Arm+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- ARM NEON support for base16 encoding and decoding.++module Data.ByteString.Base16.Arm (+ base16_arm_available+ , encode+ , decode+ ) where++import qualified Data.Bits as B+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BI+import Data.Word (Word8)+import Foreign.C.Types (CInt(..), CSize(..))+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, plusPtr)+import System.IO.Unsafe (unsafeDupablePerformIO)++-- ffi ------------------------------------------------------------------------++foreign import ccall unsafe "base16_encode_arm"+ c_base16_encode :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()++foreign import ccall unsafe "base16_decode_arm"+ c_base16_decode :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt++foreign import ccall unsafe "base16_arm_available"+ c_base16_arm_available :: IO CInt++-- utilities ------------------------------------------------------------------++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}++-- api ------------------------------------------------------------------------++-- | Are ARM NEON extensions available?+base16_arm_available :: Bool+base16_arm_available =+ unsafeDupablePerformIO c_base16_arm_available /= 0+{-# NOINLINE base16_arm_available #-}++-- | Encode a base256 'ByteString' as base16 using NEON.+encode :: BS.ByteString -> BS.ByteString+encode (BI.PS sfp soff l) =+ BI.unsafeCreate (l `B.shiftL` 1) $ \dst ->+ withForeignPtr sfp $ \sp0 ->+ c_base16_encode (sp0 `plusPtr` soff) dst (fi l)++-- | Decode a base16 'ByteString' to base256 using NEON. Returns+-- 'Nothing' on odd-length or otherwise invalid input.+decode :: BS.ByteString -> Maybe BS.ByteString+decode (BI.PS sfp soff l)+ | B.testBit l 0 = Nothing+ | otherwise = unsafeDupablePerformIO $ do+ let !n = l `B.shiftR` 1+ fp <- BI.mallocByteString n+ ok <- withForeignPtr fp $ \dst ->+ withForeignPtr sfp $ \sp0 ->+ c_base16_decode (sp0 `plusPtr` soff) dst (fi n)+ pure $! if ok /= 0 then Just (BI.PS fp 0 n) else Nothing
ppad-base16.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-base16-version: 0.2.1+version: 0.3.0 synopsis: Pure base16 encoding and decoding on bytestrings. license: MIT license-file: LICENSE@@ -18,6 +18,11 @@ default: False manual: True +flag sanitize+ description: Build with AddressSanitizer and UndefinedBehaviorSanitizer.+ default: False+ manual: True+ source-repository head type: git location: git.ppad.tech/base16.git@@ -31,9 +36,17 @@ ghc-options: -fllvm -O2 exposed-modules: Data.ByteString.Base16+ Data.ByteString.Base16.Arm build-depends: base >= 4.9 && < 5 , bytestring >= 0.9 && < 0.13+ c-sources:+ cbits/base16_arm.c+ if arch(aarch64)+ cc-options: -march=armv8-a+ if flag(sanitize)+ cc-options: -fsanitize=address,undefined -fno-omit-frame-pointer+ ghc-options: -optl=-fsanitize=address,undefined test-suite base16-tests type: exitcode-stdio-1.0@@ -43,6 +56,8 @@ ghc-options: -rtsopts -Wall -O2+ if flag(sanitize)+ ghc-options: -optl=-fsanitize=address,undefined build-depends: base