{-# LANGUAGE RankNTypes,
GADTs,
MultiParamTypeClasses,
FunctionalDependencies,
FlexibleInstances,
FlexibleContexts,
UndecidableInstances,
NoMonomorphismRestriction,
TypeSynonymInstances,
ScopedTypeVariables,
BangPatterns,
TypeOperators #-}
module Text.ParserCombinators.UU.BasicInstances(
Error (..),
Str (..),
Insertion (..),
LineCol (..),
LineColPos (..),
Parser,
ParserTrafo,
IsLocationUpdatedBy,
createStr,
show_expecting,
pSatisfy,
pRangeInsert,
pRange,
pSymInsert,
pSym,
pToken,
pTokenCost,
pMunch,
pMunchL
) where
import Text.ParserCombinators.UU.Core
import Data.Maybe
import Data.Word
import qualified Data.ListLike as LL
import Data.List (foldl')
data Error pos = Inserted String pos Strings
| Deleted String pos Strings
| Replaced String String pos Strings
| DeletedAtEnd String
instance (Show pos) => Show (Error pos) where
show :: Error pos -> String
show (Inserted String
s pos
pos Strings
expecting) = String
"-- Inserted " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ pos -> Strings -> String
forall pos. Show pos => pos -> Strings -> String
show_expecting pos
pos Strings
expecting
show (Deleted String
t pos
pos Strings
expecting) = String
"-- Deleted " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ pos -> Strings -> String
forall pos. Show pos => pos -> Strings -> String
show_expecting pos
pos Strings
expecting
show (Replaced String
old String
new pos
pos Strings
expecting) = String
"-- Replaced " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
old String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" by "String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
new String -> ShowS
forall a. [a] -> [a] -> [a]
++ pos -> Strings -> String
forall pos. Show pos => pos -> Strings -> String
show_expecting pos
pos Strings
expecting
show (DeletedAtEnd String
t) = String
"-- The token " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was not consumed by the parsing process."
show_expecting :: Show pos => pos -> [String] -> String
show_expecting :: pos -> Strings -> String
show_expecting pos
pos [String
a] = String
" at position " String -> ShowS
forall a. [a] -> [a] -> [a]
++ pos -> String
forall a. Show a => a -> String
show pos
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expecting " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a
show_expecting pos
pos (String
a:Strings
as) = String
" at position " String -> ShowS
forall a. [a] -> [a] -> [a]
++ pos -> String
forall a. Show a => a -> String
show pos
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" expecting one of [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ Strings -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ShowS -> Strings -> Strings
forall a b. (a -> b) -> [a] -> [b]
map (String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++) Strings
as) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
show_expecting pos
pos [] = String
" expecting nothing"
data Str a s loc = Str {
Str a s loc -> s
input :: s,
Str a s loc -> [Error loc]
msgs :: [Error loc],
Str a s loc -> loc
pos :: !loc,
Str a s loc -> Bool
deleteOk :: !Bool
}
type Parser a = forall loc state . (IsLocationUpdatedBy loc Char, LL.ListLike state Char) => P (Str Char state loc) a
type ParserTrafo a b = forall loc state . (IsLocationUpdatedBy loc Char, LL.ListLike state Char) => P (Str Char state loc) a -> P (Str Char state loc) b
createStr :: LL.ListLike s a => loc -> s -> Str a s loc
createStr :: loc -> s -> Str a s loc
createStr loc
beginpos s
ls = s -> [Error loc] -> loc -> Bool -> Str a s loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str s
ls [] loc
beginpos Bool
True
instance IsLocationUpdatedBy Int Char where
advance :: Int -> Char -> Int
advance !Int
pos Char
_ = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
instance IsLocationUpdatedBy Int Word8 where
advance :: Int -> Word8 -> Int
advance !Int
pos Word8
_ = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
data LineCol = LineCol !Int !Int deriving Int -> LineCol -> ShowS
[LineCol] -> ShowS
LineCol -> String
(Int -> LineCol -> ShowS)
-> (LineCol -> String) -> ([LineCol] -> ShowS) -> Show LineCol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineCol] -> ShowS
$cshowList :: [LineCol] -> ShowS
show :: LineCol -> String
$cshow :: LineCol -> String
showsPrec :: Int -> LineCol -> ShowS
$cshowsPrec :: Int -> LineCol -> ShowS
Show
instance IsLocationUpdatedBy LineCol Char where
advance :: LineCol -> Char -> LineCol
advance (LineCol Int
line Int
pos) Char
c = case Char
c of
Char
'\n' -> Int -> Int -> LineCol
LineCol (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
0
Char
'\t' -> Int -> Int -> LineCol
LineCol Int
line ( Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8)
Char
_ -> Int -> Int -> LineCol
LineCol Int
line (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
data LineColPos = LineColPos !Int !Int !Int deriving Int -> LineColPos -> ShowS
[LineColPos] -> ShowS
LineColPos -> String
(Int -> LineColPos -> ShowS)
-> (LineColPos -> String)
-> ([LineColPos] -> ShowS)
-> Show LineColPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineColPos] -> ShowS
$cshowList :: [LineColPos] -> ShowS
show :: LineColPos -> String
$cshow :: LineColPos -> String
showsPrec :: Int -> LineColPos -> ShowS
$cshowsPrec :: Int -> LineColPos -> ShowS
Show
instance IsLocationUpdatedBy LineColPos Char where
advance :: LineColPos -> Char -> LineColPos
advance (LineColPos Int
line Int
pos Int
abs) Char
c = case Char
c of
Char
'\n' -> Int -> Int -> Int -> LineColPos
LineColPos (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
0 (Int
abs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Char
'\t' -> Int -> Int -> Int -> LineColPos
LineColPos Int
line (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8) (Int
abs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Char
_ -> Int -> Int -> Int -> LineColPos
LineColPos Int
line (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
abs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
instance IsLocationUpdatedBy loc a => IsLocationUpdatedBy loc [a] where
advance :: loc -> [a] -> loc
advance = (loc -> a -> loc) -> loc -> [a] -> loc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' loc -> a -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance
instance (Show a, LL.ListLike s a) => Eof (Str a s loc) where
eof :: Str a s loc -> Bool
eof (Str s
i [Error loc]
_ loc
_ Bool
_ ) = s -> Bool
forall full item. ListLike full item => full -> Bool
LL.null s
i
deleteAtEnd :: Str a s loc -> Maybe (Int, Str a s loc)
deleteAtEnd (Str s
s [Error loc]
msgs loc
pos Bool
ok ) | s -> Bool
forall full item. ListLike full item => full -> Bool
LL.null s
s = Maybe (Int, Str a s loc)
forall a. Maybe a
Nothing
| Bool
otherwise = (Int, Str a s loc) -> Maybe (Int, Str a s loc)
forall a. a -> Maybe a
Just (Int
5, s -> [Error loc] -> loc -> Bool -> Str a s loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str (s -> s
forall full item. ListLike full item => full -> full
LL.tail s
s) ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> Error loc
forall pos. String -> Error pos
DeletedAtEnd (a -> String
forall a. Show a => a -> String
show (s -> a
forall full item. ListLike full item => full -> item
LL.head s
s))]) loc
pos Bool
ok)
instance StoresErrors (Str a s loc) (Error loc) where
getErrors :: Str a s loc -> ([Error loc], Str a s loc)
getErrors (Str s
inp [Error loc]
msgs loc
pos Bool
ok ) = ([Error loc]
msgs, s -> [Error loc] -> loc -> Bool -> Str a s loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str s
inp [] loc
pos Bool
ok)
instance HasPosition (Str a s loc) loc where
getPos :: Str a s loc -> loc
getPos (Str s
inp [Error loc]
msgs loc
pos Bool
ok ) = loc
pos
data Insertion a = Insertion String a Cost
pSatisfy :: forall loc state a .((Show a, loc `IsLocationUpdatedBy` a, LL.ListLike state a) => (a -> Bool) -> (Insertion a) -> P (Str a state loc) a)
pSatisfy :: (a -> Bool) -> Insertion a -> P (Str a state loc) a
pSatisfy a -> Bool
p (Insertion String
msg a
a Int
cost) = (forall a.
(a -> Str a state loc -> Steps a) -> Str a state loc -> Steps a)
-> Nat -> Maybe a -> P (Str a state loc) a
forall token state.
(forall a. (token -> state -> Steps a) -> state -> Steps a)
-> Nat -> Maybe token -> P state token
pSymExt forall a.
(a -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState (Nat -> Nat
Succ (Nat
Zero)) Maybe a
forall a. Maybe a
Nothing
where splitState :: forall r. ((a -> (Str a state loc) -> Steps r) -> (Str a state loc) -> Steps r)
splitState :: (a -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
splitState a -> Str a state loc -> Steps r
k (Str state
tts [Error loc]
msgs loc
pos Bool
del_ok)
= String -> Steps r -> Steps r
forall p p. p -> p -> p
show_attempt (String
"Try Predicate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at position " String -> ShowS
forall a. [a] -> [a] -> [a]
++ loc -> String
forall a. Show a => a -> String
show loc
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (
let ins :: Strings -> (Int, Steps r)
ins Strings
exp = (Int
cost, a -> Str a state loc -> Steps r
k a
a (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
tts ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> loc -> Strings -> Error loc
forall pos. String -> pos -> Strings -> Error pos
Inserted (a -> String
forall a. Show a => a -> String
show a
a) loc
pos Strings
exp]) loc
pos Bool
False))
in if state -> Bool
forall full item. ListLike full item => full -> Bool
LL.null state
tts
then Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
msg] [Strings -> (Int, Steps r)
ins]
else let t :: a
t = state -> a
forall full item. ListLike full item => full -> item
LL.head state
tts
ts :: state
ts = state -> state
forall full item. ListLike full item => full -> full
LL.tail state
tts
del :: Strings -> (Int, Steps r)
del Strings
exp = (Int
4, (a -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
forall a.
(a -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState a -> Str a state loc -> Steps r
k (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
ts ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> loc -> Strings -> Error loc
forall pos. String -> pos -> Strings -> Error pos
Deleted (a -> String
forall a. Show a => a -> String
show a
t) loc
pos Strings
exp]) (loc -> a -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos a
t) Bool
True ))
in if a -> Bool
p a
t
then String -> Steps r -> Steps r
forall b. String -> b -> b
show_symbol (String
"Accepting symbol: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at position: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ loc -> String
forall a. Show a => a -> String
show loc
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n")
(Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Step Int
1 (a -> Str a state loc -> Steps r
k a
t (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
ts [Error loc]
msgs (loc -> a -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos a
t) Bool
True)))
else Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
msg] (Strings -> (Int, Steps r)
ins(Strings -> (Int, Steps r))
-> [Strings -> (Int, Steps r)] -> [Strings -> (Int, Steps r)]
forall a. a -> [a] -> [a]
: if Bool
del_ok then [Strings -> (Int, Steps r)
del] else [])
)
pRangeInsert :: (Ord a, Show a, IsLocationUpdatedBy loc a, LL.ListLike state a) => (a, a) -> Insertion a -> P (Str a state loc) a
pRangeInsert :: (a, a) -> Insertion a -> P (Str a state loc) a
pRangeInsert (a
low, a
high) = (a -> Bool) -> Insertion a -> P (Str a state loc) a
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> Insertion a -> P (Str a state loc) a
pSatisfy (\ a
t -> a
low a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
t Bool -> Bool -> Bool
&& a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
high)
pRange :: (Ord a, Show a, IsLocationUpdatedBy loc a, LL.ListLike state a) => (a, a) -> P (Str a state loc) a
pRange :: (a, a) -> P (Str a state loc) a
pRange lh :: (a, a)
lh@(a
low, a
high) = (a, a) -> Insertion a -> P (Str a state loc) a
forall a loc state.
(Ord a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a, a) -> Insertion a -> P (Str a state loc) a
pRangeInsert (a, a)
lh (String -> a -> Int -> Insertion a
forall a. String -> a -> Int -> Insertion a
Insertion (a -> String
forall a. Show a => a -> String
show a
low String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".." String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
high) a
low Int
5)
pSymInsert :: (Eq a,Show a, IsLocationUpdatedBy loc a, LL.ListLike state a) => a -> Insertion a -> P (Str a state loc) a
pSymInsert :: a -> Insertion a -> P (Str a state loc) a
pSymInsert a
t = (a -> Bool) -> Insertion a -> P (Str a state loc) a
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> Insertion a -> P (Str a state loc) a
pSatisfy (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
t)
pSym :: (Eq a,Show a, IsLocationUpdatedBy loc a, LL.ListLike state a) => a -> P (Str a state loc) a
pSym :: a -> P (Str a state loc) a
pSym a
t = a -> Insertion a -> P (Str a state loc) a
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> Insertion a -> P (Str a state loc) a
pSymInsert a
t (String -> a -> Int -> Insertion a
forall a. String -> a -> Int -> Insertion a
Insertion (a -> String
forall a. Show a => a -> String
show a
t) a
t Int
5)
pMunchL :: forall loc state a .((Show a, loc `IsLocationUpdatedBy` a, LL.ListLike state a) => (a -> Bool) -> String -> P (Str a state loc) [a])
pMunchL :: (a -> Bool) -> String -> P (Str a state loc) [a]
pMunchL a -> Bool
p String
msg = (forall a.
([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a)
-> Nat -> Maybe [a] -> P (Str a state loc) [a]
forall token state.
(forall a. (token -> state -> Steps a) -> state -> Steps a)
-> Nat -> Maybe token -> P state token
pSymExt forall a.
([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState Nat
Zero Maybe [a]
forall a. Maybe a
Nothing
where splitState :: forall r. (([a] -> (Str a state loc) -> Steps r) -> (Str a state loc) -> Steps r)
splitState :: ([a] -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
splitState [a] -> Str a state loc -> Steps r
k inp :: Str a state loc
inp@(Str state
tts [Error loc]
msgs loc
pos Bool
del_ok)
= String -> Steps r -> Steps r
forall p p. p -> p -> p
show_attempt (String
"Try Munch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (
let (state
fmunch, state
rest) = (a -> Bool) -> state -> (state, state)
forall full item.
ListLike full item =>
(item -> Bool) -> full -> (full, full)
LL.span a -> Bool
p state
tts
munched :: [Item state]
munched = state -> [Item state]
forall l. IsList l => l -> [Item l]
LL.toList state
fmunch
l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
[Item state]
munched
in if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then String -> Steps r -> Steps r
forall b. String -> b -> b
show_munch (String
"Accepting munch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
[Item state]
munched String -> ShowS
forall a. [a] -> [a] -> [a]
++ loc -> String
forall a. Show a => a -> String
show loc
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
(Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Step Int
l ([a] -> Str a state loc -> Steps r
k [a]
[Item state]
munched (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
rest [Error loc]
msgs (loc -> [a] -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos [a]
[Item state]
munched) (Int
lInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
|| Bool
del_ok))))
else String -> Steps r -> Steps r
forall b. String -> b -> b
show_munch (String
"Accepting munch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" as emtty munch " String -> ShowS
forall a. [a] -> [a] -> [a]
++ loc -> String
forall a. Show a => a -> String
show loc
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") ([a] -> Str a state loc -> Steps r
k [] Str a state loc
inp)
)
pMunch :: forall loc state a .((Show a, loc `IsLocationUpdatedBy` a, LL.ListLike state a) => (a -> Bool) -> P (Str a state loc) [a])
pMunch :: (a -> Bool) -> P (Str a state loc) [a]
pMunch a -> Bool
p = (a -> Bool) -> String -> P (Str a state loc) [a]
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> String -> P (Str a state loc) [a]
pMunchL a -> Bool
p String
""
pTokenCost :: forall loc state a .((Show a, Eq a, loc `IsLocationUpdatedBy` a, LL.ListLike state a) => [a] -> Int -> P (Str a state loc) [a])
pTokenCost :: [a] -> Int -> P (Str a state loc) [a]
pTokenCost [a]
as Int
cost =
if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
as then String -> P (Str a state loc) [a]
forall a. HasCallStack => String -> a
error String
"Module: BasicInstances, function: pTokenCost; call with empty token"
else (forall a.
([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a)
-> Nat -> Maybe [a] -> P (Str a state loc) [a]
forall token state.
(forall a. (token -> state -> Steps a) -> state -> Steps a)
-> Nat -> Maybe token -> P state token
pSymExt forall a.
([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState ([a] -> Nat
forall a. [a] -> Nat
nat_length [a]
as) Maybe [a]
forall a. Maybe a
Nothing
where tas :: state
tas :: state
tas = [Item state] -> state
forall l. IsList l => [Item l] -> l
LL.fromList [a]
[Item state]
as
nat_length :: [a] -> Nat
nat_length [] = Nat
Zero
nat_length (a
_:[a]
as) = Nat -> Nat
Succ ([a] -> Nat
nat_length [a]
as)
l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as
msg :: String
msg = [a] -> String
forall a. Show a => a -> String
show [a]
as
splitState :: forall r. (([a] -> (Str a state loc) -> Steps r) -> (Str a state loc) -> Steps r)
splitState :: ([a] -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
splitState [a] -> Str a state loc -> Steps r
k inp :: Str a state loc
inp@(Str state
tts [Error loc]
msgs loc
pos Bool
del_ok)
= String -> Steps r -> Steps r
forall p p. p -> p -> p
show_attempt (String
"Try Token: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
as String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (
if state -> state -> Bool
forall full item.
(ListLike full item, Eq item) =>
full -> full -> Bool
LL.isPrefixOf state
tas state
tts
then String -> Steps r -> Steps r
forall b. String -> b -> b
show_tokens (String
"Accepting token: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
as String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n")
(Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Step Int
l ([a] -> Str a state loc -> Steps r
k [a]
as (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str (Int -> state -> state
forall full item. ListLike full item => Int -> full -> full
LL.drop Int
l state
tts) [Error loc]
msgs (loc -> [a] -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos [a]
as) Bool
True)))
else let ins :: Strings -> (Int, Steps r)
ins Strings
exp = (Int
cost, [a] -> Str a state loc -> Steps r
k [a]
as (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
tts ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> loc -> Strings -> Error loc
forall pos. String -> pos -> Strings -> Error pos
Inserted String
msg loc
pos Strings
exp]) loc
pos Bool
False))
in if state -> Bool
forall full item. ListLike full item => full -> Bool
LL.null state
tts
then Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
msg] [Strings -> (Int, Steps r)
ins]
else let t :: a
t = state -> a
forall full item. ListLike full item => full -> item
LL.head state
tts
ts :: state
ts = state -> state
forall full item. ListLike full item => full -> full
LL.tail state
tts
del :: Strings -> (Int, Steps r)
del Strings
exp = (Int
5, ([a] -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
forall a.
([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState [a] -> Str a state loc -> Steps r
k
(state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
ts ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> loc -> Strings -> Error loc
forall pos. String -> pos -> Strings -> Error pos
Deleted (a -> String
forall a. Show a => a -> String
show a
t) loc
pos Strings
exp])
(loc -> a -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos a
t) Bool
True))
in Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
msg] (Strings -> (Int, Steps r)
ins(Strings -> (Int, Steps r))
-> [Strings -> (Int, Steps r)] -> [Strings -> (Int, Steps r)]
forall a. a -> [a] -> [a]
: if Bool
del_ok then [Strings -> (Int, Steps r)
del] else [])
)
pToken :: forall loc state a .((Show a, Eq a, loc `IsLocationUpdatedBy` a, LL.ListLike state a) => [a] -> P (Str a state loc) [a])
pToken :: [a] -> P (Str a state loc) [a]
pToken [a]
as = [a] -> Int -> P (Str a state loc) [a]
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> Int -> P (Str a state loc) [a]
pTokenCost [a]
as Int
10
{-# INLINE show_tokens #-}
show_tokens :: String -> b -> b
show_tokens :: String -> b -> b
show_tokens String
m b
v = b
v
{-# INLINE show_munch #-}
show_munch :: String -> b -> b
show_munch :: String -> b -> b
show_munch String
m b
v = b
v
{-# INLINE show_symbol #-}
show_symbol :: String -> b -> b
show_symbol :: String -> b -> b
show_symbol String
m b
v = b
v
{-# INLINE show_attempt #-}
show_attempt :: p -> p -> p
show_attempt p
m p
v = p
v