{-# LANGUAGE RankNTypes,
GADTs,
MultiParamTypeClasses,
FunctionalDependencies,
FlexibleInstances,
KindSignatures,
CPP #-}
module Text.ParserCombinators.UU.Core
(
IsParser,
ExtAlternative (..),
Eof (..),
IsLocationUpdatedBy (..),
StoresErrors (..),
HasPosition (..),
P (..),
Steps (..),
Cost,
Progress,
Nat (..),
Strings,
micro,
amb,
pErrors,
pPos,
pState,
pEnd,
pSwitch,
pSymExt,
parse, parse_h,
getZeroP,
getOneP,
addLength,
eval,
module Control.Applicative,
module Control.Monad
) where
import Control.Applicative
import Control.Monad
import Data.Char
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 710
import Prelude hiding ((.), traverse)
#else
import Prelude hiding ((.))
#endif
import Data.Maybe
t -> t
f . :: (t -> t) -> (t -> t) -> t -> t
. t -> t
g = \t
x -> t -> t
f ( t -> t
g t
x)
{-# INLINE (.) #-}
class (Alternative p, Applicative p, ExtAlternative p) => IsParser p
instance MonadPlus (P st) where
mzero :: P st a
mzero = P st a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: P st a -> P st a -> P st a
mplus = P st a -> P st a -> P st a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
class (Alternative p) => ExtAlternative p where
(<<|>) :: p a -> p a -> p a
(<?>) :: p a -> String -> p a
must_be_non_empty :: String -> p a -> c -> c
must_be_non_empties :: String -> p a -> p b -> c -> c
opt :: p a -> a -> p a
opt p a
p a
v = String -> p a -> p a -> p a
forall (p :: * -> *) a c.
ExtAlternative p =>
String -> p a -> c -> c
must_be_non_empty String
"opt" p a
p (p a
p p a -> p a -> p a
forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> a -> p a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v)
infix 2 <?>
infixl 3 <<|>
infixl 2 `opt`
class Eof state where
eof :: state -> Bool
deleteAtEnd :: state -> Maybe (Cost, state)
class Show loc => loc `IsLocationUpdatedBy` str where
advance :: loc
-> str
-> loc
class state `StoresErrors` error | state -> error where
getErrors :: state -> ([error], state)
class state `HasPosition` pos | state -> pos where
getPos :: state -> pos
data T st a = T (forall r . (a -> st -> Steps r) -> st -> Steps r )
(forall r . ( st -> Steps r) -> st -> Steps (a, r) )
(forall r . ( st -> Steps r) -> st -> Steps r )
instance Functor (T st) where
fmap :: (a -> b) -> T st a -> T st b
fmap a -> b
f (T forall r. (a -> st -> Steps r) -> st -> Steps r
ph forall r. (st -> Steps r) -> st -> Steps (a, r)
pf forall r. (st -> Steps r) -> st -> Steps r
pr) = (forall r. (b -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (b, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st b
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ b -> st -> Steps r
k -> (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
ph ( b -> st -> Steps r
k (b -> st -> Steps r) -> (a -> b) -> a -> st -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
.a -> b
f ))
( \ st -> Steps r
k -> (a -> b) -> Steps (a, r) -> Steps (b, r)
forall b a r. (b -> a) -> Steps (b, r) -> Steps (a, r)
apply2fst a -> b
f (Steps (a, r) -> Steps (b, r))
-> (st -> Steps (a, r)) -> st -> Steps (b, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
pf st -> Steps r
k)
forall r. (st -> Steps r) -> st -> Steps r
pr
a
f <$ :: a -> T st b -> T st a
<$ (T forall r. (b -> st -> Steps r) -> st -> Steps r
_ forall r. (st -> Steps r) -> st -> Steps (b, r)
_ forall r. (st -> Steps r) -> st -> Steps r
pr) = (forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( (st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
pr ((st -> Steps r) -> st -> Steps r)
-> ((a -> st -> Steps r) -> st -> Steps r)
-> (a -> st -> Steps r)
-> st
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. ((a -> st -> Steps r) -> a -> st -> Steps r
forall a b. (a -> b) -> a -> b
$a
f))
( \ st -> Steps r
k st
st -> a -> Steps r -> Steps (a, r)
forall v r. v -> Steps r -> Steps (v, r)
push a
f ( (st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
pr st -> Steps r
k st
st))
forall r. (st -> Steps r) -> st -> Steps r
pr
instance Applicative (T state) where
T forall r. ((a -> b) -> state -> Steps r) -> state -> Steps r
ph forall r. (state -> Steps r) -> state -> Steps (a -> b, r)
pf forall r. (state -> Steps r) -> state -> Steps r
pr <*> :: T state (a -> b) -> T state a -> T state b
<*> ~(T forall r. (a -> state -> Steps r) -> state -> Steps r
qh forall r. (state -> Steps r) -> state -> Steps (a, r)
qf forall r. (state -> Steps r) -> state -> Steps r
qr) = (forall r. (b -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (b, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state b
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ b -> state -> Steps r
k -> ((a -> b) -> state -> Steps r) -> state -> Steps r
forall r. ((a -> b) -> state -> Steps r) -> state -> Steps r
ph (\ a -> b
pr -> (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
qh (\ a
qr -> b -> state -> Steps r
k (a -> b
pr a
qr))))
((Steps (a -> b, (a, r)) -> Steps (b, r)
forall b a r. Steps (b -> a, (b, r)) -> Steps (a, r)
apply (Steps (a -> b, (a, r)) -> Steps (b, r))
-> (state -> Steps (a -> b, (a, r))) -> state -> Steps (b, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
.) ((state -> Steps (a -> b, (a, r))) -> state -> Steps (b, r))
-> ((state -> Steps r) -> state -> Steps (a -> b, (a, r)))
-> (state -> Steps r)
-> state
-> Steps (b, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. ((state -> Steps (a, r)) -> state -> Steps (a -> b, (a, r))
forall r. (state -> Steps r) -> state -> Steps (a -> b, r)
pf ((state -> Steps (a, r)) -> state -> Steps (a -> b, (a, r)))
-> ((state -> Steps r) -> state -> Steps (a, r))
-> (state -> Steps r)
-> state
-> Steps (a -> b, (a, r))
forall t t t. (t -> t) -> (t -> t) -> t -> t
.(state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
qf))
( (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr ((state -> Steps r) -> state -> Steps r)
-> ((state -> Steps r) -> state -> Steps r)
-> (state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr)
T forall r. (a -> state -> Steps r) -> state -> Steps r
ph forall r. (state -> Steps r) -> state -> Steps (a, r)
pf forall r. (state -> Steps r) -> state -> Steps r
pr <* :: T state a -> T state b -> T state a
<* ~(T forall r. (b -> state -> Steps r) -> state -> Steps r
_ forall r. (state -> Steps r) -> state -> Steps (b, r)
_ forall r. (state -> Steps r) -> state -> Steps r
qr) = (forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
ph((a -> state -> Steps r) -> state -> Steps r)
-> ((a -> state -> Steps r) -> a -> state -> Steps r)
-> (a -> state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. ((state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr((state -> Steps r) -> state -> Steps r)
-> (a -> state -> Steps r) -> a -> state -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
.)) ((state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
pf((state -> Steps r) -> state -> Steps (a, r))
-> ((state -> Steps r) -> state -> Steps r)
-> (state -> Steps r)
-> state
-> Steps (a, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr) ((state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr ((state -> Steps r) -> state -> Steps r)
-> ((state -> Steps r) -> state -> Steps r)
-> (state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr)
T forall r. (a -> state -> Steps r) -> state -> Steps r
_ forall r. (state -> Steps r) -> state -> Steps (a, r)
_ forall r. (state -> Steps r) -> state -> Steps r
pr *> :: T state a -> T state b -> T state b
*> ~(T forall r. (b -> state -> Steps r) -> state -> Steps r
qh forall r. (state -> Steps r) -> state -> Steps (b, r)
qf forall r. (state -> Steps r) -> state -> Steps r
qr ) = (forall r. (b -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (b, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state b
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr ((state -> Steps r) -> state -> Steps r)
-> ((b -> state -> Steps r) -> state -> Steps r)
-> (b -> state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (b -> state -> Steps r) -> state -> Steps r
forall r. (b -> state -> Steps r) -> state -> Steps r
qh ) ((state -> Steps (b, r)) -> state -> Steps (b, r)
forall r. (state -> Steps r) -> state -> Steps r
pr((state -> Steps (b, r)) -> state -> Steps (b, r))
-> ((state -> Steps r) -> state -> Steps (b, r))
-> (state -> Steps r)
-> state
-> Steps (b, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps (b, r)
forall r. (state -> Steps r) -> state -> Steps (b, r)
qf) ((state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr ((state -> Steps r) -> state -> Steps r)
-> ((state -> Steps r) -> state -> Steps r)
-> (state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr)
pure :: a -> T state a
pure a
a = (forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ((a -> state -> Steps r) -> a -> state -> Steps r
forall a b. (a -> b) -> a -> b
$a
a) ((a -> Steps r -> Steps (a, r)
forall v r. v -> Steps r -> Steps (v, r)
push a
a)(Steps r -> Steps (a, r))
-> (state -> Steps r) -> state -> Steps (a, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
.) forall a. a -> a
forall r. (state -> Steps r) -> state -> Steps r
id
instance Alternative (T state) where
T forall r. (a -> state -> Steps r) -> state -> Steps r
ph forall r. (state -> Steps r) -> state -> Steps (a, r)
pf forall r. (state -> Steps r) -> state -> Steps r
pr <|> :: T state a -> T state a -> T state a
<|> T forall r. (a -> state -> Steps r) -> state -> Steps r
qh forall r. (state -> Steps r) -> state -> Steps (a, r)
qf forall r. (state -> Steps r) -> state -> Steps r
qr = (forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T (\ a -> state -> Steps r
k state
inp -> (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
ph a -> state -> Steps r
k state
inp Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`best` (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
qh a -> state -> Steps r
k state
inp)
(\ state -> Steps r
k state
inp -> (state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
pf state -> Steps r
k state
inp Steps (a, r) -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a -> Steps a
`best` (state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
qf state -> Steps r
k state
inp)
(\ state -> Steps r
k state
inp -> (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr state -> Steps r
k state
inp Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`best` (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr state -> Steps r
k state
inp)
empty :: T state a
empty = (forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ a -> state -> Steps r
k state
inp -> Steps r
forall a. Steps a
noAlts) ( \ state -> Steps r
k state
inp -> Steps (a, r)
forall a. Steps a
noAlts) ( \ state -> Steps r
k state
inp -> Steps r
forall a. Steps a
noAlts)
data P st a = P (T st a)
(Maybe (T st a))
(Maybe a)
Nat
instance Show (P st a) where
show :: P st a -> String
show (P T st a
_ Maybe (T st a)
nt Maybe a
e Nat
n) = String
"P _ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (T st a -> String) -> Maybe (T st a) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Nothing" (String -> T st a -> String
forall a b. a -> b -> a
const String
"(Just _)") Maybe (T st a)
nt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Nothing" (String -> a -> String
forall a b. a -> b -> a
const String
"(Just _)") Maybe a
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Nat -> String
forall a. Show a => a -> String
show Nat
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") "
getOneP :: P a b -> Maybe (P a b)
getOneP :: P a b -> Maybe (P a b)
getOneP (P T a b
_ Maybe (T a b)
Nothing Maybe b
_ Nat
l) = Maybe (P a b)
forall a. Maybe a
Nothing
getOneP (P T a b
_ Maybe (T a b)
onep Maybe b
ep Nat
l) = P a b -> Maybe (P a b)
forall a. a -> Maybe a
Just( Maybe (T a b) -> Maybe b -> Nat -> P a b
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T a b)
onep Maybe b
forall a. Maybe a
Nothing Nat
l)
getZeroP :: P t a -> Maybe a
getZeroP :: P t a -> Maybe a
getZeroP (P T t a
_ Maybe (T t a)
_ Maybe a
z Nat
_) = Maybe a
z
mkParser :: Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser :: Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st a)
np Maybe a
ne Nat
l = T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P (Maybe (T st a) -> Maybe a -> T st a
forall (f :: * -> *) a.
Alternative f =>
Maybe (f a) -> Maybe a -> f a
mkParser' Maybe (T st a)
np Maybe a
ne) Maybe (T st a)
np Maybe a
ne Nat
l
where mkParser' :: Maybe (f a) -> Maybe a -> f a
mkParser' np :: Maybe (f a)
np@(Just f a
nt) ne :: Maybe a
ne@Maybe a
Nothing = f a
nt
mkParser' np :: Maybe (f a)
np@Maybe (f a)
Nothing ne :: Maybe a
ne@(Just a
a) = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
mkParser' np :: Maybe (f a)
np@(Just f a
nt) ne :: Maybe a
ne@(Just a
a) = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
nt
mkParser' np :: Maybe (f a)
np@(Maybe (f a)
Nothing) ne :: Maybe a
ne@(Maybe a
Nothing) = f a
forall (f :: * -> *) a. Alternative f => f a
empty
combine :: (Alternative f) => Maybe t1 -> Maybe t2 -> t -> Maybe t3
-> (t1 -> t -> f a) -> (t2 -> t3 -> f a) -> Maybe (f a)
combine :: Maybe t1
-> Maybe t2
-> t
-> Maybe t3
-> (t1 -> t -> f a)
-> (t2 -> t3 -> f a)
-> Maybe (f a)
combine Maybe t1
Nothing Maybe t2
Nothing t
_ Maybe t3
_ t1 -> t -> f a
_ t2 -> t3 -> f a
_ = Maybe (f a)
forall a. Maybe a
Nothing
combine (Just t1
p) Maybe t2
Nothing t
aq Maybe t3
_ t1 -> t -> f a
op1 t2 -> t3 -> f a
op2 = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (t1
p t1 -> t -> f a
`op1` t
aq)
combine (Just t1
p) (Just t2
v) t
aq Maybe t3
nq t1 -> t -> f a
op1 t2 -> t3 -> f a
op2 = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (case Maybe t3
nq of
Just t3
nnq -> t1
p t1 -> t -> f a
`op1` t
aq f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> t2
v t2 -> t3 -> f a
`op2` t3
nnq
Maybe t3
Nothing -> t1
p t1 -> t -> f a
`op1` t
aq
)
combine Maybe t1
Nothing (Just t2
v) t
_ Maybe t3
nq t1 -> t -> f a
_ t2 -> t3 -> f a
op2 = case Maybe t3
nq of
Just t3
nnq -> f a -> Maybe (f a)
forall a. a -> Maybe a
Just (t2
v t2 -> t3 -> f a
`op2` t3
nnq)
Maybe t3
Nothing -> Maybe (f a)
forall a. Maybe a
Nothing
instance Functor (P state) where
fmap :: (a -> b) -> P state a -> P state b
fmap a -> b
f (P T state a
ap Maybe (T state a)
np Maybe a
me Nat
l) = T state b -> Maybe (T state b) -> Maybe b -> Nat -> P state b
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P ((a -> b) -> T state a -> T state b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f T state a
ap) ((T state a -> T state b) -> Maybe (T state a) -> Maybe (T state b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> T state a -> T state b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Maybe (T state a)
np) (a -> b
f (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
me) Nat
l
a
f <$ :: a -> P state b -> P state a
<$ (P T state b
ap Maybe (T state b)
np Maybe b
me Nat
l) = T state a -> Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P (a
f a -> T state b -> T state a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ T state b
ap) ((T state b -> T state a) -> Maybe (T state b) -> Maybe (T state a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
f a -> T state b -> T state a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) Maybe (T state b)
np) (a
f a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe b
me) Nat
l
instance Applicative (P state) where
P T state (a -> b)
ap Maybe (T state (a -> b))
np Maybe (a -> b)
pe Nat
pl <*> :: P state (a -> b) -> P state a -> P state b
<*> ~(P T state a
aq Maybe (T state a)
nq Maybe a
qe Nat
ql) = String -> P state b -> P state b
forall b. String -> b -> b
trace'' String
"<*>" (Maybe (T state b) -> Maybe b -> Nat -> P state b
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser (Maybe (T state (a -> b))
-> Maybe (a -> b)
-> T state a
-> Maybe (T state a)
-> (T state (a -> b) -> T state a -> T state b)
-> ((a -> b) -> T state a -> T state b)
-> Maybe (T state b)
forall (f :: * -> *) t1 t2 t t3 a.
Alternative f =>
Maybe t1
-> Maybe t2
-> t
-> Maybe t3
-> (t1 -> t -> f a)
-> (t2 -> t3 -> f a)
-> Maybe (f a)
combine Maybe (T state (a -> b))
np Maybe (a -> b)
pe T state a
aq Maybe (T state a)
nq T state (a -> b) -> T state a -> T state b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (a -> b) -> T state a -> T state b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>)) (Maybe (a -> b)
pe Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
qe) (Nat -> Nat -> Nat
nat_add Nat
pl Nat
ql))
P T state a
ap Maybe (T state a)
np Maybe a
pe Nat
pl <* :: P state a -> P state b -> P state a
<* ~(P T state b
aq Maybe (T state b)
nq Maybe b
qe Nat
ql) = String -> P state a -> P state a
forall b. String -> b -> b
trace'' String
"<* " (Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser (Maybe (T state a)
-> Maybe a
-> T state b
-> Maybe (T state b)
-> (T state a -> T state b -> T state a)
-> (a -> T state b -> T state a)
-> Maybe (T state a)
forall (f :: * -> *) t1 t2 t t3 a.
Alternative f =>
Maybe t1
-> Maybe t2
-> t
-> Maybe t3
-> (t1 -> t -> f a)
-> (t2 -> t3 -> f a)
-> Maybe (f a)
combine Maybe (T state a)
np Maybe a
pe T state b
aq Maybe (T state b)
nq T state a -> T state b -> T state a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*) a -> T state b -> T state a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$)) (Maybe a
pe Maybe a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Maybe b
qe ) (Nat -> Nat -> Nat
nat_add Nat
pl Nat
ql))
P T state a
ap Maybe (T state a)
np Maybe a
pe Nat
pl *> :: P state a -> P state b -> P state b
*> ~(P T state b
aq Maybe (T state b)
nq Maybe b
qe Nat
ql) = String -> P state b -> P state b
forall b. String -> b -> b
trace'' String
" *>" (Maybe (T state b) -> Maybe b -> Nat -> P state b
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser (Maybe (T state a)
-> Maybe a
-> T state b
-> Maybe (T state b)
-> (T state a -> T state b -> T state b)
-> (a -> T state b -> T state b)
-> Maybe (T state b)
forall (f :: * -> *) t1 t2 t t3 a.
Alternative f =>
Maybe t1
-> Maybe t2
-> t
-> Maybe t3
-> (t1 -> t -> f a)
-> (t2 -> t3 -> f a)
-> Maybe (f a)
combine Maybe (T state a)
np Maybe a
pe T state b
aq Maybe (T state b)
nq T state a -> T state b -> T state b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) ((T state b -> a -> T state b) -> a -> T state b -> T state b
forall a b c. (a -> b -> c) -> b -> a -> c
flip T state b -> a -> T state b
forall a b. a -> b -> a
const)) (Maybe a
pe Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe b
qe ) (Nat -> Nat -> Nat
nat_add Nat
pl Nat
ql))
pure :: a -> P state a
pure a
a = String -> P state a -> P state a
forall b. String -> b -> b
trace'' String
"pure" (Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T state a)
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just a
a) Nat
Zero)
instance Alternative (P state) where
(P T state a
ap Maybe (T state a)
np Maybe a
pe Nat
pl) <|> :: P state a -> P state a -> P state a
<|> (P T state a
aq Maybe (T state a)
nq Maybe a
qe Nat
ql)
= let pl' :: Nat
pl' = Nat -> (a -> Nat) -> Maybe a -> Nat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Nat
pl (Nat -> a -> Nat
forall a b. a -> b -> a
const Nat
Zero) Maybe a
pe
ql' :: Nat
ql' = Nat -> (a -> Nat) -> Maybe a -> Nat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Nat
ql (Nat -> a -> Nat
forall a b. a -> b -> a
const Nat
Zero) Maybe a
qe
(Nat
rl', Bool
b) = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"calling natMin from <|>" (Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
pl' Nat
ql' Int
0)
(Nat
rl, Bool
_) = Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
pl Nat
ql Int
0
Maybe (f a)
Nothing alt :: Maybe (f a) -> Maybe (f a) -> Maybe (f a)
`alt` Maybe (f a)
q = Maybe (f a)
q
Maybe (f a)
p `alt` Maybe (f a)
Nothing = Maybe (f a)
p
Just f a
p `alt` Just f a
q = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (f a
p f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
q)
in Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser ((if Bool
b then (Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a))
-> Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a)
forall a. a -> a
id else (Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a))
-> Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip) Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a)
forall (f :: * -> *) a.
Alternative f =>
Maybe (f a) -> Maybe (f a) -> Maybe (f a)
alt Maybe (T state a)
np Maybe (T state a)
nq) (Maybe a
pe Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
qe) Nat
rl
empty :: P state a
empty = Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T state a)
forall (f :: * -> *) a. Alternative f => f a
empty Maybe a
forall (f :: * -> *) a. Alternative f => f a
empty Nat
Infinite
instance ExtAlternative (P st) where
~(P T st a
ap Maybe (T st a)
np Maybe a
pe Nat
pl) <<|> :: P st a -> P st a -> P st a
<<|> ~(P T st a
aq Maybe (T st a)
nq Maybe a
qe Nat
ql)
= let pl' :: Nat
pl' = Nat -> (a -> Nat) -> Maybe a -> Nat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Nat
pl (Nat -> a -> Nat
forall a b. a -> b -> a
const Nat
Zero) Maybe a
pe
ql' :: Nat
ql' = Nat -> (a -> Nat) -> Maybe a -> Nat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Nat
ql (Nat -> a -> Nat
forall a b. a -> b -> a
const Nat
Zero) Maybe a
qe
(Nat
rl', Bool
b) = Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
pl' Nat
ql' Int
0
(Nat
rl, Bool
_) = Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
pl Nat
ql Int
0
bestx :: Steps a -> Steps a -> Steps a
bestx :: Steps a -> Steps a -> Steps a
bestx = (if Bool
b then (Steps a -> Steps a -> Steps a) -> Steps a -> Steps a -> Steps a
forall a. a -> a
id else (Steps a -> Steps a -> Steps a) -> Steps a -> Steps a -> Steps a
forall a b c. (a -> b -> c) -> b -> a -> c
flip) Steps a -> Steps a -> Steps a
forall a. Steps a -> Steps a -> Steps a
best
choose:: T st a -> T st a -> T st a
choose :: T st a -> T st a -> T st a
choose (T forall r. (a -> st -> Steps r) -> st -> Steps r
ph forall r. (st -> Steps r) -> st -> Steps (a, r)
pf forall r. (st -> Steps r) -> st -> Steps r
pr) (T forall r. (a -> st -> Steps r) -> st -> Steps r
qh forall r. (st -> Steps r) -> st -> Steps (a, r)
qf forall r. (st -> Steps r) -> st -> Steps r
qr)
= (forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T (\ a -> st -> Steps r
k st
st -> let left :: Steps r
left = Steps r -> Steps r
forall a. Steps a -> Steps a
norm ((a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
ph a -> st -> Steps r
k st
st)
in if Steps r -> Bool
forall t. Steps t -> Bool
has_success Steps r
left then Steps r
left else Steps r
left Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`bestx` (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
qh a -> st -> Steps r
k st
st)
(\ st -> Steps r
k st
st -> let left :: Steps (a, r)
left = Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a
norm ((st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
pf st -> Steps r
k st
st)
in if Steps (a, r) -> Bool
forall t. Steps t -> Bool
has_success Steps (a, r)
left then Steps (a, r)
left else Steps (a, r)
left Steps (a, r) -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a -> Steps a
`bestx` (st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
qf st -> Steps r
k st
st)
(\ st -> Steps r
k st
st -> let left :: Steps r
left = Steps r -> Steps r
forall a. Steps a -> Steps a
norm ((st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
pr st -> Steps r
k st
st)
in if Steps r -> Bool
forall t. Steps t -> Bool
has_success Steps r
left then Steps r
left else Steps r
left Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`bestx` (st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
qr st -> Steps r
k st
st)
in T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P (T st a -> T st a -> T st a
forall state a. T state a -> T state a -> T state a
choose T st a
ap T st a
aq )
(Maybe (T st a)
-> (T st a -> Maybe (T st a)) -> Maybe (T st a) -> Maybe (T st a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (T st a)
np (\T st a
nqq -> Maybe (T st a)
-> (T st a -> Maybe (T st a)) -> Maybe (T st a) -> Maybe (T st a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (T st a)
nq (\T st a
npp -> T st a -> Maybe (T st a)
forall (m :: * -> *) a. Monad m => a -> m a
return( T st a -> T st a -> T st a
forall state a. T state a -> T state a -> T state a
choose T st a
npp T st a
nqq)) Maybe (T st a)
np) Maybe (T st a)
nq)
(Maybe a
pe Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
qe)
Nat
rl
P T st a
_ Maybe (T st a)
np Maybe a
pe Nat
pl <?> :: P st a -> String -> P st a
<?> String
label = let replaceExpected :: Steps a -> Steps a
replaceExpected :: Steps a -> Steps a
replaceExpected (Fail Strings
_ [Strings -> (Int, Steps a)]
c) = (Strings -> [Strings -> (Int, Steps a)] -> Steps a
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
label] [Strings -> (Int, Steps a)]
c)
replaceExpected Steps a
others = Steps a
others
nnp :: Maybe (T st a)
nnp = case Maybe (T st a)
np of Maybe (T st a)
Nothing -> Maybe (T st a)
forall a. Maybe a
Nothing
Just ((T forall r. (a -> st -> Steps r) -> st -> Steps r
ph forall r. (st -> Steps r) -> st -> Steps (a, r)
pf forall r. (st -> Steps r) -> st -> Steps r
pr)) -> T st a -> Maybe (T st a)
forall a. a -> Maybe a
Just((forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ a -> st -> Steps r
k st
inp -> Steps r -> Steps r
forall a. Steps a -> Steps a
replaceExpected (Steps r -> Steps r
forall a. Steps a -> Steps a
norm ( (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
ph a -> st -> Steps r
k st
inp)))
( \ st -> Steps r
k st
inp -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a
replaceExpected (Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a
norm ( (st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
pf st -> Steps r
k st
inp)))
( \ st -> Steps r
k st
inp -> Steps r -> Steps r
forall a. Steps a -> Steps a
replaceExpected (Steps r -> Steps r
forall a. Steps a -> Steps a
norm ( (st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
pr st -> Steps r
k st
inp))))
in Maybe (T st a) -> Maybe a -> Nat -> P st a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st a)
nnp Maybe a
pe Nat
pl
must_be_non_empty :: String -> P st a -> c -> c
must_be_non_empty String
msg p :: P st a
p@(P T st a
_ Maybe (T st a)
_ (Just a
_) Nat
_) c
_
= String -> c
forall a. HasCallStack => String -> a
error (String
"The combinator " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" requires that its argument cannot recognise the empty string\n")
must_be_non_empty String
_ P st a
_ c
q = c
q
must_be_non_empties :: String -> P st a -> P st b -> c -> c
must_be_non_empties String
msg (P T st a
_ Maybe (T st a)
_ (Just a
_) Nat
_) (P T st b
_ Maybe (T st b)
_ (Just b
_) Nat
_) c
_
= String -> c
forall a. HasCallStack => String -> a
error (String
"The combinator " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" requires that not both arguments can recognise the empty string\n")
must_be_non_empties String
_ P st a
_ P st b
_ c
q = c
q
instance IsParser (P st)
instance Monad (P st) where
p :: P st a
p@(P T st a
ap Maybe (T st a)
np Maybe a
pe Nat
pl ) >>= :: P st a -> (a -> P st b) -> P st b
>>= a -> P st b
a2q =
(T st b -> Maybe (T st b) -> Maybe b -> Nat -> P st b
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P T st b
newap Maybe (T st b)
newnp Maybe b
newep (Nat -> Nat -> Nat
nat_add Nat
pl Nat
Hole))
where (Maybe b
newep, Maybe (T st b)
newnp, T st b
newap) = case Maybe a
pe of
Maybe a
Nothing -> (Maybe b
forall a. Maybe a
Nothing, Maybe (T st b)
t, T st b -> (T st b -> T st b) -> Maybe (T st b) -> T st b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T st b
forall (f :: * -> *) a. Alternative f => f a
empty T st b -> T st b
forall a. a -> a
id Maybe (T st b)
t)
Just a
a -> let P T st b
aq Maybe (T st b)
nq Maybe b
eq Nat
lq = a -> P st b
a2q a
a
in (Maybe b
eq, Maybe (T st b) -> Maybe (T st b) -> Maybe (T st b)
forall (f :: * -> *) a.
Alternative f =>
Maybe (f a) -> Maybe (f a) -> Maybe (f a)
combine Maybe (T st b)
t Maybe (T st b)
nq , Maybe (T st b)
t Maybe (T st b) -> T st b -> T st b
forall (f :: * -> *) a. Alternative f => Maybe (f a) -> f a -> f a
`alt` T st b
aq)
Maybe (f a)
Nothing alt :: Maybe (f a) -> f a -> f a
`alt` f a
q = f a
q
Just f a
p `alt` f a
q = f a
p f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
q
t :: Maybe (T st b)
t = (T st a -> T st b) -> Maybe (T st a) -> Maybe (T st b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (T forall r. (a -> st -> Steps r) -> st -> Steps r
h forall r. (st -> Steps r) -> st -> Steps (a, r)
_ forall r. (st -> Steps r) -> st -> Steps r
_ ) -> ((forall r. (b -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (b, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st b
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \b -> st -> Steps r
k -> (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
h (\ a
a -> P st b -> (b -> st -> Steps r) -> st -> Steps r
forall b a r. P b a -> (a -> b -> Steps r) -> b -> Steps r
unParser_h (a -> P st b
a2q a
a) b -> st -> Steps r
k))
( \st -> Steps r
k -> (a -> st -> Steps (b, r)) -> st -> Steps (b, r)
forall r. (a -> st -> Steps r) -> st -> Steps r
h (\ a
a -> P st b -> (st -> Steps r) -> st -> Steps (b, r)
forall b a r. P b a -> (b -> Steps r) -> b -> Steps (a, r)
unParser_f (a -> P st b
a2q a
a) st -> Steps r
k))
( \st -> Steps r
k -> (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
h (\ a
a -> P st b -> (st -> Steps r) -> st -> Steps r
forall b a r. P b a -> (b -> Steps r) -> b -> Steps r
unParser_r (a -> P st b
a2q a
a) st -> Steps r
k))) ) Maybe (T st a)
np
combine :: Maybe (f a) -> Maybe (f a) -> Maybe (f a)
combine Maybe (f a)
Nothing Maybe (f a)
Nothing = Maybe (f a)
forall a. Maybe a
Nothing
combine l :: Maybe (f a)
l@(Just f a
_ ) Maybe (f a)
Nothing = Maybe (f a)
l
combine Maybe (f a)
Nothing r :: Maybe (f a)
r@(Just f a
_ ) = Maybe (f a)
r
combine (Just f a
l) (Just f a
r) = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (f a
l f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
r)
unParser_h :: P b a -> (a -> b -> Steps r) -> b -> Steps r
unParser_h :: P b a -> (a -> b -> Steps r) -> b -> Steps r
unParser_h (P (T forall r. (a -> b -> Steps r) -> b -> Steps r
h forall r. (b -> Steps r) -> b -> Steps (a, r)
_ forall r. (b -> Steps r) -> b -> Steps r
_ ) Maybe (T b a)
_ Maybe a
_ Nat
_ ) = (a -> b -> Steps r) -> b -> Steps r
forall r. (a -> b -> Steps r) -> b -> Steps r
h
unParser_f :: P b a -> (b -> Steps r) -> b -> Steps (a, r)
unParser_f :: P b a -> (b -> Steps r) -> b -> Steps (a, r)
unParser_f (P (T forall r. (a -> b -> Steps r) -> b -> Steps r
_ forall r. (b -> Steps r) -> b -> Steps (a, r)
f forall r. (b -> Steps r) -> b -> Steps r
_ ) Maybe (T b a)
_ Maybe a
_ Nat
_ ) = (b -> Steps r) -> b -> Steps (a, r)
forall r. (b -> Steps r) -> b -> Steps (a, r)
f
unParser_r :: P b a -> (b -> Steps r) -> b -> Steps r
unParser_r :: P b a -> (b -> Steps r) -> b -> Steps r
unParser_r (P (T forall r. (a -> b -> Steps r) -> b -> Steps r
_ forall r. (b -> Steps r) -> b -> Steps (a, r)
_ forall r. (b -> Steps r) -> b -> Steps r
r ) Maybe (T b a)
_ Maybe a
_ Nat
_ ) = (b -> Steps r) -> b -> Steps r
forall r. (b -> Steps r) -> b -> Steps r
r
return :: a -> P st a
return = a -> P st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
pSymExt :: (forall a. (token -> state -> Steps a) -> state -> Steps a) -> Nat -> Maybe token -> P state token
pSymExt :: (forall a. (token -> state -> Steps a) -> state -> Steps a)
-> Nat -> Maybe token -> P state token
pSymExt forall a. (token -> state -> Steps a) -> state -> Steps a
splitState Nat
l Maybe token
e = Maybe (T state token) -> Maybe token -> Nat -> P state token
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser (T state token -> Maybe (T state token)
forall a. a -> Maybe a
Just T state token
t) Maybe token
e Nat
l
where t :: T state token
t = (forall a. (token -> state -> Steps a) -> state -> Steps a)
-> (forall r. (state -> Steps r) -> state -> Steps (token, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state token
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( (token -> state -> Steps r) -> state -> Steps r
forall a. (token -> state -> Steps a) -> state -> Steps a
splitState )
( \ state -> Steps r
k -> (token -> state -> Steps (token, r)) -> state -> Steps (token, r)
forall a. (token -> state -> Steps a) -> state -> Steps a
splitState (\ token
t -> token -> Steps r -> Steps (token, r)
forall v r. v -> Steps r -> Steps (v, r)
push token
t (Steps r -> Steps (token, r))
-> (state -> Steps r) -> state -> Steps (token, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. state -> Steps r
k) )
( \ state -> Steps r
k -> (token -> state -> Steps r) -> state -> Steps r
forall a. (token -> state -> Steps a) -> state -> Steps a
splitState (\ token
_ -> state -> Steps r
k ) )
micro :: P state a -> Int -> P state a
P T state a
_ Maybe (T state a)
np Maybe a
pe Nat
pl micro :: P state a -> Int -> P state a
`micro` Int
i
= let nnp :: Maybe (T state a)
nnp = (T state a -> T state a) -> Maybe (T state a) -> Maybe (T state a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (T forall r. (a -> state -> Steps r) -> state -> Steps r
ph forall r. (state -> Steps r) -> state -> Steps (a, r)
pf forall r. (state -> Steps r) -> state -> Steps r
pr) -> ((forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ a -> state -> Steps r
k state
st -> (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
ph (\ a
a state
st -> Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Micro Int
i (a -> state -> Steps r
k a
a state
st)) state
st)
( \ state -> Steps r
k state
st -> (state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
pf (Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Micro Int
i (Steps r -> Steps r) -> (state -> Steps r) -> state -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
.state -> Steps r
k) state
st)
( \ state -> Steps r
k state
st -> (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr (Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Micro Int
i (Steps r -> Steps r) -> (state -> Steps r) -> state -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
.state -> Steps r
k) state
st))) Maybe (T state a)
np
in Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T state a)
nnp Maybe a
pe Nat
pl
amb :: P st a -> P st [a]
amb :: P st a -> P st [a]
amb (P T st a
_ Maybe (T st a)
np Maybe a
pe Nat
pl)
= let combinevalues :: Steps [(a,r)] -> Steps ([a],r)
combinevalues :: Steps [(a, r)] -> Steps ([a], r)
combinevalues Steps [(a, r)]
lar = ([(a, r)] -> ([a], r)) -> Steps [(a, r)] -> Steps ([a], r)
forall a b. (b -> a) -> Steps b -> Steps a
Apply (\ [(a, r)]
lar -> (((a, r) -> a) -> [(a, r)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, r) -> a
forall a b. (a, b) -> a
fst [(a, r)]
lar, (a, r) -> r
forall a b. (a, b) -> b
snd ([(a, r)] -> (a, r)
forall a. [a] -> a
head [(a, r)]
lar))) Steps [(a, r)]
lar
nnp :: Maybe (T st [a])
nnp = case Maybe (T st a)
np of
Maybe (T st a)
Nothing -> Maybe (T st [a])
forall a. Maybe a
Nothing
Just ((T forall r. (a -> st -> Steps r) -> st -> Steps r
ph forall r. (st -> Steps r) -> st -> Steps (a, r)
pf forall r. (st -> Steps r) -> st -> Steps r
pr)) -> T st [a] -> Maybe (T st [a])
forall a. a -> Maybe a
Just((forall r. ([a] -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps ([a], r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st [a]
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \[a] -> st -> Steps r
k -> Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h (Steps (a, r) -> Steps r) -> (st -> Steps (a, r)) -> st -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (a -> st -> Steps (a, r)) -> st -> Steps (a, r)
forall r. (a -> st -> Steps r) -> st -> Steps r
ph (\ a
a st
st' -> ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([a
a], \ [a]
as -> [a] -> st -> Steps r
k [a]
as st
st') Steps (a, r)
forall a. Steps a
noAlts))
( \st -> Steps r
k st
inp -> Steps [(a, r)] -> Steps ([a], r)
forall a r. Steps [(a, r)] -> Steps ([a], r)
combinevalues (Steps [(a, r)] -> Steps ([a], r))
-> (Steps (a, r) -> Steps [(a, r)])
-> Steps (a, r)
-> Steps ([a], r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. Steps (a, r) -> Steps [(a, r)]
forall r. Steps r -> Steps [r]
removeEnd_f (Steps (a, r) -> Steps ([a], r)) -> Steps (a, r) -> Steps ([a], r)
forall a b. (a -> b) -> a -> b
$ (st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
pf (\st
st -> [Steps r] -> Steps r -> Steps r
forall a. [Steps a] -> Steps a -> Steps a
End_f [st -> Steps r
k st
st] Steps r
forall a. Steps a
noAlts) st
inp)
( \st -> Steps r
k -> Steps (Any, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h (Steps (Any, r) -> Steps r)
-> (st -> Steps (Any, r)) -> st -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (st -> Steps (Any, r)) -> st -> Steps (Any, r)
forall r. (st -> Steps r) -> st -> Steps r
pr (\ st
st' -> ([Any], [Any] -> Steps r) -> Steps (Any, r) -> Steps (Any, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([Any
forall a. HasCallStack => a
undefined], \ [Any]
_ -> st -> Steps r
k st
st') Steps (Any, r)
forall a. Steps a
noAlts)))
nep :: Maybe [a]
nep = ((a -> [a]) -> Maybe a -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
pe)
in Maybe (T st [a]) -> Maybe [a] -> Nat -> P st [a]
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st [a])
nnp Maybe [a]
nep Nat
pl
pErrors :: StoresErrors st error => P st [error]
pErrors :: P st [error]
pErrors = let nnp :: Maybe (T st [error])
nnp = T st [error] -> Maybe (T st [error])
forall a. a -> Maybe a
Just ((forall r. ([error] -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps ([error], r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st [error]
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ [error] -> st -> Steps r
k st
inp -> let ([error]
errs, st
inp') = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp in [error] -> st -> Steps r
k [error]
errs st
inp' )
( \ st -> Steps r
k st
inp -> let ([error]
errs, st
inp') = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp in [error] -> Steps r -> Steps ([error], r)
forall v r. v -> Steps r -> Steps (v, r)
push [error]
errs (st -> Steps r
k st
inp'))
( \ st -> Steps r
k st
inp -> let ([error]
errs, st
inp') = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp in st -> Steps r
k st
inp' ))
in Maybe (T st [error]) -> Maybe [error] -> Nat -> P st [error]
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st [error])
nnp Maybe [error]
forall a. Maybe a
Nothing Nat
Zero
pPos :: HasPosition st pos => P st pos
pPos :: P st pos
pPos = let nnp :: Maybe (T st pos)
nnp = T st pos -> Maybe (T st pos)
forall a. a -> Maybe a
Just ( (forall r. (pos -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (pos, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st pos
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ pos -> st -> Steps r
k st
inp -> let pos :: pos
pos = st -> pos
forall state pos. HasPosition state pos => state -> pos
getPos st
inp in pos -> st -> Steps r
k pos
pos st
inp )
( \ st -> Steps r
k st
inp -> let pos :: pos
pos = st -> pos
forall state pos. HasPosition state pos => state -> pos
getPos st
inp in pos -> Steps r -> Steps (pos, r)
forall v r. v -> Steps r -> Steps (v, r)
push pos
pos (st -> Steps r
k st
inp))
( \ st -> Steps r
k st
inp -> st -> Steps r
k st
inp ))
in Maybe (T st pos) -> Maybe pos -> Nat -> P st pos
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st pos)
nnp Maybe pos
forall a. Maybe a
Nothing Nat
Zero
pState :: P st st
pState :: P st st
pState = let nnp :: Maybe (T a a)
nnp = T a a -> Maybe (T a a)
forall a. a -> Maybe a
Just ( (forall r. (a -> a -> Steps r) -> a -> Steps r)
-> (forall r. (a -> Steps r) -> a -> Steps (a, r))
-> (forall r. (a -> Steps r) -> a -> Steps r)
-> T a a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ a -> a -> Steps r
k a
inp -> a -> a -> Steps r
k a
inp a
inp)
( \ a -> Steps r
k a
inp -> a -> Steps r -> Steps (a, r)
forall v r. v -> Steps r -> Steps (v, r)
push a
inp (a -> Steps r
k a
inp))
forall r. (a -> Steps r) -> a -> Steps r
forall a b. (a -> b) -> a -> b
($))
in Maybe (T st st) -> Maybe st -> Nat -> P st st
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st st)
forall a. Maybe (T a a)
nnp Maybe st
forall a. Maybe a
Nothing Nat
Zero
pEnd :: (StoresErrors st error, Eof st) => P st [error]
pEnd :: P st [error]
pEnd = let nnp :: Maybe (T st [error])
nnp = T st [error] -> Maybe (T st [error])
forall a. a -> Maybe a
Just ( (forall r. ([error] -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps ([error], r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st [error]
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ [error] -> st -> Steps r
k st
inp -> let deleterest :: st -> Steps r
deleterest st
inp = case st -> Maybe (Int, st)
forall state. Eof state => state -> Maybe (Int, state)
deleteAtEnd st
inp of
Maybe (Int, st)
Nothing -> let ([error]
finalerrors, st
finalstate) = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp
in [error] -> st -> Steps r
k [error]
finalerrors st
finalstate
Just (Int
i, st
inp') -> Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [] [(Int, Steps r) -> Strings -> (Int, Steps r)
forall a b. a -> b -> a
const (Int
i, st -> Steps r
deleterest st
inp')]
in st -> Steps r
deleterest st
inp)
( \ st -> Steps r
k st
inp -> let deleterest :: st -> Steps ([error], r)
deleterest st
inp = case st -> Maybe (Int, st)
forall state. Eof state => state -> Maybe (Int, state)
deleteAtEnd st
inp of
Maybe (Int, st)
Nothing -> let ([error]
finalerrors, st
finalstate) = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp
in [error] -> Steps r -> Steps ([error], r)
forall v r. v -> Steps r -> Steps (v, r)
push [error]
finalerrors (st -> Steps r
k st
finalstate)
Just (Int
i, st
inp') -> Strings
-> [Strings -> (Int, Steps ([error], r))] -> Steps ([error], r)
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [] [(Int, Steps ([error], r)) -> Strings -> (Int, Steps ([error], r))
forall a b. a -> b -> a
const ((Int
i, st -> Steps ([error], r)
deleterest st
inp'))]
in st -> Steps ([error], r)
deleterest st
inp)
( \ st -> Steps r
k st
inp -> let deleterest :: st -> Steps r
deleterest st
inp = case st -> Maybe (Int, st)
forall state. Eof state => state -> Maybe (Int, state)
deleteAtEnd st
inp of
Maybe (Int, st)
Nothing -> let ([error]
finalerrors, st
finalstate) = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp
in (st -> Steps r
k st
finalstate)
Just (Int
i, st
inp') -> Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [] [(Int, Steps r) -> Strings -> (Int, Steps r)
forall a b. a -> b -> a
const (Int
i, st -> Steps r
deleterest st
inp')]
in st -> Steps r
deleterest st
inp))
in Maybe (T st [error]) -> Maybe [error] -> Nat -> P st [error]
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st [error])
nnp Maybe [error]
forall a. Maybe a
Nothing Nat
Zero
pSwitch :: (st1 -> (st2, st2 -> st1)) -> P st2 a -> P st1 a
pSwitch :: (st1 -> (st2, st2 -> st1)) -> P st2 a -> P st1 a
pSwitch st1 -> (st2, st2 -> st1)
split (P T st2 a
_ Maybe (T st2 a)
np Maybe a
pe Nat
pl)
= let nnp :: Maybe (T st1 a)
nnp = (T st2 a -> T st1 a) -> Maybe (T st2 a) -> Maybe (T st1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (T forall r. (a -> st2 -> Steps r) -> st2 -> Steps r
ph forall r. (st2 -> Steps r) -> st2 -> Steps (a, r)
pf forall r. (st2 -> Steps r) -> st2 -> Steps r
pr) ->(forall r. (a -> st1 -> Steps r) -> st1 -> Steps r)
-> (forall r. (st1 -> Steps r) -> st1 -> Steps (a, r))
-> (forall r. (st1 -> Steps r) -> st1 -> Steps r)
-> T st1 a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T (\ a -> st1 -> Steps r
k st1
st1 -> let (st2
st2, st2 -> st1
back) = st1 -> (st2, st2 -> st1)
split st1
st1
in (a -> st2 -> Steps r) -> st2 -> Steps r
forall r. (a -> st2 -> Steps r) -> st2 -> Steps r
ph (\ a
a st2
st2' -> a -> st1 -> Steps r
k a
a (st2 -> st1
back st2
st2')) st2
st2)
(\ st1 -> Steps r
k st1
st1 -> let (st2
st2, st2 -> st1
back) = st1 -> (st2, st2 -> st1)
split st1
st1
in (st2 -> Steps r) -> st2 -> Steps (a, r)
forall r. (st2 -> Steps r) -> st2 -> Steps (a, r)
pf (\st2
st2' -> st1 -> Steps r
k (st2 -> st1
back st2
st2')) st2
st2)
(\ st1 -> Steps r
k st1
st1 -> let (st2
st2, st2 -> st1
back) = st1 -> (st2, st2 -> st1)
split st1
st1
in (st2 -> Steps r) -> st2 -> Steps r
forall r. (st2 -> Steps r) -> st2 -> Steps r
pr (\st2
st2' -> st1 -> Steps r
k (st2 -> st1
back st2
st2')) st2
st2)) Maybe (T st2 a)
np
in Maybe (T st1 a) -> Maybe a -> Nat -> P st1 a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st1 a)
nnp Maybe a
pe Nat
pl
parse :: (Eof t) => P t a -> t -> a
parse :: P t a -> t -> a
parse (P (T forall r. (a -> t -> Steps r) -> t -> Steps r
_ forall r. (t -> Steps r) -> t -> Steps (a, r)
pf forall r. (t -> Steps r) -> t -> Steps r
_) Maybe (T t a)
_ Maybe a
_ Nat
_) t
state = (a, ()) -> a
forall a b. (a, b) -> a
fst ((a, ()) -> a) -> (Steps (a, ()) -> (a, ())) -> Steps (a, ()) -> a
forall t t t. (t -> t) -> (t -> t) -> t -> t
. Steps (a, ()) -> (a, ())
forall a. Steps a -> a
eval (Steps (a, ()) -> a) -> Steps (a, ()) -> a
forall a b. (a -> b) -> a -> b
$ (t -> Steps ()) -> t -> Steps (a, ())
forall r. (t -> Steps r) -> t -> Steps (a, r)
pf (\ t
rest -> if t -> Bool
forall state. Eof state => state -> Bool
eof t
rest then () -> Steps ()
forall a. a -> Steps a
Done ()
else String -> Steps ()
forall a. HasCallStack => String -> a
error String
"pEnd missing?") t
state
parse_h :: (Eof t) => P t a -> t -> a
parse_h :: P t a -> t -> a
parse_h (P (T forall r. (a -> t -> Steps r) -> t -> Steps r
ph forall r. (t -> Steps r) -> t -> Steps (a, r)
_ forall r. (t -> Steps r) -> t -> Steps r
_) Maybe (T t a)
_ Maybe a
_ Nat
_) t
state = Steps a -> a
forall a. Steps a -> a
eval (Steps a -> a) -> Steps a -> a
forall a b. (a -> b) -> a -> b
$ (a -> t -> Steps a) -> t -> Steps a
forall r. (a -> t -> Steps r) -> t -> Steps r
ph (\ a
a t
rest -> if t -> Bool
forall state. Eof state => state -> Bool
eof t
rest then a -> Steps a
forall a. a -> Steps a
Done a
a
else String -> Steps a
forall a. HasCallStack => String -> a
error String
"pEnd missing?") t
state
data Steps :: * -> * where
Step :: Progress -> Steps a -> Steps a
Apply :: forall a b. (b -> a) -> Steps b -> Steps a
Fail :: Strings -> [Strings -> (Cost , Steps a)] -> Steps a
Micro :: Int -> Steps a -> Steps a
Done :: a -> Steps a
End_h :: ([a] , [a] -> Steps r) -> Steps (a,r) -> Steps (a, r)
End_f :: [Steps a] -> Steps a -> Steps a
instance Show (Steps a) where
show :: Steps a -> String
show (Step Int
_ Steps a
_) = String
"Step"
show (Apply b -> a
_ Steps b
_) = String
"Apply"
show (Fail Strings
_ [Strings -> (Int, Steps a)]
_) = String
"Fail"
show (Micro Int
_ Steps a
_) = String
"Micro"
show (Done a
_) = String
"Done"
show (End_h ([a], [a] -> Steps r)
_ Steps (a, r)
_ ) = String
"End_h"
show (End_f [Steps a]
_ Steps a
_ ) = String
"End_f"
type Cost = Int
type Progress = Int
type Strings = [String]
apply :: Steps (b -> a, (b, r)) -> Steps (a, r)
apply :: Steps (b -> a, (b, r)) -> Steps (a, r)
apply = ((b -> a, (b, r)) -> (a, r))
-> Steps (b -> a, (b, r)) -> Steps (a, r)
forall a b. (b -> a) -> Steps b -> Steps a
Apply (\(b -> a
b2a, (b, r)
br) -> let (b
b, r
r) = (b, r)
br in (b -> a
b2a b
b, r
r))
push :: v -> Steps r -> Steps (v, r)
push :: v -> Steps r -> Steps (v, r)
push v
v = (r -> (v, r)) -> Steps r -> Steps (v, r)
forall a b. (b -> a) -> Steps b -> Steps a
Apply (\ r
r -> (v
v, r
r))
apply2fst :: (b -> a) -> Steps (b, r) -> Steps (a, r)
apply2fst :: (b -> a) -> Steps (b, r) -> Steps (a, r)
apply2fst b -> a
f = ((b, r) -> (a, r)) -> Steps (b, r) -> Steps (a, r)
forall a b. (b -> a) -> Steps b -> Steps a
Apply (\ (b, r)
br -> let (b
b, r
r) = (b, r)
br in (b -> a
f b
b, r
r))
noAlts :: Steps a
noAlts :: Steps a
noAlts = Strings -> [Strings -> (Int, Steps a)] -> Steps a
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [] []
has_success :: Steps t -> Bool
has_success :: Steps t -> Bool
has_success (Step Int
_ Steps t
_) = Bool
True
has_success (Done t
_) = Bool
True
has_success Steps t
_ = Bool
False
eval :: Steps a -> a
eval :: Steps a -> a
eval (Step Int
n Steps a
l) = String -> a -> a
forall b. String -> b -> b
trace' (String
"Step " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Steps a -> a
forall a. Steps a -> a
eval Steps a
l)
eval (Micro Int
_ Steps a
l) = Steps a -> a
forall a. Steps a -> a
eval Steps a
l
eval (Fail Strings
ss [Strings -> (Int, Steps a)]
ls ) = String -> a -> a
forall b. String -> b -> b
trace' (String
"expecting: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Strings -> String
forall a. Show a => a -> String
show Strings
ss) (Steps a -> a
forall a. Steps a -> a
eval (Int -> [(Int, Steps a)] -> Steps a
forall a. Int -> [(Int, Steps a)] -> Steps a
getCheapest Int
5 (((Strings -> (Int, Steps a)) -> (Int, Steps a))
-> [Strings -> (Int, Steps a)] -> [(Int, Steps a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Strings -> (Int, Steps a)) -> Strings -> (Int, Steps a)
forall a b. (a -> b) -> a -> b
$Strings
ss) [Strings -> (Int, Steps a)]
ls)))
eval (Apply b -> a
f Steps b
l ) = b -> a
f (Steps b -> b
forall a. Steps a -> a
eval Steps b
l)
eval (End_f [Steps a]
_ Steps a
_ ) = String -> a
forall a. HasCallStack => String -> a
error String
"dangling End_f constructor"
eval (End_h ([a], [a] -> Steps r)
_ Steps (a, r)
_ ) = String -> a
forall a. HasCallStack => String -> a
error String
"dangling End_h constructor"
eval (Done a
a ) = a
a
norm :: Steps a -> Steps a
norm :: Steps a -> Steps a
norm (Apply b -> a
f (Step Int
p Steps b
l )) = Int -> Steps a -> Steps a
forall a. Int -> Steps a -> Steps a
Step Int
p ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f Steps b
l)
norm (Apply b -> a
f (Micro Int
c Steps b
l )) = Int -> Steps a -> Steps a
forall a. Int -> Steps a -> Steps a
Micro Int
c ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f Steps b
l)
norm (Apply b -> a
f (Fail Strings
ss [Strings -> (Int, Steps b)]
ls )) = Strings -> [Strings -> (Int, Steps a)] -> Steps a
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail Strings
ss ((Steps b -> Steps a)
-> [Strings -> (Int, Steps b)] -> [Strings -> (Int, Steps a)]
forall c d a b. (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f) [Strings -> (Int, Steps b)]
ls)
norm (Apply b -> a
f (Apply b -> b
g Steps b
l )) = Steps a -> Steps a
forall a. Steps a -> Steps a
norm ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply (b -> a
f(b -> a) -> (b -> b) -> b -> a
forall t t t. (t -> t) -> (t -> t) -> t -> t
.b -> b
g) Steps b
l)
norm (Apply b -> a
f (End_f [Steps b]
ss Steps b
l )) = [Steps a] -> Steps a -> Steps a
forall a. [Steps a] -> Steps a -> Steps a
End_f ((Steps b -> Steps a) -> [Steps b] -> [Steps a]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f) [Steps b]
ss) ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f Steps b
l)
norm (Apply b -> a
f (End_h ([a], [a] -> Steps r)
_ Steps (a, r)
_ )) = String -> Steps a
forall a. HasCallStack => String -> a
error String
"Apply before End_h"
norm (Apply b -> a
f (Done b
a )) = a -> Steps a
forall a. a -> Steps a
Done (b -> a
f b
a)
norm Steps a
steps = Steps a
steps
applyFail :: (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail :: (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail c -> d
f = ((a -> (b, c)) -> a -> (b, d)) -> [a -> (b, c)] -> [a -> (b, d)]
forall a b. (a -> b) -> [a] -> [b]
map (\ a -> (b, c)
g -> \ a
ex -> let (b
c, c
l) = a -> (b, c)
g a
ex in (b
c, c -> d
f c
l))
best :: Steps a -> Steps a -> Steps a
Steps a
x best :: Steps a -> Steps a -> Steps a
`best` Steps a
y = Steps a -> Steps a
forall a. Steps a -> Steps a
norm Steps a
x Steps a -> Steps a -> Steps a
forall a. Steps a -> Steps a -> Steps a
`best'` Steps a -> Steps a
forall a. Steps a -> Steps a
norm Steps a
y
best' :: Steps b -> Steps b -> Steps b
(Done b
_) best' :: Steps b -> Steps b -> Steps b
`best'` (Done b
_) = String -> Steps b
forall a. HasCallStack => String -> a
error String
"ambiguous parsers"
l :: Steps b
l@(Done b
_) `best'` Steps b
r = Steps b
l
Steps b
l `best'` r :: Steps b
r@(Done b
_) = Steps b
r
End_f [Steps b]
as Steps b
l `best'` End_f [Steps b]
bs Steps b
r = [Steps b] -> Steps b -> Steps b
forall a. [Steps a] -> Steps a -> Steps a
End_f ([Steps b]
as[Steps b] -> [Steps b] -> [Steps b]
forall a. [a] -> [a] -> [a]
++[Steps b]
bs) (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
End_f [Steps b]
as Steps b
l `best'` Steps b
r = [Steps b] -> Steps b -> Steps b
forall a. [Steps a] -> Steps a -> Steps a
End_f [Steps b]
as (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
Steps b
l `best'` End_f [Steps b]
bs Steps b
r = [Steps b] -> Steps b -> Steps b
forall a. [Steps a] -> Steps a -> Steps a
End_f [Steps b]
bs (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
End_h ([a]
as, [a] -> Steps r
k_h_st) Steps (a, r)
l `best'` End_h ([a]
bs, [a] -> Steps r
_) Steps (a, r)
r = ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([a]
as[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
[a]
bs, [a] -> Steps r
k_h_st) (Steps (a, r)
l Steps (a, r) -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a -> Steps a
`best` Steps (a, r)
Steps (a, r)
r)
End_h ([a], [a] -> Steps r)
as Steps (a, r)
l `best'` Steps b
r = ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([a], [a] -> Steps r)
as (Steps (a, r)
l Steps (a, r) -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
Steps (a, r)
r)
Steps b
l `best'` End_h ([a], [a] -> Steps r)
bs Steps (a, r)
r = ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([a], [a] -> Steps r)
bs (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
Steps (a, r)
r)
Fail Strings
sl [Strings -> (Int, Steps b)]
ll `best'` Fail Strings
sr [Strings -> (Int, Steps b)]
rr = Strings -> [Strings -> (Int, Steps b)] -> Steps b
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail (Strings
sl Strings -> Strings -> Strings
forall a. [a] -> [a] -> [a]
++ Strings
sr) ([Strings -> (Int, Steps b)]
ll[Strings -> (Int, Steps b)]
-> [Strings -> (Int, Steps b)] -> [Strings -> (Int, Steps b)]
forall a. [a] -> [a] -> [a]
++[Strings -> (Int, Steps b)]
rr)
Fail Strings
_ [Strings -> (Int, Steps b)]
_ `best'` Steps b
r = Steps b
r
Steps b
l `best'` Fail Strings
_ [Strings -> (Int, Steps b)]
_ = Steps b
l
Step Int
n Steps b
l `best'` Step Int
m Steps b
r
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m = Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step Int
n (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m = Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step Int
n (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Steps b
r)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m = Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step Int
m (Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
ls :: Steps b
ls@(Step Int
_ Steps b
_) `best'` Micro Int
_ Steps b
_ = Steps b
ls
Micro Int
_ Steps b
_ `best'` rs :: Steps b
rs@(Step Int
_ Steps b
_) = Steps b
rs
ls :: Steps b
ls@(Micro Int
i Steps b
l) `best'` rs :: Steps b
rs@(Micro Int
j Steps b
r)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j = Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Micro Int
i (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j = Steps b
ls
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
j = Steps b
rs
Steps b
l `best'` Steps b
r = String -> Steps b
forall a. HasCallStack => String -> a
error (String
"missing alternative in best': " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Steps b -> String
forall a. Show a => a -> String
show Steps b
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Steps b -> String
forall a. Show a => a -> String
show Steps b
r)
getCheapest :: Int -> [(Int, Steps a)] -> Steps a
getCheapest :: Int -> [(Int, Steps a)] -> Steps a
getCheapest Int
_ [] = String -> Steps a
forall a. HasCallStack => String -> a
error String
"no correcting alternative found"
getCheapest Int
n [(Int, Steps a)]
l = (Int, Steps a) -> Steps a
forall a b. (a, b) -> b
snd ((Int, Steps a) -> Steps a) -> (Int, Steps a) -> Steps a
forall a b. (a -> b) -> a -> b
$ ((Int, Steps a) -> (Int, Steps a) -> (Int, Steps a))
-> (Int, Steps a) -> [(Int, Steps a)] -> (Int, Steps a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
w,Steps a
ll) btf :: (Int, Steps a)
btf@(Int
c, Steps a
l)
-> if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c
then let new :: Int
new = (Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n Steps a
ll Int
w Int
c)
in if Int
new Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c then (Int
new, Steps a
ll) else (Int, Steps a)
btf
else (Int, Steps a)
btf
) (Int
forall a. Bounded a => a
maxBound, String -> Steps a
forall a. HasCallStack => String -> a
error String
"getCheapest") [(Int, Steps a)]
l
traverse :: Int -> Steps a -> Int -> Int -> Int
traverse :: Int -> Steps a -> Int -> Int -> Int
traverse Int
0 Steps a
_ Int
v Int
c = String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Integer
0 Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" choosing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
100
traverse Int
n (Step Int
_ Steps a
l) Int
v Int
c = String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Step " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Steps a
l Int
v Int
c
traverse Int
n (Micro Int
x Steps a
l) Int
v Int
c = String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Micro " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n Steps a
l Int
v Int
c
traverse Int
n (Apply b -> a
_ Steps b
l) Int
v Int
c = String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Apply " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Int -> Steps b -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n Steps b
l Int
v Int
c
traverse Int
n (Fail Strings
m [Strings -> (Int, Steps a)]
m2ls) Int
v Int
c = String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Fail " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Strings -> String
forall a. Show a => a -> String
show Strings
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" length m2ls = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Strings -> (Int, Steps a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Strings -> (Int, Steps a)]
m2ls) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
((Strings -> (Int, Steps a)) -> Int -> Int)
-> Int -> [Strings -> (Int, Steps a)] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((\ (Int
w,Steps a
l) Int
c' -> if Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c' then Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 ) Steps a
l (Int
vInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w) Int
c'
else Int
c') ((Int, Steps a) -> Int -> Int)
-> ((Strings -> (Int, Steps a)) -> (Int, Steps a))
-> (Strings -> (Int, Steps a))
-> Int
-> Int
forall t t t. (t -> t) -> (t -> t) -> t -> t
. ((Strings -> (Int, Steps a)) -> Strings -> (Int, Steps a)
forall a b. (a -> b) -> a -> b
$Strings
m)) Int
c [Strings -> (Int, Steps a)]
m2ls
traverse Int
n (End_h ([a]
a, [a] -> Steps r
lf) Steps (a, r)
r) Int
v Int
c = String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse End_h " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Int -> Steps r -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n ([a] -> Steps r
lf [a]
a Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`best` Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h Steps (a, r)
r) Int
v Int
c
traverse Int
n (End_f (Steps a
l :[Steps a]
_) Steps a
r) Int
v Int
c = String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse End_f " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n (Steps a
l Steps a -> Steps a -> Steps a
forall a. Steps a -> Steps a -> Steps a
`best` Steps a
r) Int
v Int
c
traverse Int
n (End_f [] Steps a
r) Int
v Int
c = String -> Int
forall a. HasCallStack => String -> a
error String
"Cannot traverse End_f with empty list"
traverse Int
n (Done a
_ ) Int
v Int
c = String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Done " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" choosing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
Int
v
show' :: (Show a, Show b, Show c) => a -> b -> c -> String
show' :: a -> b -> c -> String
show' a
n b
v c
c = String
"n: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" v: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" c: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Show a => a -> String
show c
c
removeEnd_h :: Steps (a, r) -> Steps r
removeEnd_h :: Steps (a, r) -> Steps r
removeEnd_h (Fail Strings
m [Strings -> (Int, Steps (a, r))]
ls ) = Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail Strings
m ((Steps (a, r) -> Steps r)
-> [Strings -> (Int, Steps (a, r))] -> [Strings -> (Int, Steps r)]
forall c d a b. (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h [Strings -> (Int, Steps (a, r))]
ls)
removeEnd_h (Step Int
ps Steps (a, r)
l ) = Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Step Int
ps (Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h Steps (a, r)
l)
removeEnd_h (Apply b -> (a, r)
f Steps b
l ) = String -> Steps r
forall a. HasCallStack => String -> a
error String
"not in history parsers"
removeEnd_h (Micro Int
c Steps (a, r)
l ) = Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Micro Int
c (Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h Steps (a, r)
l)
removeEnd_h (End_h ([a]
as, [a] -> Steps r
k_st ) Steps (a, r)
r ) = [a] -> Steps r
k_st [a]
as Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`best` Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h Steps (a, r)
r
removeEnd_h (Done (a, r)
_) = String -> Steps r
forall a. HasCallStack => String -> a
error String
"spurious End_h at Done"
removeEnd_f :: Steps r -> Steps [r]
removeEnd_f :: Steps r -> Steps [r]
removeEnd_f (Fail Strings
m [Strings -> (Int, Steps r)]
ls) = Strings -> [Strings -> (Int, Steps [r])] -> Steps [r]
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail Strings
m ((Steps r -> Steps [r])
-> [Strings -> (Int, Steps r)] -> [Strings -> (Int, Steps [r])]
forall c d a b. (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail Steps r -> Steps [r]
forall r. Steps r -> Steps [r]
removeEnd_f [Strings -> (Int, Steps r)]
ls)
removeEnd_f (Step Int
ps Steps r
l) = Int -> Steps [r] -> Steps [r]
forall a. Int -> Steps a -> Steps a
Step Int
ps (Steps r -> Steps [r]
forall r. Steps r -> Steps [r]
removeEnd_f Steps r
l)
removeEnd_f (Apply b -> r
f Steps b
l) = ([b] -> [r]) -> Steps [b] -> Steps [r]
forall a b. (b -> a) -> Steps b -> Steps a
Apply ((b -> r) -> [b] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map' b -> r
f) (Steps b -> Steps [b]
forall r. Steps r -> Steps [r]
removeEnd_f Steps b
l)
where map' :: (t -> b) -> [t] -> [b]
map' t -> b
f ~(t
x:[t]
xs) = t -> b
f t
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (t -> b) -> [t] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map t -> b
f [t]
xs
removeEnd_f (Micro Int
c Steps r
l ) = Int -> Steps [r] -> Steps [r]
forall a. Int -> Steps a -> Steps a
Micro Int
c (Steps r -> Steps [r]
forall r. Steps r -> Steps [r]
removeEnd_f Steps r
l)
removeEnd_f (End_f(Steps r
s:[Steps r]
ss) Steps r
r) = (r -> [r]) -> Steps r -> Steps [r]
forall a b. (b -> a) -> Steps b -> Steps a
Apply (r -> [r] -> [r]
forall a. a -> [a] -> [a]
:((Steps r -> r) -> [Steps r] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map Steps r -> r
forall a. Steps a -> a
eval [Steps r]
ss)) Steps r
s
Steps [r] -> Steps [r] -> Steps [r]
forall a. Steps a -> Steps a -> Steps a
`best`
Steps r -> Steps [r]
forall r. Steps r -> Steps [r]
removeEnd_f Steps r
r
removeEnd_f (Done r
_) = String -> Steps [r]
forall a. HasCallStack => String -> a
error String
"spurious End_f at Done"
data Nat = Zero
| Succ Nat
| Infinite
| Unspecified
| Hole
deriving Int -> Nat -> ShowS
[Nat] -> ShowS
Nat -> String
(Int -> Nat -> ShowS)
-> (Nat -> String) -> ([Nat] -> ShowS) -> Show Nat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nat] -> ShowS
$cshowList :: [Nat] -> ShowS
show :: Nat -> String
$cshow :: Nat -> String
showsPrec :: Int -> Nat -> ShowS
$cshowsPrec :: Int -> Nat -> ShowS
Show
addLength :: Int -> P st a -> P st a
addLength Int
n (P T st a
t Maybe (T st a)
nep Maybe a
e Nat
l) = T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P T st a
t Maybe (T st a)
nep Maybe a
e (Int -> Nat -> Nat
addLength' Int
n Nat
l)
addLength' :: Int -> Nat -> Nat
addLength' :: Int -> Nat -> Nat
addLength' Int
n Nat
Zero = Int -> Nat
fromInt Int
n
addLength' Int
n (Succ Nat
m) = Nat -> Nat
Succ (Int -> Nat -> Nat
addLength' Int
n Nat
m)
addLength' Int
n Nat
Infinite = Nat
Infinite
addLength' Int
n Nat
Unspecified = Nat
Unspecified
addLength' Int
n Nat
Hole = Int -> Nat
fromInt Int
n
fromInt :: Int -> Nat
fromInt Int
n = if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
n Int -> (Nat -> Nat) -> Nat -> Nat
`times` Nat -> Nat
Succ) Nat
Zero else String -> Nat
forall a. HasCallStack => String -> a
error String
"error: negative argument passed to addlength"
where times :: Int -> (Nat -> Nat) -> Nat -> Nat
times :: Int -> (Nat -> Nat) -> Nat -> Nat
times Int
0 Nat -> Nat
_ Nat
v = Nat
v
times Int
n Nat -> Nat
f Nat
v = Int -> (Nat -> Nat) -> Nat -> Nat
times (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Nat -> Nat
f (Nat -> Nat
f Nat
v)
nat_min :: Nat -> Nat -> Int -> ( Nat
, Bool
)
nat_min :: Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
Zero Nat
Zero Int
n = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Both Zero in nat_min\n" (Nat
Zero , Bool
False)
nat_min Nat
l rr :: Nat
rr@Nat
Zero Int
n = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Right Zero in nat_min\n" (Nat
Zero , Bool
True)
nat_min ll :: Nat
ll@Nat
Zero Nat
r Int
n = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Left Zero in nat_min\n" (Nat
Zero, Bool
False)
nat_min (Succ Nat
ll) (Succ Nat
rr) Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000 then String -> (Nat, Bool)
forall a. HasCallStack => String -> a
error String
"problem with comparing lengths"
else String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' (String
"Succ in nat_min " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
(let (Nat
v, Bool
b) = Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
ll Nat
rr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) in (Nat -> Nat
Succ Nat
v, Bool
b))
nat_min Nat
Infinite Nat
r Int
_ = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Left Infinite in nat_min\n" (Nat
r, Bool
True)
nat_min Nat
l Nat
Infinite Int
_ = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Right Infinite in nat_min\n" (Nat
l, Bool
False)
nat_min Nat
Hole Nat
r Int
_ = String -> (Nat, Bool)
forall a. HasCallStack => String -> a
error String
"canot compute minmal length of a parser due to occurrence of a moadic bind, use addLength to override"
nat_min Nat
l Nat
Hole Int
_ = String -> (Nat, Bool)
forall a. HasCallStack => String -> a
error String
"canot compute minmal length of a parser due to occurrence of a moadic bind, use addLength to override"
nat_min Nat
l Nat
Unspecified Int
_ = (Nat
l , Bool
False)
nat_min Nat
Unspecified Nat
r Int
_ = (Nat
r , Bool
False)
nat_add :: Nat -> Nat -> Nat
nat_add :: Nat -> Nat -> Nat
nat_add Nat
Zero Nat
r = String -> Nat -> Nat
forall b. String -> b -> b
trace' String
"Zero in add\n" Nat
r
nat_add (Succ Nat
l) Nat
r = String -> Nat -> Nat
forall b. String -> b -> b
trace' String
"Succ in add\n" (Nat -> Nat
Succ (Nat -> Nat -> Nat
nat_add Nat
l Nat
r))
nat_add Nat
Infinite Nat
_ = String -> Nat -> Nat
forall b. String -> b -> b
trace' String
"Infinite in add\n" Nat
Infinite
nat_add Nat
Hole Nat
_ = Nat
Hole
nat_add Nat
Unspecified Nat
r = String -> Nat -> Nat
forall b. String -> b -> b
trace' String
"Unspecified in add\n" Nat
Unspecified
trace' :: String -> b -> b
trace' :: String -> b -> b
trace' String
m b
v = b
v
trace'' :: String -> b -> b
trace'' :: String -> b -> b
trace'' String
m b
v = b
v