{-# 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 -- return the old state
  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 (a -> r'' -> r')
-> ((a, a) -> Steps r'' s p) -> (a, a) -> Steps r' s 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 (st -> r'' -> r')
-> ((a, st) -> Steps r'' s p) -> (a, st) -> Steps r' s 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]]