{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Data.ByteString.Base32.Internal.Tail
( loopTail
, loopTailNoPad
) where


import Data.Bits
import Data.ByteString.Internal
import Data.ByteString.Base32.Internal.Utils

import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable

import GHC.Exts
import GHC.Word


-- | Unroll final quantum encoding for base32
--
loopTail
    :: Addr#
    -> ForeignPtr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> IO ByteString
loopTail :: Addr#
-> ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO ByteString
loopTail !Addr#
lut !ForeignPtr Word8
dfp !Ptr Word8
dptr !Ptr Word8
end !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 (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))
    | forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1 forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = do -- 2 6
      !Word8
a <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src

      let !t :: Word8
t = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0xf8) Int
3)
          !u :: Word8
u = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0x07) Int
2)

      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst Word8
t
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) Word8
u
      Ptr Word8 -> Int -> IO ()
padN (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) Int
6

      forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
8 forall a. Num a => a -> a -> a
+ forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))
    | forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2 forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = do -- 4 4
      !Word8
a <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
      !Word8
b <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)

      let !t :: Word8
t = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0xf8) Int
3)
          !u :: Word8
u = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0x07) Int
2) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0xc0) Int
6))
          !v :: Word8
v = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x3e) Int
1)
          !w :: Word8
w = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x01) Int
4)

      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst Word8
t
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) Word8
u
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) Word8
v
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) Word8
w
      Ptr Word8 -> Int -> IO ()
padN (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
4) Int
4

      forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
8 forall a. Num a => a -> a -> a
+ forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))
    | forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3 forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = do -- 5 3
      !Word8
a <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
      !Word8
b <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
      !Word8
c <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)

      let !t :: Word8
t = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0xf8) Int
3)
          !u :: Word8
u = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0x07) Int
2) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0xc0) Int
6))
          !v :: Word8
v = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x3e) Int
1)
          !w :: Word8
w = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x01) Int
4) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
c forall a. Bits a => a -> a -> a
.&. Word8
0xf0) Int
4))
          !x :: Word8
x = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
c forall a. Bits a => a -> a -> a
.&. Word8
0x0f) Int
1)

      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst Word8
t
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) Word8
u
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) Word8
v
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) Word8
w
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
4) Word8
x
      Ptr Word8 -> Int -> IO ()
padN (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
5) Int
3
      forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
8 forall a. Num a => a -> a -> a
+ forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))

    | Bool
otherwise = do -- 7 1
      !Word8
a <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
      !Word8
b <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
      !Word8
c <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
      !Word8
d <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)

      let !t :: Word8
t = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0xf8) Int
3)
          !u :: Word8
u = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0x07) Int
2) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0xc0) Int
6))
          !v :: Word8
v = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x3e) Int
1)
          !w :: Word8
w = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x01) Int
4) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
c forall a. Bits a => a -> a -> a
.&. Word8
0xf0) Int
4))
          !x :: Word8
x = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
c forall a. Bits a => a -> a -> a
.&. Word8
0x0f) Int
1) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
d forall a. Bits a => a -> a -> a
.&. Word8
0x80) Int
7))
          !y :: Word8
y = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
d forall a. Bits a => a -> a -> a
.&. Word8
0x7c) Int
2)
          !z :: Word8
z = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
d forall a. Bits a => a -> a -> a
.&. Word8
0x03) Int
3)

      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst Word8
t
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) Word8
u
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) Word8
v
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) Word8
w
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
4) Word8
x
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
5) Word8
y
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
6) Word8
z
      Ptr Word8 -> Int -> IO ()
padN (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
7) Int
1
      forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
8 forall a. Num a => a -> a -> a
+ forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))
  where
    look :: Word8 -> Word8
look !Word8
n = Word8 -> Addr# -> Word8
aix Word8
n Addr#
lut

    padN :: Ptr Word8 -> Int -> IO ()
    padN :: Ptr Word8 -> Int -> IO ()
padN !Ptr Word8
_ Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    padN !Ptr Word8
p Int
n = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p Word8
0x3d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> Int -> IO ()
padN (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1) (Int
n forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE loopTail #-}

-- | Unroll final quantum encoding for base32
--
loopTailNoPad
    :: Addr#
    -> ForeignPtr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> IO ByteString
loopTailNoPad :: Addr#
-> ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO ByteString
loopTailNoPad !Addr#
lut !ForeignPtr Word8
dfp !Ptr Word8
dptr !Ptr Word8
end !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 (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))
  | forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1 forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = do -- 2 6
      !Word8
a <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src

      let !t :: Word8
t = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0xf8) Int
3)
          !u :: Word8
u = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0x07) Int
2)

      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst Word8
t
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) Word8
u

      forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
2 forall a. Num a => a -> a -> a
+ forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))

    | forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2 forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = do -- 4 4
      !Word8
a <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
      !Word8
b <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)

      let !t :: Word8
t = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0xf8) Int
3)
          !u :: Word8
u = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0x07) Int
2) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0xc0) Int
6))
          !v :: Word8
v = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x3e) Int
1)
          !w :: Word8
w = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x01) Int
4)

      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst Word8
t
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) Word8
u
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) Word8
v
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) Word8
w

      forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
4 forall a. Num a => a -> a -> a
+ forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))

    | forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3 forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = do -- 5 3
      !Word8
a <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
      !Word8
b <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
      !Word8
c <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)

      let !t :: Word8
t = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0xf8) Int
3)
          !u :: Word8
u = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0x07) Int
2) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0xc0) Int
6))
          !v :: Word8
v = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x3e) Int
1)
          !w :: Word8
w = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x01) Int
4) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
c forall a. Bits a => a -> a -> a
.&. Word8
0xf0) Int
4))
          !x :: Word8
x = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
c forall a. Bits a => a -> a -> a
.&. Word8
0x0f) Int
1)

      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst Word8
t
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) Word8
u
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) Word8
v
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) Word8
w
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
4) Word8
x
      forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
5 forall a. Num a => a -> a -> a
+ forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))

    | Bool
otherwise = do -- 7 1
      !Word8
a <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
      !Word8
b <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
      !Word8
c <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
      !Word8
d <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)

      let !t :: Word8
t = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0xf8) Int
3)
          !u :: Word8
u = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
a forall a. Bits a => a -> a -> a
.&. Word8
0x07) Int
2) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0xc0) Int
6))
          !v :: Word8
v = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x3e) Int
1)
          !w :: Word8
w = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x01) Int
4) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
c forall a. Bits a => a -> a -> a
.&. Word8
0xf0) Int
4))
          !x :: Word8
x = Word8 -> Word8
look ((forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
c forall a. Bits a => a -> a -> a
.&. Word8
0x0f) Int
1) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
d forall a. Bits a => a -> a -> a
.&. Word8
0x80) Int
7))
          !y :: Word8
y = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
d forall a. Bits a => a -> a -> a
.&. Word8
0x7c) Int
2)
          !z :: Word8
z = Word8 -> Word8
look (forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8
d forall a. Bits a => a -> a -> a
.&. Word8
0x03) Int
3)

      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst Word8
t
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) Word8
u
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) Word8
v
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) Word8
w
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
4) Word8
x
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
5) Word8
y
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
6) Word8
z
      forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
7 forall a. Num a => a -> a -> a
+ forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
dst Ptr Word8
dptr))
  where
    look :: Word8 -> Word8
look !Word8
i = Word8 -> Addr# -> Word8
aix Word8
i Addr#
lut
{-# INLINE loopTailNoPad #-}