{-# language BangPatterns #-}
{-# language BinaryLiterals #-}
{-# language DataKinds #-}
{-# language DeriveFunctor #-}
{-# language DerivingStrategies #-}
{-# language GADTSyntax #-}
{-# language KindSignatures #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language MultiWayIf #-}
{-# language PolyKinds #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language TypeApplications #-}
{-# language UnboxedSums #-}
{-# language UnboxedTuples #-}
module Data.Parser.Unsafe
(
Parser(..)
, unconsume
) where
import GHC.Exts (Int(I#),Int#)
import Data.Bytes.Parser (Result(..),Slice(..))
import Data.Kind (Type)
import Data.Primitive.SmallArray (SmallArray(SmallArray))
import GHC.Exts (TYPE,State#,SmallArray#)
import qualified Control.Monad
type SmallVector# a = (# SmallArray# a, Int#, Int# #)
type ST# s (a :: TYPE r) = State# s -> (# State# s, a #)
type Result# e (a :: TYPE r) =
(# e
| (# a, Int#, Int# #) #)
newtype Parser :: Type -> Type -> Type -> Type -> Type where
Parser :: { runParser :: SmallVector# a -> ST# s (Result# e b) }
-> Parser a e s b
instance Functor (Parser a e s) where
{-# inline fmap #-}
fmap f (Parser g) = Parser
(\x s0 -> case g x s0 of
(# s1, r #) -> case r of
(# e | #) -> (# s1, (# e | #) #)
(# | (# a, b, c #) #) -> (# s1, (# | (# f a, b, c #) #) #)
)
instance Applicative (Parser a e s) where
pure = pureParser
(<*>) = Control.Monad.ap
instance Monad (Parser a e s) where
{-# inline return #-}
{-# inline (>>=) #-}
return = pureParser
Parser f >>= g = Parser
(\x@(# arr, _, _ #) s0 -> case f x s0 of
(# s1, r0 #) -> case r0 of
(# e | #) -> (# s1, (# e | #) #)
(# | (# y, b, c #) #) ->
runParser (g y) (# arr, b, c #) s1
)
pureParser :: b -> Parser a e s b
pureParser a = Parser
(\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))
unconsume :: Int -> Parser a e s ()
unconsume n = uneffectful $ \_ off len ->
Success (Slice (off - n) (len + n) ())
uneffectful ::
(SmallArray a -> Int -> Int -> Result e b)
-> Parser a e s b
{-# inline uneffectful #-}
uneffectful f = Parser
( \(# arr,off,len #) s0 -> (# s0, unboxResult (f (SmallArray arr) (I# off) (I# len)) #) )
unboxResult :: Result e a -> (# e | (# a, Int#, Int# #) #)
unboxResult (Success (Slice (I# b) (I# c) a)) = (# | (# a, b, c #) #)
unboxResult (Failure e) = (# e | #)