{-# language UnboxedTuples #-}
module FlatParse.Basic (
type Parser(..)
, type Res#
, pattern OK#
, pattern Fail#
, pattern Err#
, Result(..)
, runParser
, runParserS
, empty
, err
, lookahead
, fails
, try
, optional
, optional_
, optioned
, cut
, cutting
, eof
, char
, byte
, bytes
, string
, switch
, switchWithPost
, rawSwitchWithPost
, satisfy
, satisfy_
, satisfyASCII
, satisfyASCII_
, fusedSatisfy
, fusedSatisfy_
, anyWord8
, anyWord8_
, anyWord16
, anyWord16_
, anyWord32
, anyWord32_
, anyWord
, anyWord_
, anyChar
, anyChar_
, anyCharASCII
, anyCharASCII_
, FlatParse.Internal.isDigit
, FlatParse.Internal.isGreekLetter
, FlatParse.Internal.isLatinLetter
, FlatParse.Basic.readInt
, FlatParse.Basic.readInteger
, (<|>)
, branch
, chainl
, chainr
, many
, many_
, some
, some_
, notFollowedBy
, Pos(..)
, Span(..)
, getPos
, setPos
, endPos
, spanOf
, spanned
, byteStringOf
, byteStringed
, inSpan
, validPos
, posLineCols
, unsafeSpanToByteString
, unsafeSlice
, mkPos
, FlatParse.Basic.lines
, takeLine
, traceLine
, takeRest
, traceRest
, packUTF8
, unpackUTF8
, ensureBytes#
, scan8#
, scan16#
, scan32#
, scan64#
, scanAny8#
, scanBytes#
, setBack#
) where
import Control.Monad
import Data.Foldable
import Data.List (sortBy)
import Data.Map (Map)
import Data.Ord (comparing)
import Data.Word
import GHC.Exts
import GHC.Word
import GHC.ForeignPtr
import Language.Haskell.TH
import System.IO.Unsafe
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Internal as B
import qualified Data.Map.Strict as M
import FlatParse.Internal
type Res# e a =
(#
(# a, Addr# #)
| (# #)
| (# e #)
#)
pattern OK# :: a -> Addr# -> Res# e a
pattern $bOK# :: a -> Addr# -> Res# e a
$mOK# :: forall r a e. Res# e a -> (a -> Addr# -> r) -> (Void# -> r) -> r
OK# a s = (# (# a, s #) | | #)
pattern Err# :: e -> Res# e a
pattern $bErr# :: e -> Res# e a
$mErr# :: forall r e a. Res# e a -> (e -> r) -> (Void# -> r) -> r
Err# e = (# | | (# e #) #)
pattern Fail# :: Res# e a
pattern $bFail# :: Void# -> forall e a. Res# e a
$mFail# :: forall r e a. Res# e a -> (Void# -> r) -> (Void# -> r) -> r
Fail# = (# | (# #) | #)
{-# complete OK#, Err#, Fail# #-}
newtype Parser e a = Parser {Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# :: ForeignPtrContents -> Addr# -> Addr# -> Res# e a}
instance Functor (Parser e) where
fmap :: (a -> b) -> Parser e a -> Parser e b
fmap a -> b
f (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
g) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
g ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s -> let !b :: b
b = a -> b
f a
a in b -> Addr# -> Res# e b
forall a e. a -> Addr# -> Res# e a
OK# b
b Addr#
s
Res# e a
x -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
{-# inline fmap #-}
<$ :: a -> Parser e b -> Parser e a
(<$) a
a' (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
g) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e b
g ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# b
a Addr#
s -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a' Addr#
s
Res# e b
x -> Res# e b -> Res# e a
unsafeCoerce# Res# e b
x
{-# inline (<$) #-}
instance Applicative (Parser e) where
pure :: a -> Parser e a
pure a
a = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a Addr#
s
{-# inline pure #-}
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e (a -> b)
ff <*> :: Parser e (a -> b) -> Parser e a -> Parser e b
<*> Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e (a -> b)
ff ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a -> b
f Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s -> let !b :: b
b = a -> b
f a
a in b -> Addr# -> Res# e b
forall a e. a -> Addr# -> Res# e a
OK# b
b Addr#
s
Res# e a
x -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
Res# e (a -> b)
x -> Res# e (a -> b) -> Res# e b
unsafeCoerce# Res# e (a -> b)
x
{-# inline (<*>) #-}
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa <* :: Parser e a -> Parser e b -> Parser e a
<* Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
fb = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e b
fb ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# b
b Addr#
s -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a Addr#
s
Res# e b
x -> Res# e b -> Res# e a
unsafeCoerce# Res# e b
x
Res# e a
x -> Res# e a -> Res# e a
unsafeCoerce# Res# e a
x
{-# inline (<*) #-}
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa *> :: Parser e a -> Parser e b -> Parser e b
*> Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
fb = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
fb ForeignPtrContents
fp Addr#
eob Addr#
s
Res# e a
x -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
{-# inline (*>) #-}
instance Monad (Parser e) where
return :: a -> Parser e a
return = a -> Parser e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# inline return #-}
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa >>= :: Parser e a -> (a -> Parser e b) -> Parser e b
>>= a -> Parser e b
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (a -> Parser e b
f a
a) ForeignPtrContents
fp Addr#
eob Addr#
s
Res# e a
x -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
{-# inline (>>=) #-}
>> :: Parser e a -> Parser e b -> Parser e b
(>>) = Parser e a -> Parser e b -> Parser e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
{-# inline (>>) #-}
data Result e a =
OK a !(B.ByteString)
| Fail
| Err !e
deriving Int -> Result e a -> ShowS
[Result e a] -> ShowS
Result e a -> String
(Int -> Result e a -> ShowS)
-> (Result e a -> String)
-> ([Result e a] -> ShowS)
-> Show (Result e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show a, Show e) => Int -> Result e a -> ShowS
forall e a. (Show a, Show e) => [Result e a] -> ShowS
forall e a. (Show a, Show e) => Result e a -> String
showList :: [Result e a] -> ShowS
$cshowList :: forall e a. (Show a, Show e) => [Result e a] -> ShowS
show :: Result e a -> String
$cshow :: forall e a. (Show a, Show e) => Result e a -> String
showsPrec :: Int -> Result e a -> ShowS
$cshowsPrec :: forall e a. (Show a, Show e) => Int -> Result e a -> ShowS
Show
instance Functor (Result e) where
fmap :: (a -> b) -> Result e a -> Result e b
fmap a -> b
f (OK a
a ByteString
s) = let !b :: b
b = a -> b
f a
a in b -> ByteString -> Result e b
forall e a. a -> ByteString -> Result e a
OK b
b ByteString
s
fmap a -> b
f Result e a
r = Result e a -> Result e b
unsafeCoerce# Result e a
r
{-# inline fmap #-}
<$ :: a -> Result e b -> Result e a
(<$) a
a (OK b
_ ByteString
s) = a -> ByteString -> Result e a
forall e a. a -> ByteString -> Result e a
OK a
a ByteString
s
(<$) a
_ Result e b
r = Result e b -> Result e a
unsafeCoerce# Result e b
r
{-# inline (<$) #-}
runParser :: Parser e a -> B.ByteString -> Result e a
runParser :: Parser e a -> ByteString -> Result e a
runParser (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) b :: ByteString
b@(B.PS (ForeignPtr Addr#
_ ForeignPtrContents
fp) Int
_ (I# Int#
len)) = IO (Result e a) -> Result e a
forall a. IO a -> a
unsafeDupablePerformIO do
ByteString -> (CString -> IO (Result e a)) -> IO (Result e a)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
b \(Ptr Addr#
buf) -> do
let end :: Addr#
end = Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
len
case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
end Addr#
buf of
Err# e
e ->
Result e a -> IO (Result e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Result e a
forall e a. e -> Result e a
Err e
e)
OK# a
a Addr#
s -> do
let offset :: Int#
offset = Addr# -> Addr# -> Int#
minusAddr# Addr#
s Addr#
buf
Result e a -> IO (Result e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ByteString -> Result e a
forall e a. a -> ByteString -> Result e a
OK a
a (Int -> ByteString -> ByteString
B.drop (Int# -> Int
I# Int#
offset) ByteString
b))
Res# e a
Fail# ->
Result e a -> IO (Result e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result e a
forall e a. Result e a
Fail
{-# inlinable runParser #-}
runParserS :: Parser e a -> String -> Result e a
runParserS :: Parser e a -> String -> Result e a
runParserS Parser e a
pa String
s = Parser e a -> ByteString -> Result e a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser e a
pa (String -> ByteString
packUTF8 String
s)
empty :: Parser e a
empty :: Parser e a
empty = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> Res# e a
forall e a. Res# e a
Fail#
{-# inline empty #-}
err :: e -> Parser e a
err :: e -> Parser e a
err e
e = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> e -> Res# e a
forall e a. e -> Res# e a
Err# e
e
{-# inline err #-}
lookahead :: Parser e a -> Parser e a
lookahead :: Parser e a -> Parser e a
lookahead (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
_ -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a Addr#
s
Res# e a
x -> Res# e a
x
{-# inline lookahead #-}
fails :: Parser e a -> Parser e ()
fails :: Parser e a -> Parser e ()
fails (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
_ Addr#
_ -> Res# e ()
forall e a. Res# e a
Fail#
Res# e a
Fail# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
Err# e
e -> e -> Res# e ()
forall e a. e -> Res# e a
Err# e
e
{-# inline fails #-}
try :: Parser e a -> Parser e a
try :: Parser e a -> Parser e a
try (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
Err# e
_ -> Res# e a
forall e a. Res# e a
Fail#
Res# e a
x -> Res# e a
x
{-# inline try #-}
optional :: Parser e a -> Parser e (Maybe a)
optional :: Parser e a -> Parser e (Maybe a)
optional Parser e a
p = (a -> Maybe a
forall k1. k1 -> Maybe k1
Just (a -> Maybe a) -> Parser e a -> Parser e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e a
p) Parser e (Maybe a) -> Parser e (Maybe a) -> Parser e (Maybe a)
forall e a. Parser e a -> Parser e a -> Parser e a
<|> Maybe a -> Parser e (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall k1. Maybe k1
Nothing
{-# inline optional #-}
optional_ :: Parser e a -> Parser e ()
optional_ :: Parser e a -> Parser e ()
optional_ Parser e a
p = (() () -> Parser e a -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e a
p) Parser e () -> Parser e () -> Parser e ()
forall e a. Parser e a -> Parser e a -> Parser e a
<|> () -> Parser e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# inline optional_ #-}
optioned :: Parser e a -> (a -> Parser e b) -> Parser e b -> Parser e b
optioned :: Parser e a -> (a -> Parser e b) -> Parser e b -> Parser e b
optioned (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) a -> Parser e b
just (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
nothing) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (a -> Parser e b
just a
a) ForeignPtrContents
fp Addr#
eob Addr#
s
Res# e a
Fail# -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
nothing ForeignPtrContents
fp Addr#
eob Addr#
s
Err# e
e -> e -> Res# e b
forall e a. e -> Res# e a
Err# e
e
{-# inline optioned #-}
cut :: Parser e a -> e -> Parser e a
cut :: Parser e a -> e -> Parser e a
cut (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) e
e = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
Res# e a
Fail# -> e -> Res# e a
forall e a. e -> Res# e a
Err# e
e
Res# e a
x -> Res# e a
x
{-# inline cut #-}
cutting :: Parser e a -> e -> (e -> e -> e) -> Parser e a
cutting :: Parser e a -> e -> (e -> e -> e) -> Parser e a
cutting (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) e
e e -> e -> e
merge = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
Res# e a
Fail# -> e -> Res# e a
forall e a. e -> Res# e a
Err# e
e
Err# e
e' -> let !e'' :: e
e'' = e -> e -> e
merge e
e' e
e in e -> Res# e a
forall e a. e -> Res# e a
Err# e
e''
Res# e a
x -> Res# e a
x
{-# inline cutting #-}
eof :: Parser e ()
eof :: Parser e ()
eof = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
s of
Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
Int#
_ -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline eof #-}
char :: Char -> Q Exp
char :: Char -> Q Exp
char Char
c = String -> Q Exp
string [Char
c]
byte :: Word -> Parser e ()
byte :: Word -> Parser e ()
byte (W# Word#
w) = Int -> Parser e ()
forall e. Int -> Parser e ()
ensureBytes# Int
1 Parser e () -> Parser e () -> Parser e ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> Parser e ()
forall e. Word -> Parser e ()
scan8# (Word# -> Word
W# Word#
w)
{-# inline byte #-}
bytes :: [Word] -> Q Exp
bytes :: [Word] -> Q Exp
bytes [Word]
bytes = do
let !len :: Int
len = [Word] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
bytes
[| ensureBytes# len >> $(scanBytes# bytes) |]
string :: String -> Q Exp
string :: String -> Q Exp
string String
str = [Word] -> Q Exp
bytes (String -> [Word]
strToBytes String
str)
switch :: Q Exp -> Q Exp
switch :: Q Exp -> Q Exp
switch = Maybe (Q Exp) -> Q Exp -> Q Exp
switchWithPost Maybe (Q Exp)
forall k1. Maybe k1
Nothing
switchWithPost :: Maybe (Q Exp) -> Q Exp -> Q Exp
switchWithPost :: Maybe (Q Exp) -> Q Exp -> Q Exp
switchWithPost Maybe (Q Exp)
postAction Q Exp
exp = do
!Maybe Exp
postAction <- Maybe (Q Exp) -> Q (Maybe Exp)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe (Q Exp)
postAction
(![(String, Exp)]
cases, !Maybe Exp
fallback) <- Q Exp -> Q ([(String, Exp)], Maybe Exp)
parseSwitch Q Exp
exp
(Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp
genTrie ((Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp)
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
-> Q Exp
forall a b. (a -> b) -> a -> b
$! Maybe Exp
-> [(String, Exp)]
-> Maybe Exp
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
genSwitchTrie' Maybe Exp
postAction [(String, Exp)]
cases Maybe Exp
fallback
rawSwitchWithPost :: Maybe (Q Exp) -> [(String, Q Exp)] -> Maybe (Q Exp) -> Q Exp
rawSwitchWithPost :: Maybe (Q Exp) -> [(String, Q Exp)] -> Maybe (Q Exp) -> Q Exp
rawSwitchWithPost Maybe (Q Exp)
postAction [(String, Q Exp)]
cases Maybe (Q Exp)
fallback = do
!Maybe Exp
postAction <- Maybe (Q Exp) -> Q (Maybe Exp)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe (Q Exp)
postAction
![(String, Exp)]
cases <- [(String, Q Exp)]
-> ((String, Q Exp) -> Q (String, Exp)) -> Q [(String, Exp)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, Q Exp)]
cases \(String
str, Q Exp
rhs) -> (String
str,) (Exp -> (String, Exp)) -> Q Exp -> Q (String, Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Exp
rhs
!Maybe Exp
fallback <- Maybe (Q Exp) -> Q (Maybe Exp)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe (Q Exp)
fallback
(Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp
genTrie ((Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp)
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
-> Q Exp
forall a b. (a -> b) -> a -> b
$! Maybe Exp
-> [(String, Exp)]
-> Maybe Exp
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
genSwitchTrie' Maybe Exp
postAction [(String, Exp)]
cases Maybe Exp
fallback
satisfy :: (Char -> Bool) -> Parser e Char
satisfy :: (Char -> Bool) -> Parser e Char
satisfy Char -> Bool
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Parser Any Char
-> ForeignPtrContents -> Addr# -> Addr# -> Res# Any Char
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser Any Char
forall e. Parser e Char
anyChar ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# Char
c Addr#
s | Char -> Bool
f Char
c -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# Char
c Addr#
s
Res# Any Char
_ -> Res# e Char
forall e a. Res# e a
Fail#
{-# inline satisfy #-}
satisfy_ :: (Char -> Bool) -> Parser e ()
satisfy_ :: (Char -> Bool) -> Parser e ()
satisfy_ Char -> Bool
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Parser Any Char
-> ForeignPtrContents -> Addr# -> Addr# -> Res# Any Char
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser Any Char
forall e. Parser e Char
anyChar ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# Char
c Addr#
s | Char -> Bool
f Char
c -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
Res# Any Char
_ -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline satisfy_ #-}
satisfyASCII :: (Char -> Bool) -> Parser e Char
satisfyASCII :: (Char -> Bool) -> Parser e Char
satisfyASCII Char -> Bool
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
s of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Char#
derefChar8# Addr#
s of
Char#
c1 | Char -> Bool
f (Char# -> Char
C# Char#
c1) -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# Char#
c1) (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#)
| Bool
otherwise -> Res# e Char
forall e a. Res# e a
Fail#
{-# inline satisfyASCII #-}
satisfyASCII_ :: (Char -> Bool) -> Parser e ()
satisfyASCII_ :: (Char -> Bool) -> Parser e ()
satisfyASCII_ Char -> Bool
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
s of
Int#
1# -> Res# e ()
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Char#
derefChar8# Addr#
s of
Char#
c1 | Char -> Bool
f (Char# -> Char
C# Char#
c1) -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#)
| Bool
otherwise -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline satisfyASCII_ #-}
fusedSatisfy :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser e Char
fusedSatisfy :: (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> Parser e Char
fusedSatisfy Char -> Bool
f1 Char -> Bool
f2 Char -> Bool
f3 Char -> Bool
f4 = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Char#
derefChar8# Addr#
buf of
Char#
c1 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\x7F'# of
Int#
1# | Char -> Bool
f1 (Char# -> Char
C# Char#
c1) -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# Char#
c1) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
| Bool
otherwise -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#) of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
1# of
Char#
c2 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xDF'# of
Int#
1# ->
let resc :: Char
resc = Char# -> Char
C# (Int# -> Char#
chr# (((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xC0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
`orI#`
(Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#)))
in case Char -> Bool
f2 Char
resc of
Bool
True -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# Char
resc (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#)
Bool
_ -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#) of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
2# of
Char#
c3 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xEF'# of
Int#
1# ->
let resc :: Char
resc = Char# -> Char
C# (Int# -> Char#
chr# (((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xE0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
((Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
`orI#`
(Char# -> Int#
ord# Char#
c3 Int# -> Int# -> Int#
-# Int#
0x80#)))
in case Char -> Bool
f3 Char
resc of
Bool
True -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# Char
resc (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#)
Bool
_ -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#) of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
3# of
Char#
c4 ->
let resc :: Char
resc = Char# -> Char
C# (Int# -> Char#
chr# (((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xF0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
18#) Int# -> Int# -> Int#
`orI#`
((Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
((Char# -> Int#
ord# Char#
c3 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
`orI#`
(Char# -> Int#
ord# Char#
c4 Int# -> Int# -> Int#
-# Int#
0x80#)))
in case Char -> Bool
f4 Char
resc of
Bool
True -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# Char
resc (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
4#)
Bool
_ -> Res# e Char
forall e a. Res# e a
Fail#
{-# inline fusedSatisfy #-}
fusedSatisfy_ :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser e ()
fusedSatisfy_ :: (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> Parser e ()
fusedSatisfy_ Char -> Bool
f1 Char -> Bool
f2 Char -> Bool
f3 Char -> Bool
f4 = () () -> Parser e Char -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> Parser e Char
forall e.
(Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> Parser e Char
fusedSatisfy Char -> Bool
f1 Char -> Bool
f2 Char -> Bool
f3 Char -> Bool
f4
{-# inline fusedSatisfy_ #-}
anyWord8 :: Parser e Word8
anyWord8 :: Parser e Word8
anyWord8 = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Word8)
-> Parser e Word8
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
Int#
1# -> Res# e Word8
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
buf Int#
0# of
Word#
w -> Word8 -> Addr# -> Res# e Word8
forall a e. a -> Addr# -> Res# e a
OK# (Word# -> Word8
W8# Word#
w) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
{-# inline anyWord8 #-}
anyWord8_ :: Parser e ()
anyWord8_ :: Parser e ()
anyWord8_ = () () -> Parser e Word8 -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Word8
forall e. Parser e Word8
anyWord8
{-# inline anyWord8_ #-}
anyWord16 :: Parser e Word
anyWord16 :: Parser e Word
anyWord16 = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Word)
-> Parser e Word
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Int#
2# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
buf of
Int#
0# -> Res# e Word
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Word#
indexWord16OffAddr Addr#
buf Int#
0# of
Word#
w -> Word -> Addr# -> Res# e Word
forall a e. a -> Addr# -> Res# e a
OK# (Word# -> Word
W# Word#
w) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#)
{-# inline anyWord16 #-}
anyWord16_ :: Parser e ()
anyWord16_ :: Parser e ()
anyWord16_ = () () -> Parser e Word -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Word
forall e. Parser e Word
anyWord16
{-# inline anyWord16_ #-}
anyWord32 :: Parser e Word
anyWord32 :: Parser e Word
anyWord32 = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Word)
-> Parser e Word
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Int#
4# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
buf of
Int#
0# -> Res# e Word
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Word#
indexWord32OffAddr Addr#
buf Int#
0# of
Word#
w -> Word -> Addr# -> Res# e Word
forall a e. a -> Addr# -> Res# e a
OK# (Word# -> Word
W# Word#
w) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
4#)
{-# inline anyWord32 #-}
anyWord32_ :: Parser e ()
anyWord32_ :: Parser e ()
anyWord32_ = () () -> Parser e Word -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Word
forall e. Parser e Word
anyWord32
{-# inline anyWord32_ #-}
anyWord :: Parser e Word
anyWord :: Parser e Word
anyWord = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Word)
-> Parser e Word
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Int#
8# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
buf of
Int#
0# -> Res# e Word
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Word#
indexWordOffAddr# Addr#
buf Int#
0# of
Word#
w -> Word -> Addr# -> Res# e Word
forall a e. a -> Addr# -> Res# e a
OK# (Word# -> Word
W# Word#
w) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
8#)
{-# inline anyWord #-}
anyWord_ :: Parser e ()
anyWord_ :: Parser e ()
anyWord_ = () () -> Parser e Word -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Word
forall e. Parser e Word
anyWord
{-# inline anyWord_ #-}
anyChar :: Parser e Char
anyChar :: Parser e Char
anyChar = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Char#
derefChar8# Addr#
buf of
Char#
c1 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\x7F'# of
Int#
1# -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# Char#
c1) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#) of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
1# of
Char#
c2 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xDF'# of
Int#
1# ->
let resc :: Int#
resc = ((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xC0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
`orI#`
(Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#)
in Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# (Int# -> Char#
chr# Int#
resc)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#)
Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#) of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
2# of
Char#
c3 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xEF'# of
Int#
1# ->
let resc :: Int#
resc = ((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xE0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
((Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
`orI#`
(Char# -> Int#
ord# Char#
c3 Int# -> Int# -> Int#
-# Int#
0x80#)
in Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# (Int# -> Char#
chr# Int#
resc)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#)
Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#) of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
3# of
Char#
c4 ->
let resc :: Int#
resc = ((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xF0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
18#) Int# -> Int# -> Int#
`orI#`
((Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
((Char# -> Int#
ord# Char#
c3 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
`orI#`
(Char# -> Int#
ord# Char#
c4 Int# -> Int# -> Int#
-# Int#
0x80#)
in Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# (Int# -> Char#
chr# Int#
resc)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
4#)
{-# inline anyChar #-}
anyChar_ :: Parser e ()
anyChar_ :: Parser e ()
anyChar_ = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
Int#
1# -> Res# e ()
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Char#
derefChar8# Addr#
buf of
Char#
c1 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\x7F'# of
Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
Int#
_ ->
let buf' :: Addr#
buf' =
case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xDF'# of
Int#
1# -> Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#
Int#
_ -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xEF'# of
Int#
1# -> Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#
Int#
_ -> Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
4#
in case Addr# -> Addr# -> Int#
leAddr# Addr#
buf' Addr#
eob of
Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
buf'
Int#
_ -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline anyChar_ #-}
anyCharASCII :: Parser e Char
anyCharASCII :: Parser e Char
anyCharASCII = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
Int#
_ -> case Addr# -> Char#
derefChar8# Addr#
buf of
Char#
c1 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\x7F'# of
Int#
1# -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# Char#
c1) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
Int#
_ -> Res# e Char
forall e a. Res# e a
Fail#
{-# inline anyCharASCII #-}
anyCharASCII_ :: Parser e ()
anyCharASCII_ :: Parser e ()
anyCharASCII_ = () () -> Parser e Char -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Char
forall e. Parser e Char
anyCharASCII
{-# inline anyCharASCII_ #-}
readInt :: Parser e Int
readInt :: Parser e Int
readInt = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Int)
-> Parser e Int
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Addr# -> Addr# -> (# (# #) | (# Int#, Addr# #) #)
FlatParse.Internal.readInt Addr#
eob Addr#
s of
(# (##) | #) -> Res# e Int
forall e a. Res# e a
Fail#
(# | (# Int#
n, Addr#
s' #) #) -> Int -> Addr# -> Res# e Int
forall a e. a -> Addr# -> Res# e a
OK# (Int# -> Int
I# Int#
n) Addr#
s'
{-# inline readInt #-}
readInteger :: Parser e Integer
readInteger :: Parser e Integer
readInteger = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Integer)
-> Parser e Integer
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents
-> Addr# -> Addr# -> (# (# #) | (# Integer, Addr# #) #)
FlatParse.Internal.readInteger ForeignPtrContents
fp Addr#
eob Addr#
s of
(# (##) | #) -> Res# e Integer
forall e a. Res# e a
Fail#
(# | (# Integer
i, Addr#
s' #) #) -> Integer -> Addr# -> Res# e Integer
forall a e. a -> Addr# -> Res# e a
OK# Integer
i Addr#
s'
{-# inline readInteger #-}
infixr 6 <|>
(<|>) :: Parser e a -> Parser e a -> Parser e a
<|> :: Parser e a -> Parser e a -> Parser e a
(<|>) (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
g) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
Res# e a
Fail# -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
g ForeignPtrContents
fp Addr#
eob Addr#
s
Res# e a
x -> Res# e a
x
{-# inline (<|>) #-}
branch :: Parser e a -> Parser e b -> Parser e b -> Parser e b
branch :: Parser e a -> Parser e b -> Parser e b -> Parser e b
branch Parser e a
pa Parser e b
pt Parser e b
pf = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser e a
pa ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
_ Addr#
s -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser e b
pt ForeignPtrContents
fp Addr#
eob Addr#
s
Res# e a
Fail# -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser e b
pf ForeignPtrContents
fp Addr#
eob Addr#
s
Err# e
e -> e -> Res# e b
forall e a. e -> Res# e a
Err# e
e
{-# inline branch #-}
chainl :: (b -> a -> b) -> Parser e b -> Parser e a -> Parser e b
chainl :: (b -> a -> b) -> Parser e b -> Parser e a -> Parser e b
chainl b -> a -> b
f Parser e b
start Parser e a
elem = Parser e b
start Parser e b -> (b -> Parser e b) -> Parser e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Parser e b
go where
go :: b -> Parser e b
go b
b = do {!a
a <- Parser e a
elem; b -> Parser e b
go (b -> Parser e b) -> b -> Parser e b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
b a
a} Parser e b -> Parser e b -> Parser e b
forall e a. Parser e a -> Parser e a -> Parser e a
<|> b -> Parser e b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
{-# inline chainl #-}
chainr :: (a -> b -> b) -> Parser e a -> Parser e b -> Parser e b
chainr :: (a -> b -> b) -> Parser e a -> Parser e b -> Parser e b
chainr a -> b -> b
f (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
elem) (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
end) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
go where
go :: ForeignPtrContents -> Addr# -> Addr# -> Res# e b
go ForeignPtrContents
fp Addr#
eob Addr#
s = case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
elem ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e b
go ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# b
b Addr#
s -> let !b' :: b
b' = a -> b -> b
f a
a b
b in b -> Addr# -> Res# e b
forall a e. a -> Addr# -> Res# e a
OK# b
b' Addr#
s
Res# e b
x -> Res# e b
x
Res# e a
Fail# -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
end ForeignPtrContents
fp Addr#
eob Addr#
s
Err# e
e -> e -> Res# e b
forall e a. e -> Res# e a
Err# e
e
{-# inline chainr #-}
many :: Parser e a -> Parser e [a]
many :: Parser e a -> Parser e [a]
many (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e [a])
-> Parser e [a]
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e [a]
go where
go :: ForeignPtrContents -> Addr# -> Addr# -> Res# e [a]
go ForeignPtrContents
fp Addr#
eob Addr#
s = case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e [a]
go ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# [a]
as Addr#
s -> [a] -> Addr# -> Res# e [a]
forall a e. a -> Addr# -> Res# e a
OK# (a
aa -> [a] -> [a]
forall k1. k1 -> [k1] -> [k1]
:[a]
as) Addr#
s
Res# e [a]
x -> Res# e [a]
x
Res# e a
Fail# -> [a] -> Addr# -> Res# e [a]
forall a e. a -> Addr# -> Res# e a
OK# [] Addr#
s
Err# e
e -> e -> Res# e [a]
forall e a. e -> Res# e a
Err# e
e
{-# inline many #-}
many_ :: Parser e a -> Parser e ()
many_ :: Parser e a -> Parser e ()
many_ (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e ()
go where
go :: ForeignPtrContents -> Addr# -> Addr# -> Res# e ()
go ForeignPtrContents
fp Addr#
eob Addr#
s = case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s -> ForeignPtrContents -> Addr# -> Addr# -> Res# e ()
go ForeignPtrContents
fp Addr#
eob Addr#
s
Res# e a
Fail# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
Err# e
e -> e -> Res# e ()
forall e a. e -> Res# e a
Err# e
e
{-# inline many_ #-}
some :: Parser e a -> Parser e [a]
some :: Parser e a -> Parser e [a]
some Parser e a
p = (:) (a -> [a] -> [a]) -> Parser e a -> Parser e ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e a
p Parser e ([a] -> [a]) -> Parser e [a] -> Parser e [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser e a -> Parser e [a]
forall e a. Parser e a -> Parser e [a]
many Parser e a
p
{-# inline some #-}
some_ :: Parser e a -> Parser e ()
some_ :: Parser e a -> Parser e ()
some_ Parser e a
pa = Parser e a
pa Parser e a -> Parser e () -> Parser e ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser e a -> Parser e ()
forall e a. Parser e a -> Parser e ()
many_ Parser e a
pa
{-# inline some_ #-}
notFollowedBy :: Parser e a -> Parser e b -> Parser e a
notFollowedBy :: Parser e a -> Parser e b -> Parser e a
notFollowedBy Parser e a
p1 Parser e b
p2 = Parser e a
p1 Parser e a -> Parser e () -> Parser e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser e b -> Parser e ()
forall e a. Parser e a -> Parser e ()
fails Parser e b
p2
{-# inline notFollowedBy #-}
getPos :: Parser e Pos
getPos :: Parser e Pos
getPos = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Pos)
-> Parser e Pos
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> Pos -> Addr# -> Res# e Pos
forall a e. a -> Addr# -> Res# e a
OK# (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s) Addr#
s
{-# inline getPos #-}
setPos :: Pos -> Parser e ()
setPos :: Pos -> Parser e ()
setPos Pos
s = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
_ -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Pos -> Addr#
posToAddr# Addr#
eob Pos
s)
{-# inline setPos #-}
endPos :: Pos
endPos :: Pos
endPos = Int -> Pos
Pos Int
0
{-# inline endPos #-}
spanOf :: Parser e a -> Parser e Span
spanOf :: Parser e a -> Parser e Span
spanOf (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Span)
-> Parser e Span
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s' -> Span -> Addr# -> Res# e Span
forall a e. a -> Addr# -> Res# e a
OK# (Pos -> Pos -> Span
Span (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s) (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s')) Addr#
s'
Res# e a
x -> Res# e a -> Res# e Span
unsafeCoerce# Res# e a
x
{-# inline spanOf #-}
spanned :: Parser e a -> (a -> Span -> Parser e b) -> Parser e b
spanned :: Parser e a -> (a -> Span -> Parser e b) -> Parser e b
spanned (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) a -> Span -> Parser e b
g = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s' -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (a -> Span -> Parser e b
g a
a (Pos -> Pos -> Span
Span (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s) (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s'))) ForeignPtrContents
fp Addr#
eob Addr#
s'
Res# e a
x -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
{-# inline spanned #-}
byteStringOf :: Parser e a -> Parser e B.ByteString
byteStringOf :: Parser e a -> Parser e ByteString
byteStringOf (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ByteString)
-> Parser e ByteString
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s' -> ByteString -> Addr# -> Res# e ByteString
forall a e. a -> Addr# -> Res# e a
OK# (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
s ForeignPtrContents
fp) Int
0 (Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
s' Addr#
s))) Addr#
s'
Res# e a
x -> Res# e a -> Res# e ByteString
unsafeCoerce# Res# e a
x
{-# inline byteStringOf #-}
byteStringed :: Parser e a -> (a -> B.ByteString -> Parser e b) -> Parser e b
byteStringed :: Parser e a -> (a -> ByteString -> Parser e b) -> Parser e b
byteStringed (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) a -> ByteString -> Parser e b
g = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
OK# a
a Addr#
s' -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (a -> ByteString -> Parser e b
g a
a (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
s ForeignPtrContents
fp) Int
0 (Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
s' Addr#
s)))) ForeignPtrContents
fp Addr#
eob Addr#
s'
Res# e a
x -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
{-# inline byteStringed #-}
inSpan :: Span -> Parser e a -> Parser e a
inSpan :: Span -> Parser e a -> Parser e a
inSpan (Span Pos
s Pos
eob) (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob' Addr#
s' ->
case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp (Addr# -> Pos -> Addr#
posToAddr# Addr#
eob' Pos
eob) (Addr# -> Pos -> Addr#
posToAddr# Addr#
eob' Pos
s) of
OK# a
a Addr#
_ -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a Addr#
s'
Res# e a
x -> Res# e a -> Res# e a
unsafeCoerce# Res# e a
x
{-# inline inSpan #-}
validPos :: B.ByteString -> Pos -> Bool
validPos :: ByteString -> Pos -> Bool
validPos ByteString
str Pos
pos =
let go :: Parser e Bool
go = do
Pos
start <- Parser e Pos
forall e. Parser e Pos
getPos
Bool -> Parser e Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pos
start Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
pos Bool -> Bool -> Bool
&& Pos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
endPos)
in case Parser Any Bool -> ByteString -> Result Any Bool
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser Any Bool
forall e. Parser e Bool
go ByteString
str of
OK Bool
b ByteString
_ -> Bool
b
Result Any Bool
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"impossible"
{-# inline validPos #-}
posLineCols :: B.ByteString -> [Pos] -> [(Int, Int)]
posLineCols :: ByteString -> [Pos] -> [(Int, Int)]
posLineCols ByteString
str [Pos]
poss =
let go :: a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go !a
line !a
col [] = [(a, (a, a))] -> Parser e [(a, (a, a))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
go a
line a
col ((a
i, Pos
pos):[(a, Pos)]
poss) = do
Pos
p <- Parser e Pos
forall e. Parser e Pos
getPos
if Pos
pos Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
p then
((a
i, (a
line, a
col))(a, (a, a)) -> [(a, (a, a))] -> [(a, (a, a))]
forall k1. k1 -> [k1] -> [k1]
:) ([(a, (a, a))] -> [(a, (a, a))])
-> Parser e [(a, (a, a))] -> Parser e [(a, (a, a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go a
line a
col [(a, Pos)]
poss
else do
Char
c <- Parser e Char
forall e. Parser e Char
anyChar
if Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c then
a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go (a
line a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a
0 ((a
i, Pos
pos)(a, Pos) -> [(a, Pos)] -> [(a, Pos)]
forall k1. k1 -> [k1] -> [k1]
:[(a, Pos)]
poss)
else
a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go a
line (a
col a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) ((a
i, Pos
pos)(a, Pos) -> [(a, Pos)] -> [(a, Pos)]
forall k1. k1 -> [k1] -> [k1]
:[(a, Pos)]
poss)
sorted :: [(Int, Pos)]
sorted :: [(Int, Pos)]
sorted = ((Int, Pos) -> (Int, Pos) -> Ordering)
-> [(Int, Pos)] -> [(Int, Pos)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, Pos) -> Pos) -> (Int, Pos) -> (Int, Pos) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, Pos) -> Pos
forall a b. (a, b) -> b
snd) ([Int] -> [Pos] -> [(Int, Pos)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Pos]
poss)
in case Parser Any [(Int, (Int, Int))]
-> ByteString -> Result Any [(Int, (Int, Int))]
forall e a. Parser e a -> ByteString -> Result e a
runParser (Int -> Int -> [(Int, Pos)] -> Parser Any [(Int, (Int, Int))]
forall a a a e.
(Num a, Num a) =>
a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go Int
0 Int
0 [(Int, Pos)]
sorted) ByteString
str of
OK [(Int, (Int, Int))]
res ByteString
_ -> (Int, (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd ((Int, (Int, Int)) -> (Int, Int))
-> [(Int, (Int, Int))] -> [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, (Int, Int)) -> (Int, (Int, Int)) -> Ordering)
-> [(Int, (Int, Int))] -> [(Int, (Int, Int))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (Int, Int)) -> Int)
-> (Int, (Int, Int)) -> (Int, (Int, Int)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (Int, Int)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (Int, Int))]
res
Result Any [(Int, (Int, Int))]
_ -> String -> [(Int, Int)]
forall a. HasCallStack => String -> a
error String
"invalid position"
unsafeSpanToByteString :: Span -> Parser e B.ByteString
unsafeSpanToByteString :: Span -> Parser e ByteString
unsafeSpanToByteString (Span Pos
l Pos
r) =
Parser e ByteString -> Parser e ByteString
forall e a. Parser e a -> Parser e a
lookahead (Pos -> Parser e ()
forall e. Pos -> Parser e ()
setPos Pos
l Parser e () -> Parser e ByteString -> Parser e ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser e () -> Parser e ByteString
forall e a. Parser e a -> Parser e ByteString
byteStringOf (Pos -> Parser e ()
forall e. Pos -> Parser e ()
setPos Pos
r))
{-# inline unsafeSpanToByteString #-}
mkPos :: B.ByteString -> (Int, Int) -> Pos
mkPos :: ByteString -> (Int, Int) -> Pos
mkPos ByteString
str (Int
line', Int
col') =
let go :: Int -> Int -> Parser e Pos
go Int
line Int
col | Int
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line' Bool -> Bool -> Bool
&& Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
col' = Parser e Pos
forall e. Parser e Pos
getPos
go Int
line Int
col = (do
Char
c <- Parser e Char
forall e. Parser e Char
anyChar
if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then Int -> Int -> Parser e Pos
go (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0
else Int -> Int -> Parser e Pos
go Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Parser e Pos -> Parser e Pos -> Parser e Pos
forall e a. Parser e a -> Parser e a -> Parser e a
<|> String -> Parser e Pos
forall a. HasCallStack => String -> a
error String
"mkPos: invalid position"
in case Parser Any Pos -> ByteString -> Result Any Pos
forall e a. Parser e a -> ByteString -> Result e a
runParser (Int -> Int -> Parser Any Pos
forall e. Int -> Int -> Parser e Pos
go Int
0 Int
0) ByteString
str of
OK Pos
res ByteString
_ -> Pos
res
Result Any Pos
_ -> String -> Pos
forall a. HasCallStack => String -> a
error String
"impossible"
lines :: B.ByteString -> [String]
lines :: ByteString -> [String]
lines ByteString
str =
let go :: Parser e [String]
go = ([] [String] -> Parser e () -> Parser e [String]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e ()
forall e. Parser e ()
eof) Parser e [String] -> Parser e [String] -> Parser e [String]
forall e a. Parser e a -> Parser e a -> Parser e a
<|> ((:) (String -> [String] -> [String])
-> Parser e String -> Parser e ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e String
forall e. Parser e String
takeLine Parser e ([String] -> [String])
-> Parser e [String] -> Parser e [String]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser e [String]
go)
in case Parser Any [String] -> ByteString -> Result Any [String]
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser Any [String]
forall e. Parser e [String]
go ByteString
str of
OK [String]
ls ByteString
_ -> [String]
ls
Result Any [String]
_ -> String -> [String]
forall a. HasCallStack => String -> a
error String
"linesUTF8: invalid input"
takeLine :: Parser e String
takeLine :: Parser e String
takeLine =
Parser e ()
-> Parser e String -> Parser e String -> Parser e String
forall e a b. Parser e a -> Parser e b -> Parser e b -> Parser e b
branch Parser e ()
forall e. Parser e ()
eof (String -> Parser e String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") do
Char
c <- Parser e Char
forall e. Parser e Char
anyChar
case Char
c of
Char
'\n' -> String -> Parser e String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
Char
_ -> (Char
cChar -> ShowS
forall k1. k1 -> [k1] -> [k1]
:) ShowS -> Parser e String -> Parser e String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e String
forall e. Parser e String
takeLine
traceLine :: Parser e String
traceLine :: Parser e String
traceLine = Parser e String -> Parser e String
forall e a. Parser e a -> Parser e a
lookahead Parser e String
forall e. Parser e String
takeLine
takeRest :: Parser e String
takeRest :: Parser e String
takeRest = ((:) (Char -> ShowS) -> Parser e Char -> Parser e ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e Char
forall e. Parser e Char
anyChar Parser e ShowS -> Parser e String -> Parser e String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser e String
forall e. Parser e String
takeRest) Parser e String -> Parser e String -> Parser e String
forall e a. Parser e a -> Parser e a -> Parser e a
<|> String -> Parser e String
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
traceRest :: Parser e String
traceRest :: Parser e String
traceRest = Parser e String -> Parser e String
forall e a. Parser e a -> Parser e a
lookahead Parser e String
forall e. Parser e String
traceRest
unpackUTF8 :: B.ByteString -> String
unpackUTF8 :: ByteString -> String
unpackUTF8 ByteString
str = case Parser Any String -> ByteString -> Result Any String
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser Any String
forall e. Parser e String
takeRest ByteString
str of
OK String
a ByteString
_ -> String
a
Result Any String
_ -> ShowS
forall a. HasCallStack => String -> a
error String
"unpackUTF8: invalid encoding"
ensureBytes# :: Int -> Parser e ()
ensureBytes# :: Int -> Parser e ()
ensureBytes# (I# Int#
len) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
case Int#
len Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s of
Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
Int#
_ -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline ensureBytes# #-}
scan8# :: Word -> Parser e ()
scan8# :: Word -> Parser e ()
scan8# (W# Word#
c) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
case Addr# -> Int# -> Word#
indexWord8OffAddr Addr#
s Int#
0# of
Word#
c' -> case Word# -> Word# -> Int#
eqWord# Word#
c Word#
c' of
Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#)
Int#
_ -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scan8# #-}
scan16# :: Word -> Parser e ()
scan16# :: Word -> Parser e ()
scan16# (W# Word#
c) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
case Addr# -> Int# -> Word#
indexWord16OffAddr Addr#
s Int#
0# of
Word#
c' -> case Word# -> Word# -> Int#
eqWord# Word#
c Word#
c' of
Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
2#)
Int#
_ -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scan16# #-}
scan32# :: Word -> Parser e ()
scan32# :: Word -> Parser e ()
scan32# (W# Word#
c) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
case Addr# -> Int# -> Word#
indexWord32OffAddr Addr#
s Int#
0# of
Word#
c' -> case Word# -> Word# -> Int#
eqWord# Word#
c Word#
c' of
Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
4#)
Int#
_ -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scan32# #-}
scan64# :: Word -> Parser e ()
scan64# :: Word -> Parser e ()
scan64# (W# Word#
c) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
case Addr# -> Int# -> Word#
indexWord64OffAddr Addr#
s Int#
0# of
Word#
c' -> case Word# -> Word# -> Int#
eqWord# Word#
c Word#
c' of
Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
8#)
Int#
_ -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scan64# #-}
scanAny8# :: Parser e Word
scanAny8# :: Parser e Word
scanAny8# = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Word)
-> Parser e Word
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> Word -> Addr# -> Res# e Word
forall a e. a -> Addr# -> Res# e a
OK# (Word# -> Word
W# (Addr# -> Int# -> Word#
indexWord8OffAddr Addr#
s Int#
0#)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#)
{-# inline scanAny8# #-}
scanPartial64# :: Int -> Word -> Parser e ()
scanPartial64# :: Int -> Word -> Parser e ()
scanPartial64# (I# Int#
len) (W# Word#
w) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
case Addr# -> Int# -> Word#
indexWordOffAddr# Addr#
s Int#
0# of
Word#
w' -> case Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
8# Int# -> Int# -> Int#
-# Int#
len) Int#
3# of
Int#
sh -> case Word# -> Int# -> Word#
uncheckedShiftL# Word#
w' Int#
sh of
Word#
w' -> case Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w' Int#
sh of
Word#
w' -> case Word# -> Word# -> Int#
eqWord# Word#
w Word#
w' of
Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
len)
Int#
_ -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scanPartial64# #-}
setBack# :: Int -> Parser e ()
setBack# :: Int -> Parser e ()
setBack# (I# Int#
i) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
() -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s (Int# -> Int#
negateInt# Int#
i))
{-# inline setBack# #-}
scanBytes# :: [Word] -> Q Exp
scanBytes# :: [Word] -> Q Exp
scanBytes# [Word]
bytes = do
let !([Word]
leading, [Word]
w8s) = [Word] -> ([Word], [Word])
splitBytes [Word]
bytes
!scanw8s :: Q Exp
scanw8s = [Word] -> Q Exp
forall t. Lift t => [t] -> Q Exp
go [Word]
w8s where
go :: [t] -> Q Exp
go (t
w8:[] ) = [| scan64# w8 |]
go (t
w8:[t]
w8s) = [| scan64# w8 >> $(go w8s) |]
go [] = [| pure () |]
case [Word]
w8s of
[] -> [Word] -> Q Exp
go [Word]
leading
where
go :: [Word] -> Q Exp
go (Word
a:Word
b:Word
c:Word
d:[]) = let !w :: Word
w = [Word] -> Word
packBytes [Word
a, Word
b, Word
c, Word
d] in [| scan32# w |]
go (Word
a:Word
b:Word
c:Word
d:[Word]
ws) = let !w :: Word
w = [Word] -> Word
packBytes [Word
a, Word
b, Word
c, Word
d] in [| scan32# w >> $(go ws) |]
go (Word
a:Word
b:[]) = let !w :: Word
w = [Word] -> Word
packBytes [Word
a, Word
b] in [| scan16# w |]
go (Word
a:Word
b:[Word]
ws) = let !w :: Word
w = [Word] -> Word
packBytes [Word
a, Word
b] in [| scan16# w >> $(go ws) |]
go (Word
a:[]) = [| scan8# a |]
go [] = [| pure () |]
[Word]
_ -> case [Word]
leading of
[] -> Q Exp
scanw8s
[Word
a] -> [| scan8# a >> $scanw8s |]
ws :: [Word]
ws@[Word
a, Word
b] -> let !w :: Word
w = [Word] -> Word
packBytes [Word]
ws in [| scan16# w >> $scanw8s |]
ws :: [Word]
ws@[Word
a, Word
b, Word
c, Word
d] -> let !w :: Word
w = [Word] -> Word
packBytes [Word]
ws in [| scan32# w >> $scanw8s |]
[Word]
ws -> let !w :: Word
w = [Word] -> Word
packBytes [Word]
ws
!l :: Int
l = [Word] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
ws
in [| scanPartial64# l w >> $scanw8s |]
#if MIN_VERSION_base(4,15,0)
mkDoE = DoE Nothing
{-# inline mkDoE #-}
#else
mkDoE :: [Stmt] -> Exp
mkDoE = [Stmt] -> Exp
DoE
{-# inline mkDoE #-}
#endif
genTrie :: (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int)) -> Q Exp
genTrie :: (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp
genTrie (Map (Maybe Int) Exp
rules, Trie' (Maybe Int, Int, Maybe Int)
t) = do
Map (Maybe Int) (Name, Exp)
branches <- (Exp -> Q (Name, Exp))
-> Map (Maybe Int) Exp -> Q (Map (Maybe Int) (Name, Exp))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Exp
e -> (,) (Name -> Exp -> (Name, Exp)) -> Q Name -> Q (Exp -> (Name, Exp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Q Name
newName String
"rule") Q (Exp -> (Name, Exp)) -> Q Exp -> Q (Name, Exp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
e) Map (Maybe Int) Exp
rules
let ix :: Map a p -> a -> p
ix Map a p
m a
k = case a -> Map a p -> Maybe p
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
k Map a p
m of
Maybe p
Nothing -> String -> p
forall a. HasCallStack => String -> a
error (String
"key not in map: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k)
Just p
a -> p
a
let ensure :: Maybe Int -> Maybe (Q Exp)
ensure :: Maybe Int -> Maybe (Q Exp)
ensure = (Int -> Q Exp) -> Maybe Int -> Maybe (Q Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
n -> [| ensureBytes# n |])
fallback :: Rule -> Int -> Q Exp
fallback :: Maybe Int -> Int -> Q Exp
fallback Maybe Int
rule Int
0 = Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ (Name, Exp) -> Name
forall a b. (a, b) -> a
fst ((Name, Exp) -> Name) -> (Name, Exp) -> Name
forall a b. (a -> b) -> a -> b
$ Map (Maybe Int) (Name, Exp) -> Maybe Int -> (Name, Exp)
forall a p. (Ord a, Show a) => Map a p -> a -> p
ix Map (Maybe Int) (Name, Exp)
branches Maybe Int
rule
fallback Maybe Int
rule Int
n = [| setBack# n >> $(pure $ VarE $ fst $ ix branches rule) |]
let go :: Trie' (Rule, Int, Maybe Int) -> Q Exp
go :: Trie' (Maybe Int, Int, Maybe Int) -> Q Exp
go = \case
Branch' (Maybe Int
r, Int
n, Maybe Int
alloc) Map Word (Trie' (Maybe Int, Int, Maybe Int))
ts
| Map Word (Trie' (Maybe Int, Int, Maybe Int)) -> Bool
forall k a. Map k a -> Bool
M.null Map Word (Trie' (Maybe Int, Int, Maybe Int))
ts -> Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ (Name, Exp) -> Name
forall a b. (a, b) -> a
fst ((Name, Exp) -> Name) -> (Name, Exp) -> Name
forall a b. (a -> b) -> a -> b
$ Map (Maybe Int) (Name, Exp)
branches Map (Maybe Int) (Name, Exp) -> Maybe Int -> (Name, Exp)
forall k a. Ord k => Map k a -> k -> a
M.! Maybe Int
r
| Bool
otherwise -> do
![(Word, Exp)]
next <- (((Word, Trie' (Maybe Int, Int, Maybe Int)) -> Q (Word, Exp))
-> [(Word, Trie' (Maybe Int, Int, Maybe Int))] -> Q [(Word, Exp)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((Word, Trie' (Maybe Int, Int, Maybe Int)) -> Q (Word, Exp))
-> [(Word, Trie' (Maybe Int, Int, Maybe Int))] -> Q [(Word, Exp)])
-> ((Trie' (Maybe Int, Int, Maybe Int) -> Q Exp)
-> (Word, Trie' (Maybe Int, Int, Maybe Int)) -> Q (Word, Exp))
-> (Trie' (Maybe Int, Int, Maybe Int) -> Q Exp)
-> [(Word, Trie' (Maybe Int, Int, Maybe Int))]
-> Q [(Word, Exp)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trie' (Maybe Int, Int, Maybe Int) -> Q Exp)
-> (Word, Trie' (Maybe Int, Int, Maybe Int)) -> Q (Word, Exp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Trie' (Maybe Int, Int, Maybe Int) -> Q Exp
go (Map Word (Trie' (Maybe Int, Int, Maybe Int))
-> [(Word, Trie' (Maybe Int, Int, Maybe Int))]
forall k a. Map k a -> [(k, a)]
M.toList Map Word (Trie' (Maybe Int, Int, Maybe Int))
ts)
!Exp
defaultCase <- Maybe Int -> Int -> Q Exp
fallback Maybe Int
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
let cases :: Exp
cases = [Stmt] -> Exp
mkDoE ([Stmt] -> Exp) -> [Stmt] -> Exp
forall a b. (a -> b) -> a -> b
$
[Pat -> Exp -> Stmt
BindS (Name -> Pat
VarP (String -> Name
mkName String
"c")) (Name -> Exp
VarE 'scanAny8#),
Exp -> Stmt
NoBindS (Exp -> [Match] -> Exp
CaseE (Name -> Exp
VarE (String -> Name
mkName String
"c"))
(((Word, Exp) -> Match) -> [(Word, Exp)] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map (\(Word
w, Exp
t) ->
Pat -> Body -> [Dec] -> Match
Match (Lit -> Pat
LitP (Integer -> Lit
IntegerL (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)))
(Exp -> Body
NormalB Exp
t)
[])
[(Word, Exp)]
next
[Match] -> [Match] -> [Match]
forall a. [a] -> [a] -> [a]
++ [Pat -> Body -> [Dec] -> Match
Match Pat
WildP (Exp -> Body
NormalB Exp
defaultCase) []]))]
case Maybe Int -> Maybe (Q Exp)
ensure Maybe Int
alloc of
Maybe (Q Exp)
Nothing -> Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
cases
Just Q Exp
alloc -> [| branch $alloc $(pure cases) $(fallback r n) |]
Path (Maybe Int
r, Int
n, Maybe Int
alloc) [Word]
ws Trie' (Maybe Int, Int, Maybe Int)
t ->
case Maybe Int -> Maybe (Q Exp)
ensure Maybe Int
alloc of
Maybe (Q Exp)
Nothing -> [| branch $(scanBytes# ws) $(go t) $(fallback r n)|]
Just Q Exp
alloc -> [| branch ($alloc >> $(scanBytes# ws)) $(go t) $(fallback r n) |]
[DecQ] -> Q Exp -> Q Exp
letE
(((Name, Exp) -> DecQ) -> [(Name, Exp)] -> [DecQ]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
x, Exp
rhs) -> PatQ -> BodyQ -> [DecQ] -> DecQ
valD (Name -> PatQ
varP Name
x) (Q Exp -> BodyQ
normalB (Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
rhs)) []) (Map (Maybe Int) (Name, Exp) -> [(Name, Exp)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Map (Maybe Int) (Name, Exp)
branches))
(Trie' (Maybe Int, Int, Maybe Int) -> Q Exp
go Trie' (Maybe Int, Int, Maybe Int)
t)
parseSwitch :: Q Exp -> Q ([(String, Exp)], Maybe Exp)
parseSwitch :: Q Exp -> Q ([(String, Exp)], Maybe Exp)
parseSwitch Q Exp
exp = Q Exp
exp Q Exp
-> (Exp -> Q ([(String, Exp)], Maybe Exp))
-> Q ([(String, Exp)], Maybe Exp)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
CaseE (UnboundVarE Name
_) [] -> String -> Q ([(String, Exp)], Maybe Exp)
forall a. HasCallStack => String -> a
error String
"switch: empty clause list"
CaseE (UnboundVarE Name
_) [Match]
cases -> do
(![Match]
cases, !Match
last) <- ([Match], Match) -> Q ([Match], Match)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Match] -> [Match]
forall a. [a] -> [a]
init [Match]
cases, [Match] -> Match
forall a. [a] -> a
last [Match]
cases)
![(String, Exp)]
cases <- [Match] -> (Match -> Q (String, Exp)) -> Q [(String, Exp)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Match]
cases \case
Match (LitP (StringL String
str)) (NormalB Exp
rhs) [] -> (String, Exp) -> Q (String, Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
str, Exp
rhs)
Match
_ -> String -> Q (String, Exp)
forall a. HasCallStack => String -> a
error String
"switch: expected a match clause on a string literal"
(![(String, Exp)]
cases, !Maybe Exp
last) <- case Match
last of
Match (LitP (StringL String
str)) (NormalB Exp
rhs) [] -> ([(String, Exp)], Maybe Exp) -> Q ([(String, Exp)], Maybe Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, Exp)]
cases [(String, Exp)] -> [(String, Exp)] -> [(String, Exp)]
forall a. [a] -> [a] -> [a]
++ [(String
str, Exp
rhs)], Maybe Exp
forall k1. Maybe k1
Nothing)
Match Pat
WildP (NormalB Exp
rhs) [] -> ([(String, Exp)], Maybe Exp) -> Q ([(String, Exp)], Maybe Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, Exp)]
cases, Exp -> Maybe Exp
forall k1. k1 -> Maybe k1
Just Exp
rhs)
Match
_ -> String -> Q ([(String, Exp)], Maybe Exp)
forall a. HasCallStack => String -> a
error String
"switch: expected a match clause on a string literal or a wildcard"
([(String, Exp)], Maybe Exp) -> Q ([(String, Exp)], Maybe Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, Exp)]
cases, Maybe Exp
last)
Exp
_ -> String -> Q ([(String, Exp)], Maybe Exp)
forall a. HasCallStack => String -> a
error String
"switch: expected a \"case _ of\" expression"
genSwitchTrie' :: Maybe Exp -> [(String, Exp)] -> Maybe Exp
-> (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int))
genSwitchTrie' :: Maybe Exp
-> [(String, Exp)]
-> Maybe Exp
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
genSwitchTrie' Maybe Exp
postAction [(String, Exp)]
cases Maybe Exp
fallback =
let (![(Maybe Int, Exp)]
branches, ![(Int, String)]
strings) = [((Maybe Int, Exp), (Int, String))]
-> ([(Maybe Int, Exp)], [(Int, String)])
forall a b. [(a, b)] -> ([a], [b])
unzip do
(!Int
i, (!String
str, !Exp
rhs)) <- [Int] -> [(String, Exp)] -> [(Int, (String, Exp))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(String, Exp)]
cases
case Maybe Exp
postAction of
Maybe Exp
Nothing -> ((Maybe Int, Exp), (Int, String))
-> [((Maybe Int, Exp), (Int, String))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int -> Maybe Int
forall k1. k1 -> Maybe k1
Just Int
i, Exp
rhs), (Int
i, String
str))
Just !Exp
post -> ((Maybe Int, Exp), (Int, String))
-> [((Maybe Int, Exp), (Int, String))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int -> Maybe Int
forall k1. k1 -> Maybe k1
Just Int
i, (Name -> Exp
VarE '(>>)) Exp -> Exp -> Exp
`AppE` Exp
post Exp -> Exp -> Exp
`AppE` Exp
rhs), (Int
i, String
str))
!m :: Map (Maybe Int) Exp
m = [(Maybe Int, Exp)] -> Map (Maybe Int) Exp
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Maybe Int
forall k1. Maybe k1
Nothing, Exp -> (Exp -> Exp) -> Maybe Exp -> Exp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> Exp
VarE 'empty) Exp -> Exp
forall a. a -> a
id Maybe Exp
fallback) (Maybe Int, Exp) -> [(Maybe Int, Exp)] -> [(Maybe Int, Exp)]
forall k1. k1 -> [k1] -> [k1]
: [(Maybe Int, Exp)]
branches)
!trie :: Trie' (Maybe Int, Int, Maybe Int)
trie = [(Int, String)] -> Trie' (Maybe Int, Int, Maybe Int)
compileTrie [(Int, String)]
strings
in (Map (Maybe Int) Exp
m , Trie' (Maybe Int, Int, Maybe Int)
trie)