{-# LANGUAGE MagicHash,
UnboxedTuples,
ScopedTypeVariables #-}
module UU.Parsing.StateParser(StateParser(..)) where
import GHC.Prim
import UU.Parsing.MachineInterface
import UU.Parsing.Machine(AnaParser, ParsRec(..),RealParser(..),RealRecogn(..), mkPR, anaDynE)
instance (InputState inp s p) => InputState (inp, state) s p where
splitStateE :: (inp, state) -> Either' (inp, state) s
splitStateE (inp
inp, state
st) = case inp -> Either' inp s
forall state s pos.
InputState state s pos =>
state -> Either' state s
splitStateE inp
inp of
Left' s
x inp
xs -> s -> (inp, state) -> Either' (inp, state) s
forall state s. s -> state -> Either' state s
Left' s
x (inp
xs, state
st)
Right' inp
xs -> (inp, state) -> Either' (inp, state) s
forall state s. state -> Either' state s
Right' (inp
xs, state
st)
splitState :: (inp, state) -> (# s, (inp, state) #)
splitState (inp
inp, state
st) = case inp -> (# s, inp #)
forall state s pos.
InputState state s pos =>
state -> (# s, state #)
splitState inp
inp of
(# s
x,inp
xs #) -> (# s
x, (inp
xs, state
st) #)
getPosition :: (inp, state) -> p
getPosition (inp
inp, state
_) = inp -> p
forall state s pos. InputState state s pos => state -> pos
getPosition inp
inp
class StateParser p st | p -> st where
change :: (st -> st) -> p st
set :: st -> p st
set st
x = (st -> st) -> p st
forall (p :: * -> *) st. StateParser p st => (st -> st) -> p st
change (st -> st -> st
forall a b. a -> b -> a
const st
x)
get :: p st
get = (st -> st) -> p st
forall (p :: * -> *) st. StateParser p st => (st -> st) -> p st
change st -> st
forall a. a -> a
id
fconst :: p -> p -> p
fconst p
x p
y = p
y
instance (InputState inp s p ,OutputState out) =>
StateParser (AnaParser (inp, st) out s p) st where
get :: AnaParser (inp, st) out s p st
get = ParsRec (inp, st) out s p st -> AnaParser (inp, st) out s p st
forall {state} {result :: * -> * -> *} {s} {p} {a}.
ParsRec state result s p a -> AnaParser state result s p a
anaDynE ((RealParser (inp, st) s p st, RealRecogn (inp, st) s p)
-> ParsRec (inp, st) out s p st
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR (RealParser (inp, st) s p st
forall {a} {a} {s} {p}. RealParser (a, a) s p a
rp,RealRecogn (inp, st) s p
forall {a} {t} {s} {p}. RealRecogn (a, t) s p
rr))
where f :: (t -> a -> b) -> ((a, t) -> Steps a s p) -> (a, t) -> Steps b s p
f t -> a -> b
addRes (a, t) -> Steps a s p
k (a, t)
state = ((a -> b) -> Steps a s p -> Steps b s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val (t -> a -> b
addRes ((a, t) -> t
forall a b. (a, b) -> b
snd (a, t)
state)) ((a, t) -> Steps a s p
k (a, t)
state))
rp :: RealParser (a, a) s p a
rp = (forall r' r''.
(a -> r'' -> r')
-> ((a, a) -> Steps r'' s p) -> (a, a) -> Steps r' s p)
-> RealParser (a, a) s p a
forall state s p a.
(forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state s p a
P forall r' r''.
(a -> r'' -> r')
-> ((a, a) -> Steps r'' s p) -> (a, a) -> Steps r' s p
forall {t} {a} {b} {a} {s} {p}.
(t -> a -> b) -> ((a, t) -> Steps a s p) -> (a, t) -> Steps b s p
f
rr :: RealRecogn (a, t) s p
rr = (forall r. ((a, t) -> Steps r s p) -> (a, t) -> Steps r s p)
-> RealRecogn (a, t) s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R ((t -> r -> r) -> ((a, t) -> Steps r s p) -> (a, t) -> Steps r s p
forall {t} {a} {b} {a} {s} {p}.
(t -> a -> b) -> ((a, t) -> Steps a s p) -> (a, t) -> Steps b s p
f t -> r -> r
forall {p} {p}. p -> p -> p
fconst )
change :: (st -> st) -> AnaParser (inp, st) out s p st
change st -> st
ch = ParsRec (inp, st) out s p st -> AnaParser (inp, st) out s p st
forall {state} {result :: * -> * -> *} {s} {p} {a}.
ParsRec state result s p a -> AnaParser state result s p a
anaDynE ((RealParser (inp, st) s p st, RealRecogn (inp, st) s p)
-> ParsRec (inp, st) out s p st
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR (RealParser (inp, st) s p st
forall {a} {s} {p}. RealParser (a, st) s p st
rp,RealRecogn (inp, st) s p
forall {a} {s} {p}. RealRecogn (a, st) s p
rr))
where f :: (st -> a -> b)
-> ((a, st) -> Steps a s p) -> (a, st) -> Steps b s p
f st -> a -> b
addRes (a, st) -> Steps a s p
k (a, st)
state = case (a, st)
state of (a
inp, st
st) -> (a -> b) -> Steps a s p -> Steps b s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val (st -> a -> b
addRes st
st) ((a, st) -> Steps a s p
k (a
inp, st -> st
ch st
st))
rp :: RealParser (a, st) s p st
rp = (forall r' r''.
(st -> r'' -> r')
-> ((a, st) -> Steps r'' s p) -> (a, st) -> Steps r' s p)
-> RealParser (a, st) s p st
forall state s p a.
(forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state s p a
P forall r' r''.
(st -> r'' -> r')
-> ((a, st) -> Steps r'' s p) -> (a, st) -> Steps r' s p
forall {a} {b} {a} {s} {p}.
(st -> a -> b)
-> ((a, st) -> Steps a s p) -> (a, st) -> Steps b s p
f
rr :: RealRecogn (a, st) s p
rr = (forall r. ((a, st) -> Steps r s p) -> (a, st) -> Steps r s p)
-> RealRecogn (a, st) s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R ((st -> r -> r)
-> ((a, st) -> Steps r s p) -> (a, st) -> Steps r s p
forall {a} {b} {a} {s} {p}.
(st -> a -> b)
-> ((a, st) -> Steps a s p) -> (a, st) -> Steps b s p
f st -> r -> r
forall {p} {p}. p -> p -> p
fconst)
newtype Errors s p = Errors [[Message s p]]