module FlatParse.Basic.Bytes
( bytes, bytesUnsafe
) where
import FlatParse.Basic.Parser
import FlatParse.Basic.Base ( withEnsure )
import FlatParse.Basic.Integers ( word8Unsafe, word16Unsafe, word32Unsafe, word64Unsafe )
import qualified FlatParse.Common.Assorted as Common
import Language.Haskell.TH
import GHC.Exts
import GHC.Word
bytes :: [Word] -> Q Exp
bytes :: [Word] -> Q Exp
bytes [Word]
bs = do
let !len :: Int
len = [Word] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
bs
[| withEnsure len $([Word] -> Q Exp
bytesUnsafe [Word]
bs) |]
bytesUnsafe :: [Word] -> Q Exp
bytesUnsafe :: [Word] -> Q Exp
bytesUnsafe [Word]
bytes = do
let !([Word64]
leading, [Word64]
w8s) = [Word64] -> ([Word64], [Word64])
Common.splitBytes ([Word64] -> ([Word64], [Word64]))
-> [Word64] -> ([Word64], [Word64])
forall a b. (a -> b) -> a -> b
$ (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word -> Word64) (Word -> Word64) -> [Word] -> [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word]
bytes
!scanw8s :: Q Exp
scanw8s = [Word64] -> Q Exp
forall {t} {m :: * -> *}. (Lift t, Quote m) => [t] -> m Exp
go [Word64]
w8s where
go :: [t] -> m Exp
go (t
w8:[] ) = [| word64Unsafe w8 |]
go (t
w8:[t]
w8s) = [| word64Unsafe w8 >> $([t] -> m Exp
go [t]
w8s) |]
go [] = [| pure () |]
case [Word64]
w8s of
[] -> [Word64] -> Q Exp
forall {m :: * -> *}. Quote m => [Word64] -> m Exp
go [Word64]
leading
where
go :: [Word64] -> m Exp
go (Word64
a:Word64
b:Word64
c:Word64
d:[]) = let !w :: Word64
w = [Word64] -> Word64
Common.packBytes [Word64
a, Word64
b, Word64
c, Word64
d] in [| word32Unsafe w |]
go (Word64
a:Word64
b:Word64
c:Word64
d:[Word64]
ws) = let !w :: Word64
w = [Word64] -> Word64
Common.packBytes [Word64
a, Word64
b, Word64
c, Word64
d] in [| word32Unsafe w >> $([Word64] -> m Exp
go [Word64]
ws) |]
go (Word64
a:Word64
b:[]) = let !w :: Word64
w = [Word64] -> Word64
Common.packBytes [Word64
a, Word64
b] in [| word16Unsafe w |]
go (Word64
a:Word64
b:[Word64]
ws) = let !w :: Word64
w = [Word64] -> Word64
Common.packBytes [Word64
a, Word64
b] in [| word16Unsafe w >> $([Word64] -> m Exp
go [Word64]
ws) |]
go (Word64
a:[]) = [| word8Unsafe a |]
go [] = [| pure () |]
[Word64]
_ -> case [Word64]
leading of
[] -> Q Exp
scanw8s
[Word64
a] -> [| word8Unsafe a >> $Q Exp
scanw8s |]
ws :: [Word64]
ws@[Word64
a, Word64
b] -> let !w :: Word64
w = [Word64] -> Word64
Common.packBytes [Word64]
ws in [| word16Unsafe w >> $Q Exp
scanw8s |]
ws :: [Word64]
ws@[Word64
a, Word64
b, Word64
c, Word64
d] -> let !w :: Word64
w = [Word64] -> Word64
Common.packBytes [Word64]
ws in [| word32Unsafe w >> $Q Exp
scanw8s |]
[Word64]
ws -> let !w :: Word64
w = [Word64] -> Word64
Common.packBytes [Word64]
ws
!l :: Int
l = [Word64] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word64]
ws
in [| scanPartial64# l w >> $Q Exp
scanw8s |]
scanPartial64# :: Int -> Word64 -> ParserT st e ()
scanPartial64# :: forall (st :: ZeroBitType) e. Int -> Word64 -> ParserT st e ()
scanPartial64# (I# Int#
len) (W64# Word64#
w) = (ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e ())
-> ParserT st e ()
forall (st :: ZeroBitType) e a.
(ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a)
-> ParserT st e a
ParserT \ForeignPtrContents
fp Addr#
eob Addr#
s st
st ->
case Addr# -> Int# -> Word64#
indexWord64OffAddr# Addr#
s Int#
0# of
Word64#
w' -> case Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
8# Int# -> Int# -> Int#
-# Int#
len) Int#
3# of
Int#
sh -> case Word64# -> Int# -> Word64#
uncheckedShiftL64# Word64#
w' Int#
sh of
Word64#
w' -> case Word64# -> Int# -> Word64#
uncheckedShiftRL64# Word64#
w' Int#
sh of
#if MIN_VERSION_base(4,17,0)
Word64#
w' -> case Word64# -> Word64# -> Int#
eqWord64# Word64#
w Word64#
w' of
#else
w' -> case eqWord# w w' of
#endif
Int#
1# -> st -> () -> Addr# -> Res# st e ()
forall (st :: ZeroBitType) a e. st -> a -> Addr# -> Res# st e a
OK# st
st () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
len)
Int#
_ -> st -> Res# st e ()
forall (st :: ZeroBitType) e a. st -> Res# st e a
Fail# st
st