{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
-- |
-- Module       : Data.ByteString.Base16.Internal.W16.Loop
-- Copyright 	: (c) 2020 Emily Pillmore
-- License	: BSD-style
--
-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>
-- Stability	: Experimental
-- Portability	: portable
--
-- Encoding loop optimized for 'Word16' architectures
--
module Data.ByteString.Base16.Internal.W16.Loop
( innerLoop
, decodeLoop
, decodeLoopTyped
, lenientLoop
) where


import Data.Bits
import Data.ByteString.Internal
import Data.ByteString.Base16.Internal.Utils
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 16-bit architectures
--
innerLoop
    :: Ptr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> IO ()
innerLoop :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
innerLoop !Ptr Word8
dptr !Ptr Word8
sptr !Ptr Word8
end = Ptr Word8 -> Ptr Word8 -> IO ()
go Ptr Word8
dptr Ptr Word8
sptr
  where
    !hex :: Addr#
hex = Addr#
"0123456789abcdef"#

    go :: Ptr Word8 -> Ptr Word8 -> IO ()
go !Ptr Word8
dst !Ptr Word8
src
      | Ptr Word8
src forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = do
        !Word8
t <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src

        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst (Word8 -> Addr# -> Word8
aix (forall a. Bits a => a -> Int -> a
unsafeShiftR Word8
t Int
4) Addr#
hex)
        forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (Word8 -> Addr# -> Word8
aix (Word8
t forall a. Bits a => a -> a -> a
.&. Word8
0x0f) Addr#
hex)

        Ptr Word8 -> Ptr Word8 -> IO ()
go (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)

-- | Hex decoding loop optimized for 16-bit architectures
--
decodeLoop
  :: ForeignPtr Word8
  -> Ptr Word8
  -> Ptr Word8
  -> Ptr Word8
  -> Int
  -> IO (Either Text ByteString)
decodeLoop :: ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO (Either Text ByteString)
decodeLoop !ForeignPtr Word8
dfp !Ptr Word8
dptr !Ptr Word8
sptr !Ptr Word8
end !Int
l = Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString)
go Ptr Word8
dptr Ptr Word8
sptr
  where
    err :: Ptr a -> m (Either Text b)
err !Ptr a
src = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
      forall a b. (a -> b) -> a -> b
$ [Char]
"invalid character at offset: "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Ptr a
src forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr)

    !lo :: Addr#
lo = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 :: Addr#
hi = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 :: Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString)
go !Ptr Word8
dst !Ptr Word8
src
      | Ptr Word8
src forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 Int
l)
      | Bool
otherwise = do
        !Word8
x <- forall a. Storable a => Ptr a -> IO a
peek @Word8 Ptr Word8
src
        !Word8
y <- forall a. Storable a => Ptr a -> IO a
peek @Word8 (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)

        let !a :: Word8
a = Word8 -> Addr# -> Word8
aix Word8
x Addr#
hi
            !b :: Word8
b = Word8 -> Addr# -> Word8
aix Word8
y Addr#
lo
        if
          | Word8
a forall a. Eq a => a -> a -> Bool
== Word8
0xff -> forall {m :: * -> *} {a} {b}. Monad m => Ptr a -> m (Either Text b)
err Ptr Word8
src
          | Word8
b forall a. Eq a => a -> a -> Bool
== Word8
0xff -> forall {m :: * -> *} {a} {b}. Monad m => Ptr a -> m (Either Text b)
err (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
          | Bool
otherwise -> do
            forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst (Word8
a forall a. Bits a => a -> a -> a
.|. Word8
b)
            Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString)
go (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
{-# INLINE decodeLoop #-}

-- | Hex decoding loop optimized for 16-bit architectures
--
decodeLoopTyped
  :: Ptr Word8
  -> Ptr Word8
  -> Ptr Word8
  -> IO ()
decodeLoopTyped :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
decodeLoopTyped !Ptr Word8
dptr !Ptr Word8
sptr !Ptr Word8
end = Ptr Word8 -> Ptr Word8 -> IO ()
go Ptr Word8
dptr Ptr Word8
sptr
  where
    !lo :: Addr#
lo = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 :: Addr#
hi = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 :: Ptr Word8 -> Ptr Word8 -> IO ()
go !Ptr Word8
dst !Ptr Word8
src
      | Ptr Word8
src forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = do
        !Word8
x <- forall a. Storable a => Ptr a -> IO a
peek @Word8 Ptr Word8
src
        !Word8
y <- forall a. Storable a => Ptr a -> IO a
peek @Word8 (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)

        let !a :: Word8
a = Word8 -> Addr# -> Word8
aix Word8
x Addr#
hi
            !b :: Word8
b = Word8 -> Addr# -> Word8
aix Word8
y Addr#
lo

        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst (Word8
a forall a. Bits a => a -> a -> a
.|. Word8
b)
        Ptr Word8 -> Ptr Word8 -> IO ()
go (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
{-# INLINE decodeLoopTyped #-}


-- | Lenient lazy hex decoding loop optimized for 16-bit architectures.
-- When the 'Right' case is returned, a byte
--
lenientLoop
  :: ForeignPtr Word8
  -> Ptr Word8
  -> Ptr Word8
  -> Ptr Word8
  -> Int
  -> IO ByteString
lenientLoop :: ForeignPtr Word8
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
lenientLoop !ForeignPtr Word8
dfp !Ptr Word8
dptr !Ptr Word8
sptr !Ptr Word8
end !Int
nn = Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
goHi Ptr Word8
dptr Ptr Word8
sptr Int
nn
  where
    !lo :: Addr#
lo = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 :: Addr#
hi = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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 :: Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
goHi !Ptr Word8
dst !Ptr Word8
src !Int
n
      | Ptr Word8
src forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 Int
n)
      | Bool
otherwise = do
        !Word8
x <- forall a. Storable a => Ptr a -> IO a
peek @Word8 Ptr Word8
src

        let !a :: Word8
a = Word8 -> Addr# -> Word8
aix Word8
x Addr#
hi

        if Word8
a forall a. Eq a => a -> a -> Bool
== Word8
0xff
        then Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
goHi Ptr Word8
dst (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1) Int
n
        else Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ByteString
goLo Ptr Word8
dst (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1) Word8
a Int
n

    goLo :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ByteString
goLo !Ptr Word8
dst !Ptr Word8
src !Word8
a !Int
n
      | Ptr Word8
src forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 Int
n)
      | Bool
otherwise = do
        !Word8
y <- forall a. Storable a => Ptr a -> IO a
peek @Word8 Ptr Word8
src

        let !b :: Word8
b = Word8 -> Addr# -> Word8
aix Word8
y Addr#
lo

        if Word8
b forall a. Eq a => a -> a -> Bool
== Word8
0xff
        then Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ByteString
goLo Ptr Word8
dst (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1) Word8
a Int
n
        else do
          forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst (Word8
a forall a. Bits a => a -> a -> a
.|. Word8
b)
          Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
goHi (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1) (Int
n forall a. Num a => a -> a -> a
+ Int
1)
{-# LANGUAGE lenientLoop #-}