{-# 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 :: Ptr Word32 -> Ptr Word16 -> Ptr Word8 -> IO ()
innerLoop !Ptr Word32
dptr !Ptr Word16
sptr !Ptr Word8
end = Ptr Word32 -> Ptr Word16 -> IO ()
go Ptr Word32
dptr Ptr Word16
sptr
  where
    lix :: a -> Word8
lix !a
a = Word8 -> Addr# -> Word8
aix (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x0f) Addr#
alphabet
    {-# INLINE lix #-}

    !alphabet :: Addr#
alphabet = "0123456789abcdef"#

    go :: Ptr Word32 -> Ptr Word16 -> IO ()
go !Ptr Word32
dst !Ptr Word16
src
      | Ptr Word16 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word16
src 3 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end =
        Ptr Word16 -> Ptr Word8 -> Ptr Word8 -> IO ()
W16.innerLoop (Ptr Word32 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr Word32
dst) (Ptr Word16 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
src) Ptr Word8
end
      | Bool
otherwise = do
#ifdef WORDS_BIGENDIAN
        !t <- peek src
#else
        !Word16
t <- Word16 -> Word16
byteSwap16 (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek @Word16 Ptr Word16
src
#endif
        let !a :: Word16
a = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
unsafeShiftR Word16
t 12
            !b :: Word16
b = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
unsafeShiftR Word16
t 8
            !c :: Word16
c = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
unsafeShiftR Word16
t 4

        let !w :: Word32
w = Word8 -> Word32
w32 (Word16 -> Word8
forall a. Integral a => a -> Word8
lix Word16
a)
            !x :: Word32
x = Word8 -> Word32
w32 (Word16 -> Word8
forall a. Integral a => a -> Word8
lix Word16
b)
            !y :: Word32
y = Word8 -> Word32
w32 (Word16 -> Word8
forall a. Integral a => a -> Word8
lix Word16
c)
            !z :: Word32
z = Word8 -> Word32
w32 (Word16 -> Word8
forall a. Integral a => a -> Word8
lix Word16
t)

        let !xx :: Word32
xx = Word32
w
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
x 8)
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
y 16)
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
z 24)

        Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word32 Ptr Word32
dst Word32
xx

        Ptr Word32 -> Ptr Word16 -> IO ()
go (Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word32
dst 4) (Ptr Word16 -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word16
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 :: ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word16
-> Ptr Word32
-> Ptr Word8
-> Int
-> IO (Either Text ByteString)
decodeLoop !ForeignPtr Word8
dfp !Ptr Word8
hi !Ptr Word8
lo !Ptr Word16
dptr !Ptr Word32
sptr !Ptr Word8
end !Int
nn = Ptr Word16 -> Ptr Word32 -> Int -> IO (Either Text ByteString)
go Ptr Word16
dptr Ptr Word32
sptr Int
nn
  where
    err :: Ptr a -> m (Either Text b)
err !Ptr a
src = Either Text b -> m (Either Text b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text b -> m (Either Text b))
-> (String -> Either Text b) -> String -> m (Either Text b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text b
forall a b. a -> Either a b
Left (Text -> Either Text b)
-> (String -> Text) -> String -> Either Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      (String -> m (Either Text b)) -> String -> m (Either Text b)
forall a b. (a -> b) -> a -> b
$ "invalid character at offset: "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Ptr a
src Ptr a -> Ptr Word32 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word32
sptr)

    go :: Ptr Word16 -> Ptr Word32 -> Int -> IO (Either Text ByteString)
go !Ptr Word16
dst !Ptr Word32
src !Int
n
      | Ptr Word32 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word32
src 3 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end =
        ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO (Either Text ByteString)
W16.decodeLoop ForeignPtr Word8
dfp Ptr Word8
hi Ptr Word8
lo (Ptr Word16 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
dst) (Ptr Word32 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word32
src) Ptr Word8
end Int
n
      | Bool
otherwise = do
#ifdef WORDS_BIGENDIAN
        !t <- peek @Word32 src
#else
        !Word32
t <- Word32 -> Word32
byteSwap32 (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr Word32
src
#endif
        let !w :: Int
w = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
t 24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0xff)
            !x :: Int
x = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
t 16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0xff)
            !y :: Int
y = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
t 8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0xff)
            !z :: Int
z = (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
t Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0xff))

        !Word8
a <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
hi Int
w
        !Word8
b <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
lo Int
x
        !Word8
c <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
hi Int
y
        !Word8
d <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
lo Int
z

        let !zz :: Word16
zz = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
b)
               Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
d)) 8)
        if
          | Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff -> Ptr Word32 -> IO (Either Text ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either Text b)
err Ptr Word32
src
          | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff -> Ptr Any -> IO (Either Text ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either Text b)
err (Ptr Word32 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word32
src 1)
          | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff -> Ptr Any -> IO (Either Text ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either Text b)
err (Ptr Word32 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word32
src 2)
          | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff -> Ptr Any -> IO (Either Text ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either Text b)
err (Ptr Word32 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word32
src 3)
          | Bool
otherwise -> do
            Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word16 Ptr Word16
dst Word16
zz
            Ptr Word16 -> Ptr Word32 -> Int -> IO (Either Text ByteString)
go (Ptr Word16 -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word16
dst 2) (Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word32
src 4) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
{-# INLINE decodeLoop #-}

lenientLoop
  :: ForeignPtr Word8
  -> Ptr Word8
  -> Ptr Word8
  -> Ptr Word8
  -> Ptr Word8
  -> Ptr Word8
  -> Int
  -> IO ByteString
lenientLoop :: ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO ByteString
lenientLoop !ForeignPtr Word8
dfp !Ptr Word8
hi !Ptr Word8
lo !Ptr Word8
dptr !Ptr Word8
sptr !Ptr Word8
end !Int
nn =
  ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO ByteString
W16.lenientLoop ForeignPtr Word8
dfp Ptr Word8
hi Ptr Word8
lo Ptr Word8
dptr Ptr Word8
sptr Ptr Word8
end Int
nn