{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE MagicHash,
TypeFamilies,
UnboxedTuples,
StandaloneKindSignatures #-}
module Parsley.Internal.Backend.Machine.InputRep (
Rep, RepKind,
intSame, intLess, min#, max#,
OffWith, offWith, offWithSame, offWithShiftRight,
UnpackedLazyByteString, emptyUnpackedLazyByteString,
dropStream,
offsetText,
textShiftRight, textShiftLeft,
byteStringShiftRight, byteStringShiftLeft,
module Parsley.Internal.Core.InputTypes
) where
import Data.Array.Unboxed (UArray)
import Data.ByteString.Internal (ByteString(..))
import Data.Kind (Type)
import Data.Text.Internal (Text(..))
import Data.Text.Unsafe (iter_, reverseIter_)
import GHC.Exts (Int(..), TYPE, RuntimeRep(..), (==#), (<#), (+#), (-#), isTrue#)
import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents)
import GHC.Prim (Int#, Addr#, nullAddr#)
import Parsley.Internal.Common.Utils (Code)
import Parsley.Internal.Core.InputTypes (Text16(..), CharList(..), Stream(..))
import qualified Data.ByteString.Lazy.Internal as Lazy (ByteString(..))
type OffWith ts = (# Int#, ts #)
type UnpackedLazyByteString = (#
Int#,
Addr#,
ForeignPtrContents,
Int#,
Int#,
Lazy.ByteString
#)
offWith :: Code ts -> Code (OffWith ts)
offWith :: Code ts -> Code (OffWith ts)
offWith Code ts
qts = [||(# 0#, $$qts #)||]
emptyUnpackedLazyByteString :: Code Int# -> Code UnpackedLazyByteString
emptyUnpackedLazyByteString :: Code Int# -> Code UnpackedLazyByteString
emptyUnpackedLazyByteString Code Int#
qi# = [|| (# $$(qi#), nullAddr#, error "nullForeignPtr", 0#, 0#, Lazy.Empty #) ||]
type RepKind :: Type -> RuntimeRep
type family RepKind input where
RepKind [Char] = IntRep
RepKind (UArray Int Char) = IntRep
RepKind Text16 = IntRep
RepKind ByteString = IntRep
RepKind Text = LiftedRep
RepKind Lazy.ByteString = 'TupleRep '[IntRep, AddrRep, LiftedRep, IntRep, IntRep, LiftedRep]
RepKind CharList = 'TupleRep '[IntRep, LiftedRep]
RepKind Stream = 'TupleRep '[IntRep, LiftedRep]
type Rep :: forall (rep :: Type) -> TYPE (RepKind rep)
type family Rep input where
Rep [Char] = Int#
Rep (UArray Int Char) = Int#
Rep Text16 = Int#
Rep ByteString = Int#
Rep Text = Text
Rep Lazy.ByteString = UnpackedLazyByteString
Rep CharList = (# Int#, String #)
Rep Stream = (# Int#, Stream #)
intSame :: Code Int# -> Code Int# -> Code Bool
intSame :: Code Int# -> Code Int# -> Code Bool
intSame Code Int#
qi# Code Int#
qj# = [||isTrue# ($$(qi#) ==# $$(qj#))||]
intLess :: Code Int# -> Code Int# -> Code Bool
intLess :: Code Int# -> Code Int# -> Code Bool
intLess Code Int#
qi# Code Int#
qj# = [||isTrue# ($$(qi#) <# $$(qj#))||]
offsetText :: Code Text -> Code Int
offsetText :: Code Text -> Code Int
offsetText Code Text
qt = [||case $$qt of Text _ off _ -> off||]
offWithSame :: Code (OffWith ts) -> Code (OffWith ts) -> Code Bool
offWithSame :: Code (OffWith ts) -> Code (OffWith ts) -> Code Bool
offWithSame Code (OffWith ts)
qi# Code (OffWith ts)
qj# = [||
case $$(qi#) of
(# i#, _ #) -> case $$(qj#) of
(# j#, _ #) -> $$(intSame [||i#||] [||j#||])
||]
offWithShiftRight :: Code (Int -> ts -> ts)
-> Code (OffWith ts)
-> Code Int#
-> Code (OffWith ts)
offWithShiftRight :: Code (Int -> ts -> ts)
-> Code (OffWith ts) -> Code Int# -> Code (OffWith ts)
offWithShiftRight Code (Int -> ts -> ts)
drop Code (OffWith ts)
qo# Code Int#
qi# = [||
case $$(qo#) of (# o#, ts #) -> (# o# +# $$(qi#), $$drop (I# $$(qi#)) ts #)
||]
dropStream :: Int -> Stream -> Stream
dropStream :: Int -> Stream -> Stream
dropStream Int
0 Stream
cs = Stream
cs
dropStream Int
n (Char
_ :> Stream
cs) = Int -> Stream -> Stream
dropStream (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Stream
cs
textShiftRight :: Text -> Int -> Text
textShiftRight :: Text -> Int -> Text
textShiftRight (Text Array
arr Int
off Int
unconsumed) Int
i = Int -> Int -> Int -> Text
go Int
i Int
off Int
unconsumed
where
go :: Int -> Int -> Int -> Text
go Int
0 Int
off' Int
unconsumed' = Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed'
go Int
n Int
off' Int
unconsumed'
| Int
unconsumed' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = let !d :: Int
d = Text -> Int -> Int
iter_ (Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed') Int
0
in Int -> Int -> Int -> Text
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
off'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
unconsumed'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d)
| Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed'
textShiftLeft :: Text -> Int -> Text
textShiftLeft :: Text -> Int -> Text
textShiftLeft (Text Array
arr Int
off Int
unconsumed) Int
i = Int -> Int -> Int -> Text
go Int
i Int
off Int
unconsumed
where
go :: Int -> Int -> Int -> Text
go Int
0 Int
off' Int
unconsumed' = Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed'
go Int
n Int
off' Int
unconsumed'
| Int
off' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = let !d :: Int
d = Text -> Int -> Int
reverseIter_ (Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed') Int
0 in Int -> Int -> Int -> Text
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
off'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
unconsumed'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d)
| Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed'
{-# INLINE emptyUnpackedLazyByteString' #-}
emptyUnpackedLazyByteString' :: Int# -> UnpackedLazyByteString
emptyUnpackedLazyByteString' :: Int# -> UnpackedLazyByteString
emptyUnpackedLazyByteString' Int#
i# = (# Int#
i#, Addr#
nullAddr#, [Char] -> ForeignPtrContents
forall a. HasCallStack => [Char] -> a
error [Char]
"nullForeignPtr", Int#
0#, Int#
0#, ByteString
Lazy.Empty #)
byteStringShiftRight :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftRight :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftRight (# Int#
i#, Addr#
addr#, ForeignPtrContents
final, Int#
off#, Int#
size#, ByteString
cs #) Int#
j#
| Int# -> Bool
isTrue# (Int#
j# Int# -> Int# -> Int#
<# Int#
size#) = (# Int#
i# Int# -> Int# -> Int#
+# Int#
j#, Addr#
addr#, ForeignPtrContents
final, Int#
off# Int# -> Int# -> Int#
+# Int#
j#, Int#
size# Int# -> Int# -> Int#
-# Int#
j#, ByteString
cs #)
| Bool
otherwise = case ByteString
cs of
Lazy.Chunk (PS (ForeignPtr Addr#
addr'# ForeignPtrContents
final') (I# Int#
off'#) (I# Int#
size'#)) ByteString
cs' -> UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftRight (# Int#
i# Int# -> Int# -> Int#
+# Int#
size#, Addr#
addr'#, ForeignPtrContents
final', Int#
off'#, Int#
size'#, ByteString
cs' #) (Int#
j# Int# -> Int# -> Int#
-# Int#
size#)
ByteString
Lazy.Empty -> Int# -> UnpackedLazyByteString
emptyUnpackedLazyByteString' (Int#
i# Int# -> Int# -> Int#
+# Int#
size#)
byteStringShiftLeft :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftLeft :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftLeft (# Int#
i#, Addr#
addr#, ForeignPtrContents
final, Int#
off#, Int#
size#, ByteString
cs #) Int#
j# =
let d# :: Int#
d# = Int# -> Int# -> Int#
min# Int#
off# Int#
j#
in (# Int#
i# Int# -> Int# -> Int#
-# Int#
d#, Addr#
addr#, ForeignPtrContents
final, Int#
off# Int# -> Int# -> Int#
-# Int#
d#, Int#
size# Int# -> Int# -> Int#
+# Int#
d#, ByteString
cs #)
min# :: Int# -> Int# -> Int#
min# :: Int# -> Int# -> Int#
min# Int#
i# Int#
j# = case Int#
i# Int# -> Int# -> Int#
<# Int#
j# of
Int#
0# -> Int#
j#
Int#
_ -> Int#
i#
max# :: Int# -> Int# -> Int#
max# :: Int# -> Int# -> Int#
max# Int#
i# Int#
j# = case Int#
i# Int# -> Int# -> Int#
<# Int#
j# of
Int#
0# -> Int#
i#
Int#
_ -> Int#
j#