{-# 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
inp, st :: state
st) = case inp -> Either' inp s
forall state s pos.
InputState state s pos =>
state -> Either' state s
splitStateE inp
inp of
                  Left'   x :: s
x xs :: 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'  xs :: 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
inp, st :: state
st) = case inp -> (# s, inp #)
forall state s pos.
InputState state s pos =>
state -> (# s, state #)
splitState inp
inp of
                  (# x :: s
x,xs :: inp
xs #) -> (# s
x, (inp
xs, state
st) #)
  getPosition :: (inp, state) -> p
getPosition (inp :: inp
inp, _) = 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 -- return the old state
  set    :: st -> p st
  set x :: 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 x :: p
x y :: 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 p s p. RealRecogn (a, p) s p
rr))
    where f :: (t -> a -> b) -> ((a, t) -> Steps a s p) -> (a, t) -> Steps b s p
f addRes :: t -> a -> b
addRes k :: (a, t) -> Steps a s p
k state :: (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, p) s p
rr = (forall r. ((a, p) -> Steps r s p) -> (a, p) -> Steps r s p)
-> RealRecogn (a, p) s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R ((p -> r -> r) -> ((a, p) -> Steps r s p) -> (a, p) -> 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 p -> r -> r
forall p p. p -> p -> p
fconst )
          
  change :: (st -> st) -> AnaParser (inp, st) out s p st
change ch :: 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 addRes :: st -> a -> b
addRes k :: (a, st) -> Steps a s p
k state :: (a, st)
state = case (a, st)
state of (inp :: a
inp, st :: 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]]