{-# LANGUAGE  MagicHash,
              UnboxedTuples,
              ScopedTypeVariables #-}

module UU.Parsing.Machine where

#if __GLASGOW_HASKELL__ >= 710
import Prelude hiding ( traverse )
#endif

import GHC.Prim
#if __GLASGOW_HASKELL__ >= 708
import GHC.Types (isTrue#)
#endif
import UU.Util.BinaryTrees 
import UU.Parsing.MachineInterface

pDynE :: ParsRec state result s p a -> AnaParser state result s p a
pDynE ParsRec state result s p a
v = ParsRec state result s p a -> AnaParser state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a}.
ParsRec state result s p a -> AnaParser state result s p a
anaDynE ParsRec state result s p a
v
pDynL :: ParsRec state result s p a -> AnaParser state result s p a
pDynL ParsRec state result s p a
v = ParsRec state result s p a -> AnaParser state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a}.
ParsRec state result s p a -> AnaParser state result s p a
anaDynL ParsRec state result s p a
v

-- ==========================================================================================
-- ===== BASIC PARSER TYPE  =================================================================
-- =======================================================================================

newtype RealParser    state        s p a = P(forall r' r'' . (a -> r'' -> r') ->
                                                        (state -> Steps r'' s p) ->  state -> Steps r'           s p)

newtype RealRecogn    state        s p   = R(forall r . (state -> Steps r   s p) ->  state -> Steps r            s p)

newtype RealAccept    state result s p a = A(forall r . (state -> Steps r   s p) ->  state -> Steps (result a r) s p)

newtype ParsRec       state result s p a = PR  ( RealParser  state        s p a
                                               , RealRecogn  state        s p
                                               , RealAccept  state result s p a
                                               )
                                             
mkPR :: (RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p, R forall r. (state -> Steps r s p) -> state -> Steps r s p
r) = (RealParser state s p a, RealRecogn state s p,
 RealAccept state result s p a)
-> ParsRec state result s p a
forall state (result :: * -> * -> *) s p a.
(RealParser state s p a, RealRecogn state s p,
 RealAccept state result s p a)
-> ParsRec state result s p a
PR ((forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p, (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
r, (forall r.
 (state -> Steps r s p) -> state -> Steps (result a r) s p)
-> RealAccept state result s p a
forall state (result :: * -> * -> *) s p a.
(forall r.
 (state -> Steps r s p) -> state -> Steps (result a r) s p)
-> RealAccept state result s p a
A ((a -> r -> result a r)
-> (state -> Steps r s p) -> state -> Steps (result a r) s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p a -> r -> result a r
forall v rest. v -> rest -> result v rest
forall (r :: * -> * -> *) v rest.
OutputState r =>
v -> rest -> r v rest
acceptR))

{-# INLINE unP #-}
{-# INLINE unR #-}
unP :: RealParser state s p a
-> (a -> r'' -> r')
-> (state -> Steps r'' s p)
-> state
-> Steps r' s p
unP  (P  forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p) = (a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p
unR :: RealRecogn state s p
-> (state -> Steps r s p) -> state -> Steps r s p
unR  (R  forall r. (state -> Steps r s p) -> state -> Steps r s p
p) = (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
p

parseRecbasic :: (inp -> Steps (out c d) sym pos) 
              -> ParsRec inp out sym pos a 
              -> inp 
              -> Steps (out a (out c d)) sym pos
parseRecbasic :: forall inp (out :: * -> * -> *) c d sym pos a.
(inp -> Steps (out c d) sym pos)
-> ParsRec inp out sym pos a
-> inp
-> Steps (out a (out c d)) sym pos
parseRecbasic inp -> Steps (out c d) sym pos
eof (PR ( P forall r' r''.
(a -> r'' -> r')
-> (inp -> Steps r'' sym pos) -> inp -> Steps r' sym pos
rp, RealRecogn inp sym pos
rr, A forall r.
(inp -> Steps r sym pos) -> inp -> Steps (out a r) sym pos
ra))  inp
inp = ((inp -> Steps (out c d) sym pos)
-> inp -> Steps (out a (out c d)) sym pos
forall r.
(inp -> Steps r sym pos) -> inp -> Steps (out a r) sym pos
ra inp -> Steps (out c d) sym pos
eof inp
inp)

parsebasic :: (inp -> Steps (out c d) sym pos) 
           -> AnaParser inp out sym pos a 
           -> inp 
           -> Steps (out a (out c d)) sym pos
parsebasic :: forall inp (out :: * -> * -> *) c d sym pos a.
(inp -> Steps (out c d) sym pos)
-> AnaParser inp out sym pos a
-> inp
-> Steps (out a (out c d)) sym pos
parsebasic inp -> Steps (out c d) sym pos
eof (AnaParser inp out sym pos a
pp) inp
inp
 = (inp -> Steps (out c d) sym pos)
-> ParsRec inp out sym pos a
-> inp
-> Steps (out a (out c d)) sym pos
forall inp (out :: * -> * -> *) c d sym pos a.
(inp -> Steps (out c d) sym pos)
-> ParsRec inp out sym pos a
-> inp
-> Steps (out a (out c d)) sym pos
parseRecbasic inp -> Steps (out c d) sym pos
eof (AnaParser inp out sym pos a -> ParsRec inp out sym pos a
forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a -> ParsRec state result s p a
pars AnaParser inp out sym pos a
pp) inp
inp 

-- =======================================================================================
-- ===== CORE PARSERS ====================================================================
-- ======================================================================================= 
libAccept :: (OutputState a, InputState b s p) => ParsRec b a s p s
libAccept :: forall (a :: * -> * -> *) b s p.
(OutputState a, InputState b s p) =>
ParsRec b a s p s
libAccept            = (RealParser b s p s, RealRecogn b s p) -> ParsRec b a s p s
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ((forall r' r''.
 (s -> r'' -> r') -> (b -> Steps r'' s p) -> b -> Steps r' s p)
-> RealParser b s p s
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 (\ s -> r'' -> r'
acc b -> Steps r'' s p
k b
state ->
                                case b -> (# s, b #)
forall state s pos.
InputState state s pos =>
state -> (# s, state #)
splitState b
state of
                                (# s
s, b
ss #)  -> (r'' -> r') -> Steps r'' s p -> Steps r' s p
forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
OkVal (s -> r'' -> r'
acc s
s) (b -> Steps r'' s p
k b
ss))
                            ,(forall r. (b -> Steps r s p) -> b -> Steps r s p)
-> RealRecogn b s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (\ b -> Steps r s p
k b
state ->
                                case b -> (# s, b #)
forall state s pos.
InputState state s pos =>
state -> (# s, state #)
splitState b
state of
                                (# s
s, b
ss #)  ->   Steps r s p -> Steps r s p
forall val s p. Steps val s p -> Steps val s p
Ok (b -> Steps r s p
k b
ss))
                            )
libInsert :: Int# -> a -> Expecting a -> ParsRec state result a p a
libInsert  Int#
c a
sym  Expecting a
firsts =(RealParser state a p a, RealRecogn state a p)
-> ParsRec state result a p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR( (forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' a p) -> state -> Steps r' a p)
-> RealParser state a 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'
acc state -> Steps r'' a p
k state
state ->  let msg :: Message a p
msg = Expecting a -> p -> Action a -> Message a p
forall sym pos.
Expecting sym -> pos -> Action sym -> Message sym pos
Msg  Expecting a
firsts 
                                                                     (state -> p
forall state s pos. InputState state s pos => state -> pos
getPosition state
state)
                                                                     (a -> Action a
forall s. s -> Action s
Insert a
sym)            
                                                    in Int# -> Message a p -> Steps r' a p -> Steps r' a p
forall val s p.
Int# -> Message s p -> Steps val s p -> Steps val s p
StRepair Int#
c Message a p
msg ((r'' -> r') -> Steps r'' a p -> Steps r' a p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val (a -> r'' -> r'
acc a
sym) (state -> Steps r'' a p
k (a -> state -> state
forall state s pos. InputState state s pos => s -> state -> state
insertSymbol a
sym (Message a p -> state -> state
forall state s pos.
InputState state s pos =>
Message s pos -> state -> state
reportError Message a p
msg state
state)))))
                              , (forall r. (state -> Steps r a p) -> state -> Steps r a p)
-> RealRecogn state a p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (\    state -> Steps r a p
k state
state ->  let msg :: Message a p
msg = Expecting a -> p -> Action a -> Message a p
forall sym pos.
Expecting sym -> pos -> Action sym -> Message sym pos
Msg  Expecting a
firsts 
                                                                     (state -> p
forall state s pos. InputState state s pos => state -> pos
getPosition state
state)
                                                                     (a -> Action a
forall s. s -> Action s
Insert a
sym)       
                                                    in Int# -> Message a p -> Steps r a p -> Steps r a p
forall val s p.
Int# -> Message s p -> Steps val s p -> Steps val s p
StRepair Int#
c Message a p
msg (state -> Steps r a p
k (a -> state -> state
forall state s pos. InputState state s pos => s -> state -> state
insertSymbol a
sym (Message a p -> state -> state
forall state s pos.
InputState state s pos =>
Message s pos -> state -> state
reportError Message a p
msg state
state))))
                              )
{-
{-# INLINE libSeq  #-}
{-# INLINE libSeqL #-}
{-# INLINE libSeqR #-}
{-# INLINE libDollar #-}
{-# INLINE libDollarL #-}
{-# INLINE libDollarR #-}
{-# INLINE libSucceed #-}
-}

libSucceed :: a -> ParsRec state result s p a
libSucceed a
v                                 =(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR( (forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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'
acc -> let accv :: Steps r'' s p -> Steps r' s p
accv = (r'' -> r') -> Steps r'' s p -> Steps r' s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val (a -> r'' -> r'
acc a
v) in {-# SCC "machine" #-} \ state -> Steps r'' s p
k state
state -> Steps r'' s p -> Steps r' s p
forall {s} {p}. Steps r'' s p -> Steps r' s p
accv (state -> Steps r'' s p
k state
state))
                                                  , (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (state -> Steps r s p) -> state -> Steps r s p
forall a. a -> a
forall r. (state -> Steps r s p) -> state -> Steps r s p
id
                                                  )
libSeq :: ParsRec state result s p (b -> a)
-> ParsRec state result s p b -> ParsRec state result s p a
libSeq  (PR (P forall r' r''.
((b -> a) -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
pp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
pr, RealAccept state result s p (b -> a)
_)) ~(PR (P forall r' r''.
(b -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
qr, A forall r. (state -> Steps r s p) -> state -> Steps (result b r) s p
qa)) =(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ( (forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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'
acc -> let p :: (state -> Steps (result b r'') s p) -> state -> Steps r' s p
p = ((b -> a) -> result b r'' -> r')
-> (state -> Steps (result b r'') s p) -> state -> Steps r' s p
forall r' r''.
((b -> a) -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
pp ((a -> r'' -> r') -> (b -> a) -> result b r'' -> r'
forall a rest rest' b.
(a -> rest -> rest') -> (b -> a) -> result b rest -> rest'
forall (r :: * -> * -> *) a rest rest' b.
OutputState r =>
(a -> rest -> rest') -> (b -> a) -> r b rest -> rest'
nextR a -> r'' -> r'
acc) in {-# SCC "machine" #-} \state -> Steps r'' s p
k state
state -> (state -> Steps (result b r'') s p) -> state -> Steps r' s p
p ((state -> Steps r'' s p) -> state -> Steps (result b r'') s p
forall r. (state -> Steps r s p) -> state -> Steps (result b r) s p
qa state -> Steps r'' s p
k) state
state)
                                                            , (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R ( (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
pr((state -> Steps r s p) -> state -> Steps r s p)
-> ((state -> Steps r s p) -> state -> Steps r s p)
-> (state -> Steps r s p)
-> state
-> Steps r s p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
qr)
                                                            )
libDollar :: (a -> a)
-> ParsRec state result s p a -> ParsRec state result s p a
libDollar a -> a
f                   (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
qr, RealAccept state result s p a
_   )) = (RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ( (forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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'
acc -> {-# SCC "machine" #-} (a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp (a -> r'' -> r'
acc(a -> r'' -> r') -> (a -> a) -> a -> r'' -> r'
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
f))
                                                             , (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
qr
                                                             )
libDollarL :: a -> ParsRec state result s p a -> ParsRec state result s p a
libDollarL a
f                  (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
qr, RealAccept state result s p a
_   )) = (RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ( (forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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'
acc -> let accf :: Steps r'' s p -> Steps r' s p
accf = (r'' -> r') -> Steps r'' s p -> Steps r' s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val (a -> r'' -> r'
acc a
f) in {-# SCC "machine" #-} \ state -> Steps r'' s p
k state
state -> (state -> Steps r' s p) -> state -> Steps r' s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
qr (\ state
inp -> Steps r'' s p -> Steps r' s p
forall {s} {p}. Steps r'' s p -> Steps r' s p
accf ( state -> Steps r'' s p
k state
inp)) state
state)
                                                             , (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
qr
                                                             )
libDollarR :: p -> ParsRec state result s p a -> ParsRec state result s p a
libDollarR p
f                   (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
qr, RealAccept state result s p a
_ )) = (RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ((forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp, (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
qr)

libSeqL :: ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
libSeqL (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
pp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
pr, RealAccept state result s p a
_ )) ~(PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
qr , RealAccept state result s p a
_ )) = (RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ( (forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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'
acc -> let p :: (state -> Steps r'' s p) -> state -> Steps r' s p
p = (a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
pp a -> r'' -> r'
acc in {-# SCC "machine" #-}\state -> Steps r'' s p
k state
state -> (state -> Steps r'' s p) -> state -> Steps r' s p
p ((state -> Steps r'' s p) -> state -> Steps r'' s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
qr state -> Steps r'' s p
k) state
state)
                                                             , (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R ((state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
pr((state -> Steps r s p) -> state -> Steps r s p)
-> ((state -> Steps r s p) -> state -> Steps r s p)
-> (state -> Steps r s p)
-> state
-> Steps r s p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
qr)
                                                             )
libSeqR :: ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
libSeqR (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
pp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
pr, RealAccept state result s p a
_ )) ~(PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
qr, RealAccept state result s p a
_ )) = (RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR  ( (forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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'
acc -> let q :: (state -> Steps r'' s p) -> state -> Steps r' s p
q = (a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp a -> r'' -> r'
acc in {-# SCC "machine" #-}\state -> Steps r'' s p
k state
state -> (state -> Steps r' s p) -> state -> Steps r' s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
pr ((state -> Steps r'' s p) -> state -> Steps r' s p
q state -> Steps r'' s p
k) state
state)
                                                             , (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R ((state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
pr((state -> Steps r s p) -> state -> Steps r s p)
-> ((state -> Steps r s p) -> state -> Steps r s p)
-> (state -> Steps r s p)
-> state
-> Steps r s p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
qr)
                                                             )
libOr :: ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
libOr   (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
pp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
pr,RealAccept state result s p a
_ ))   (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp, R forall r. (state -> Steps r s p) -> state -> Steps r s p
qr, RealAccept state result s p a
_ )) = (RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR  ( (forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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'
acc -> let p :: (state -> Steps r'' s p) -> state -> Steps r' s p
p = (a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
pp a -> r'' -> r'
acc
                                                                               q :: (state -> Steps r'' s p) -> state -> Steps r' s p
q = (a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
qp a -> r'' -> r'
acc
                                                                           in {-# SCC "machine" #-} \ state -> Steps r'' s p
k state
state   -> (state -> Steps r'' s p) -> state -> Steps r' s p
p  state -> Steps r'' s p
k state
state Steps r' s p -> Steps r' s p -> Steps r' s p
forall s b p. Ord s => Steps b s p -> Steps b s p -> Steps b s p
`libBest` (state -> Steps r'' s p) -> state -> Steps r' s p
q  state -> Steps r'' s p
k state
state)
                                                             , (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (\                                   state -> Steps r s p
k state
state   -> (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
pr state -> Steps r s p
k state
state Steps r s p -> Steps r s p -> Steps r s p
forall s b p. Ord s => Steps b s p -> Steps b s p -> Steps b s p
`libBest` (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
qr state -> Steps r s p
k state
state)
                                                             )
libFail :: OutputState a => ParsRec b a c p d
libFail :: forall (a :: * -> * -> *) b c p d.
OutputState a =>
ParsRec b a c p d
libFail                                      = (RealParser b c p d, RealRecogn b c p) -> ParsRec b a c p d
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ( (forall r' r''.
 (d -> r'' -> r') -> (b -> Steps r'' c p) -> b -> Steps r' c p)
-> RealParser b c p d
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 (\ d -> r'' -> r'
_ b -> Steps r'' c p
_  b
_  -> ([Char] -> Steps r' c p
forall {a}. [Char] -> a
usererror  [Char]
"calling an always failing parser"    ))
                                                    , (forall r. (b -> Steps r c p) -> b -> Steps r c p)
-> RealRecogn b c p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (\   b -> Steps r c p
_  b
_  -> ([Char] -> Steps r c p
forall {a}. [Char] -> a
usererror  [Char]
"calling an always failing recogniser"))
                                                    )
      


starting :: Steps a s p -> Expecting s
starting :: forall a s p. Steps a s p -> Expecting s
starting (StRepair Int#
_ Message s p
m Steps a s p
_ ) = Message s p -> Expecting s
forall {sym} {pos}. Message sym pos -> Expecting sym
getStart Message s p
m
starting (Best Steps a s p
l Steps a s p
_  Steps a s p
_ )    = Steps a s p -> Expecting s
forall a s p. Steps a s p -> Expecting s
starting Steps a s p
l
starting Steps a s p
_                 = [Char] -> [Char] -> Expecting s
forall {a}. [Char] -> [Char] -> a
systemerror [Char]
"UU.Parsing.Machine" [Char]
"starting"

{-
{-# INLINE hasSuccess #-}
-}

hasSuccess :: Steps a s p -> Bool
hasSuccess :: forall a s p. Steps a s p -> Bool
hasSuccess (StRepair Int#
_ Message s p
_ Steps a s p
_ ) = Bool
False
hasSuccess (Best     Steps a s p
_ Steps a s p
_ Steps a s p
_ ) = Bool
False 
hasSuccess Steps a s p
_                 = Bool
True

getStart :: Message sym pos -> Expecting sym
getStart (Msg Expecting sym
st pos
_ Action sym
_) = Expecting sym
st

addToMessage :: Message sym pos -> Expecting sym -> Message sym pos
addToMessage (Msg Expecting sym
exp pos
pos Action sym
act) Expecting sym
more = Expecting sym -> pos -> Action sym -> Message sym pos
forall sym pos.
Expecting sym -> pos -> Action sym -> Message sym pos
Msg (Expecting sym
more Expecting sym -> Expecting sym -> Expecting sym
forall a. Ord a => Expecting a -> Expecting a -> Expecting a
`eor` Expecting sym
exp) pos
pos Action sym
act


addexpecting :: Expecting s -> Steps val s p -> Steps val s p
addexpecting Expecting s
more  (StRepair    Int#
cost   Message s p
msg   Steps val s p
rest) = Int# -> Message s p -> Steps val s p -> Steps val s p
forall val s p.
Int# -> Message s p -> Steps val s p -> Steps val s p
StRepair Int#
cost (Message s p -> Expecting s -> Message s p
forall {sym} {pos}.
Ord sym =>
Message sym pos -> Expecting sym -> Message sym pos
addToMessage Message s p
msg Expecting s
more) Steps val s p
rest
addexpecting Expecting s
more  (Best     Steps val s p
l    Steps val s p
sel           Steps val s p
r) = Steps val s p -> Steps val s p -> Steps val s p -> Steps val s p
forall val s p.
Steps val s p -> Steps val s p -> Steps val s p -> Steps val s p
Best (Expecting s -> Steps val s p -> Steps val s p
addexpecting Expecting s
more   Steps val s p
l)
                                                          (Expecting s -> Steps val s p -> Steps val s p
addexpecting Expecting s
more Steps val s p
sel) 
                                                          (Expecting s -> Steps val s p -> Steps val s p
addexpecting Expecting s
more   Steps val s p
r)
addexpecting Expecting s
more  (OkVal a -> val
v Steps a s p
rest                 ) =  [Char] -> [Char] -> Steps val s p
forall {a}. [Char] -> [Char] -> a
systemerror [Char]
"UU_Parsing" ([Char]
"addexpecting: OkVal")
addexpecting Expecting s
more  (Ok   Steps val s p
_                       ) =  [Char] -> [Char] -> Steps val s p
forall {a}. [Char] -> [Char] -> a
systemerror [Char]
"UU_Parsing" ([Char]
"addexpecting: Ok")
addexpecting Expecting s
more  (Cost Int#
_ Steps val s p
_                     ) =  [Char] -> [Char] -> Steps val s p
forall {a}. [Char] -> [Char] -> a
systemerror [Char]
"UU_Parsing" ([Char]
"addexpecting: Cost")
addexpecting Expecting s
more  Steps val s p
_                               =  [Char] -> [Char] -> Steps val s p
forall {a}. [Char] -> [Char] -> a
systemerror [Char]
"UU_Parsing" ([Char]
"addexpecting: other")


eor :: Ord a => Expecting a -> Expecting a -> Expecting a
eor :: forall a. Ord a => Expecting a -> Expecting a -> Expecting a
eor Expecting a
p  Expecting a
q  = [Expecting a] -> Expecting a
forall s. [Expecting s] -> Expecting s
EOr ([Expecting a] -> [Expecting a] -> [Expecting a]
forall {a}. Ord a => [a] -> [a] -> [a]
merge (Expecting a -> [Expecting a]
forall {s}. Expecting s -> [Expecting s]
tolist Expecting a
p) (Expecting a -> [Expecting a]
forall {s}. Expecting s -> [Expecting s]
tolist Expecting a
q))
            where merge :: [a] -> [a] -> [a]
merge x :: [a]
x@(a
l:[a]
ll) y :: [a]
y@(a
r:[a]
rr) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
l a
r of
                                            Ordering
LT -> a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:( [a]
ll [a] -> [a] -> [a]
`merge`  [a]
y)
                                            Ordering
GT -> a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:( [a]
x  [a] -> [a] -> [a]
`merge` [a]
rr)
                                            Ordering
EQ -> a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:( [a]
ll [a] -> [a] -> [a]
`merge` [a]
rr)
                  merge [a]
l [] = [a]
l
                  merge [] [a]
r = [a]
r
                  tolist :: Expecting s -> [Expecting s]
tolist (EOr [Expecting s]
l) = [Expecting s]
l
                  tolist Expecting s
x       = [Expecting s
x]

-- =======================================================================================
-- ===== SELECTING THE BEST RESULT  ======================================================
-- =======================================================================================
-- INV: the first argument should be the shorter insertion
libBest :: Ord s => Steps b s p -> Steps b s p -> Steps b s p
libBest :: forall s b p. Ord s => Steps b s p -> Steps b s p -> Steps b s p
libBest Steps b s p
ls Steps b s p
rs = Steps b s p -> Steps b s p -> (b -> b) -> (b -> b) -> Steps b s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libBest' Steps b s p
ls Steps b s p
rs b -> b
forall a. a -> a
id b -> b
forall a. a -> a
id

libBest' :: Ord s => Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libBest' :: forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libBest' (OkVal a -> b
v Steps a s p
ls) (OkVal a -> c
w Steps a s p
rs) b -> d
lf c -> d
rf = Steps d s p -> Steps d s p
forall val s p. Steps val s p -> Steps val s p
Ok (Steps a s p -> Steps a s p -> (a -> d) -> (a -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libBest' Steps a s p
ls Steps a s p
rs (b -> d
lf(b -> d) -> (a -> b) -> a -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
v) (c -> d
rf(c -> d) -> (a -> c) -> a -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> c
w))
libBest' (OkVal a -> b
v Steps a s p
ls) (Ok      Steps c s p
rs) b -> d
lf c -> d
rf = Steps d s p -> Steps d s p
forall val s p. Steps val s p -> Steps val s p
Ok (Steps a s p -> Steps c s p -> (a -> d) -> (c -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libBest' Steps a s p
ls Steps c s p
rs (b -> d
lf(b -> d) -> (a -> b) -> a -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
v)  c -> d
rf   )
libBest' (Ok      Steps b s p
ls) (OkVal a -> c
w Steps a s p
rs) b -> d
lf c -> d
rf = Steps d s p -> Steps d s p
forall val s p. Steps val s p -> Steps val s p
Ok (Steps b s p -> Steps a s p -> (b -> d) -> (a -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libBest' Steps b s p
ls Steps a s p
rs  b -> d
lf    (c -> d
rf(c -> d) -> (a -> c) -> a -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> c
w))
libBest' (Ok      Steps b s p
ls) (Ok      Steps c s p
rs) b -> d
lf c -> d
rf = Steps d s p -> Steps d s p
forall val s p. Steps val s p -> Steps val s p
Ok (Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libBest' Steps b s p
ls Steps c s p
rs  b -> d
lf     c -> d
rf   )
libBest' (OkVal a -> b
v Steps a s p
ls) Steps c s p
_            b -> d
lf c -> d
rf = (a -> d) -> Steps a s p -> Steps d s p
forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
OkVal (b -> d
lf(b -> d) -> (a -> b) -> a -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
v) Steps a s p
ls 
libBest' Steps b s p
_            (OkVal a -> c
w Steps a s p
rs) b -> d
lf c -> d
rf = (a -> d) -> Steps a s p -> Steps d s p
forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
OkVal (c -> d
rf(c -> d) -> (a -> c) -> a -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> c
w) Steps a s p
rs 
libBest' (Ok      Steps b s p
ls) Steps c s p
_            b -> d
lf c -> d
rf = (b -> d) -> Steps b s p -> Steps d s p
forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
OkVal b -> d
lf Steps b s p
ls           
libBest' Steps b s p
_            (Ok      Steps c s p
rs) b -> d
lf c -> d
rf = (c -> d) -> Steps c s p -> Steps d s p
forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
OkVal c -> d
rf Steps c s p
rs   
libBest' l :: Steps b s p
l@(Cost Int#
i Steps b s p
ls ) r :: Steps c s p
r@(Cost Int#
j Steps c s p
rs ) b -> d
lf c -> d
rf
 | Int# -> Bool
isTrue (Int#
i Int# -> Int# -> Int#
==# Int#
j) = Int# -> Steps d s p -> Steps d s p
forall val s p. Int# -> Steps val s p -> Steps val s p
Cost Int#
i (Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libBest' Steps b s p
ls Steps c s p
rs b -> d
lf c -> d
rf)
 | Int# -> Bool
isTrue (Int#
i Int# -> Int# -> Int#
<# Int#
j)  = Int# -> Steps d s p -> Steps d s p
forall val s p. Int# -> Steps val s p -> Steps val s p
Cost Int#
i ((b -> d) -> Steps b s p -> Steps d s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val b -> d
lf Steps b s p
ls)
 | Int# -> Bool
isTrue (Int#
i Int# -> Int# -> Int#
># Int#
j)  = Int# -> Steps d s p -> Steps d s p
forall val s p. Int# -> Steps val s p -> Steps val s p
Cost Int#
j ((c -> d) -> Steps c s p -> Steps d s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val c -> d
rf Steps c s p
rs)
libBest' l :: Steps b s p
l@(NoMoreSteps b
v) Steps c s p
_                 b -> d
lf c -> d
rf = d -> Steps d s p
forall val s p. val -> Steps val s p
NoMoreSteps (b -> d
lf b
v)
libBest' Steps b s p
_                 r :: Steps c s p
r@(NoMoreSteps c
w) b -> d
lf c -> d
rf = d -> Steps d s p
forall val s p. val -> Steps val s p
NoMoreSteps (c -> d
rf c
w)
libBest' l :: Steps b s p
l@(Cost Int#
i Steps b s p
ls)     Steps c s p
_                 b -> d
lf c -> d
rf = Int# -> Steps d s p -> Steps d s p
forall val s p. Int# -> Steps val s p -> Steps val s p
Cost Int#
i ((b -> d) -> Steps b s p -> Steps d s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val b -> d
lf Steps b s p
ls)
libBest' Steps b s p
_                 r :: Steps c s p
r@(Cost Int#
j Steps c s p
rs)     b -> d
lf c -> d
rf = Int# -> Steps d s p -> Steps d s p
forall val s p. Int# -> Steps val s p -> Steps val s p
Cost Int#
j ((c -> d) -> Steps c s p -> Steps d s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val c -> d
rf Steps c s p
rs)
libBest' Steps b s p
l                 Steps c s p
r                 b -> d
lf c -> d
rf = Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libCorrect Steps b s p
l Steps c s p
r b -> d
lf c -> d
rf

-- Unboxed comparison changed in 7.8: https://ghc.haskell.org/trac/ghc/wiki/NewPrimopsInGHC7.8
#if __GLASGOW_HASKELL__ >= 708
isTrue :: Int# -> Bool
isTrue = Int# -> Bool
isTrue#
#else
isTrue = id
#endif

lib_correct :: Ord s => (b -> c -> Steps d s p) -> (b -> c -> Steps d s p) -> b -> c -> Steps d s p
lib_correct :: forall s b c d p.
Ord s =>
(b -> c -> Steps d s p)
-> (b -> c -> Steps d s p) -> b -> c -> Steps d s p
lib_correct b -> c -> Steps d s p
p b -> c -> Steps d s p
q = \b
k c
inp -> Steps d s p -> Steps d s p -> (d -> d) -> (d -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libCorrect (b -> c -> Steps d s p
p b
k c
inp) ( b -> c -> Steps d s p
q b
k c
inp) d -> d
forall a. a -> a
id d -> d
forall a. a -> a
id

libCorrect :: Ord s => Steps a s p -> Steps c s p -> (a -> d) -> (c -> d) -> Steps d s p
libCorrect :: forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libCorrect Steps a s p
ls Steps c s p
rs a -> d
lf c -> d
rf
 =  let (ToBeat Int#
_ Steps d s p
choice) = ToBeat (Steps d s p)
-> (Steps c s p -> Steps d s p, Steps c s p)
-> Int#
-> Int#
-> ToBeat (Steps d s p)
forall a s p v.
ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
traverse 
                            (ToBeat (Steps d s p)
-> (Steps a s p -> Steps d s p, Steps a s p)
-> Int#
-> Int#
-> ToBeat (Steps d s p)
forall a s p v.
ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
traverse (Int# -> Steps d s p -> ToBeat (Steps d s p)
forall a. Int# -> a -> ToBeat a
ToBeat Int#
999# ((a -> d) -> Steps a s p -> Steps d s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val a -> d
lf Steps a s p
newleft)) 
                                  ((a -> d) -> Steps a s p -> Steps d s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val a -> d
lf, Steps a s p
newleft)  Int#
0# Int#
4#)
                                  ((c -> d) -> Steps c s p -> Steps d s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val c -> d
rf, Steps c s p
newright) Int#
0# Int#
4# 
        newleft :: Steps a s p
newleft    = Expecting s -> Steps a s p -> Steps a s p
forall {s} {val} {p}.
Ord s =>
Expecting s -> Steps val s p -> Steps val s p
addexpecting (Steps c s p -> Expecting s
forall a s p. Steps a s p -> Expecting s
starting Steps c s p
rs) Steps a s p
ls
        newright :: Steps c s p
newright   = Expecting s -> Steps c s p -> Steps c s p
forall {s} {val} {p}.
Ord s =>
Expecting s -> Steps val s p -> Steps val s p
addexpecting (Steps a s p -> Expecting s
forall a s p. Steps a s p -> Expecting s
starting Steps a s p
ls) Steps c s p
rs
    in Steps d s p -> Steps d s p -> Steps d s p -> Steps d s p
forall val s p.
Steps val s p -> Steps val s p -> Steps val s p -> Steps val s p
Best ((a -> d) -> Steps a s p -> Steps d s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val a -> d
lf Steps a s p
newleft)
            Steps d s p
choice
            ((c -> d) -> Steps c s p -> Steps d s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val c -> d
rf Steps c s p
newright)

data ToBeat a = ToBeat Int# a

traverse :: ToBeat (Steps a s p) -> (Steps v s p -> Steps a s p, Steps v s p) ->  Int#  -> Int# -> ToBeat (Steps a s p)
traverse :: forall a s p v.
ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
traverse b :: ToBeat (Steps a s p)
b@(ToBeat Int#
bv Steps a s p
br) (Steps v s p -> Steps a s p
f, Steps v s p
s) Int#
v                  Int#
0#  = {- trace ("comparing " ++ show bv ++ " with " ++ show v ++ "\n") $ -}
                                                           if Int# -> Bool
isTrue (Int#
bv Int# -> Int# -> Int#
<=# Int#
v)
                                                           then ToBeat (Steps a s p)
b 
                                                           else Int# -> Steps a s p -> ToBeat (Steps a s p)
forall a. Int# -> a -> ToBeat a
ToBeat Int#
v (Steps v s p -> Steps a s p
f Steps v s p
s)
traverse b :: ToBeat (Steps a s p)
b@(ToBeat Int#
bv Steps a s p
br) (Steps v s p -> Steps a s p
f, Ok      Steps v s p
l) Int#
v             Int#
n = {- trace ("adding" ++ show n ++ "\n") $-} ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
forall a s p v.
ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
traverse ToBeat (Steps a s p)
b (Steps v s p -> Steps a s p
f(Steps v s p -> Steps a s p)
-> (Steps v s p -> Steps v s p) -> Steps v s p -> Steps a s p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Steps v s p -> Steps v s p
forall val s p. Steps val s p -> Steps val s p
Ok     , Steps v s p
l) (Int#
v Int# -> Int# -> Int#
-# Int#
n Int# -> Int# -> Int#
+# Int#
4#) (Int#
n Int# -> Int# -> Int#
-# Int#
1#)
traverse b :: ToBeat (Steps a s p)
b@(ToBeat Int#
bv Steps a s p
br) (Steps v s p -> Steps a s p
f, OkVal a -> v
w Steps a s p
l) Int#
v             Int#
n = {- trace ("adding" ++ show n ++ "\n") $-} ToBeat (Steps a s p)
-> (Steps a s p -> Steps a s p, Steps a s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
forall a s p v.
ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
traverse ToBeat (Steps a s p)
b (Steps v s p -> Steps a s p
f(Steps v s p -> Steps a s p)
-> (Steps a s p -> Steps v s p) -> Steps a s p -> Steps a s p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> v) -> Steps a s p -> Steps v s p
forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
OkVal a -> v
w, Steps a s p
l) (Int#
v Int# -> Int# -> Int#
-# Int#
n Int# -> Int# -> Int#
+# Int#
4#) (Int#
n Int# -> Int# -> Int#
-# Int#
1#)
traverse b :: ToBeat (Steps a s p)
b@(ToBeat Int#
bv Steps a s p
br) (Steps v s p -> Steps a s p
f, Cost Int#
i  Steps v s p
l) Int#
v             Int#
n = if Int# -> Bool
isTrue (Int#
i Int# -> Int# -> Int#
+# Int#
v Int# -> Int# -> Int#
>=# Int#
bv)
                                                           then ToBeat (Steps a s p)
b 
                                                           else ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
forall a s p v.
ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
traverse ToBeat (Steps a s p)
b (Steps v s p -> Steps a s p
f(Steps v s p -> Steps a s p)
-> (Steps v s p -> Steps v s p) -> Steps v s p -> Steps a s p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int# -> Steps v s p -> Steps v s p
forall val s p. Int# -> Steps val s p -> Steps val s p
Cost Int#
i, Steps v s p
l) (Int#
i Int# -> Int# -> Int#
+# Int#
v) Int#
n
traverse b :: ToBeat (Steps a s p)
b@(ToBeat Int#
bv Steps a s p
br) (Steps v s p -> Steps a s p
f, Best Steps v s p
l Steps v s p
_ Steps v s p
r) Int#
v            Int#
n = ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
forall a s p v.
ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
traverse (ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
forall a s p v.
ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
traverse ToBeat (Steps a s p)
b (Steps v s p -> Steps a s p
f, Steps v s p
l) Int#
v Int#
n) (Steps v s p -> Steps a s p
f, Steps v s p
r) Int#
v Int#
n
traverse b :: ToBeat (Steps a s p)
b@(ToBeat Int#
bv Steps a s p
br) (Steps v s p -> Steps a s p
f, StRepair Int#
i Message s p
msgs Steps v s p
r) Int#
v     Int#
n = if Int# -> Bool
isTrue (Int#
i Int# -> Int# -> Int#
+# Int#
v Int# -> Int# -> Int#
>=# Int#
bv) then ToBeat (Steps a s p)
b 
                                                           else ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
forall a s p v.
ToBeat (Steps a s p)
-> (Steps v s p -> Steps a s p, Steps v s p)
-> Int#
-> Int#
-> ToBeat (Steps a s p)
traverse ToBeat (Steps a s p)
b (Steps v s p -> Steps a s p
f(Steps v s p -> Steps a s p)
-> (Steps v s p -> Steps v s p) -> Steps v s p -> Steps a s p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int# -> Message s p -> Steps v s p -> Steps v s p
forall val s p.
Int# -> Message s p -> Steps val s p -> Steps val s p
StRepair Int#
i Message s p
msgs, Steps v s p
r) (Int#
i Int# -> Int# -> Int#
+# Int#
v) (Int#
n Int# -> Int# -> Int#
-# Int#
1#)
traverse b :: ToBeat (Steps a s p)
b@(ToBeat Int#
bv Steps a s p
br) (Steps v s p -> Steps a s p
f, t :: Steps v s p
t@(NoMoreSteps v
_)) Int#
v     Int#
n = if Int# -> Bool
isTrue (Int#
bv Int# -> Int# -> Int#
<=# Int#
v) then ToBeat (Steps a s p)
b else Int# -> Steps a s p -> ToBeat (Steps a s p)
forall a. Int# -> a -> ToBeat a
ToBeat Int#
v (Steps v s p -> Steps a s p
f Steps v s p
t)
-- =======================================================================================
-- ===== DESCRIPTORS =====================================================================
-- =======================================================================================
data AnaParser  state result s p a
 = AnaParser { forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a -> ParsRec state result s p a
pars     :: ParsRec state result s p a
             , forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a -> Nat
leng     :: Nat
             , forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a
-> Maybe (Bool, Either a (ParsRec state result s p a))
zerop    :: Maybe (Bool, Either a (ParsRec state result s p a))
             , forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a -> OneDescr state result s p a
onep     :: OneDescr state  result s p a
             } -- deriving Show
data OneDescr  state result s p a
 = OneDescr  { forall state (result :: * -> * -> *) s p a.
OneDescr state result s p a -> Expecting s
firsts   :: Expecting s
             , forall state (result :: * -> * -> *) s p a.
OneDescr state result s p a
-> [(SymbolR s, TableEntry state result s p a)]
table    :: [(SymbolR s, TableEntry state result s p a)]
             } -- deriving Show
             
data TableEntry state result s p a = TableEntry (ParsRec  state result s p a) (Expecting s -> ParsRec state result s p a)
-- =======================================================================================
-- ===== ANALYSING COMBINATORS ===========================================================
-- =======================================================================================
anaFail :: OutputState a => AnaParser b a c p d
anaFail :: forall (a :: * -> * -> *) b c p d.
OutputState a =>
AnaParser b a c p d
anaFail = AnaParser { pars :: ParsRec b a c p d
pars    = ParsRec b a c p d
forall (a :: * -> * -> *) b c p d.
OutputState a =>
ParsRec b a c p d
libFail
                    , leng :: Nat
leng    = Nat
Infinite
                    , zerop :: Maybe (Bool, Either d (ParsRec b a c p d))
zerop   = Maybe (Bool, Either d (ParsRec b a c p d))
forall a. Maybe a
Nothing
                    , onep :: OneDescr b a c p d
onep    = OneDescr b a c p d
forall {state} {result :: * -> * -> *} {s} {p} {a}.
OneDescr state result s p a
noOneParser
                    }
noOneParser :: OneDescr state result s p a
noOneParser = Expecting s
-> [(SymbolR s, TableEntry state result s p a)]
-> OneDescr state result s p a
forall state (result :: * -> * -> *) s p a.
Expecting s
-> [(SymbolR s, TableEntry state result s p a)]
-> OneDescr state result s p a
OneDescr ([Expecting s] -> Expecting s
forall s. [Expecting s] -> Expecting s
EOr []) []

pEmpty :: ParsRec state result s p a
-> (Bool, Either a (ParsRec state result s p a))
-> AnaParser state result s p a
pEmpty ParsRec state result s p a
p (Bool, Either a (ParsRec state result s p a))
zp = AnaParser { pars :: ParsRec state result s p a
pars    = ParsRec state result s p a
p
                        , leng :: Nat
leng    = Nat
Zero
                        , zerop :: Maybe (Bool, Either a (ParsRec state result s p a))
zerop   = (Bool, Either a (ParsRec state result s p a))
-> Maybe (Bool, Either a (ParsRec state result s p a))
forall a. a -> Maybe a
Just (Bool, Either a (ParsRec state result s p a))
zp
                        , onep :: OneDescr state result s p a
onep    = OneDescr state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a}.
OneDescr state result s p a
noOneParser
                        }

anaSucceed :: a -> AnaParser state result s p a
anaSucceed  a
v = ParsRec state result s p a
-> (Bool, Either a (ParsRec state result s p a))
-> AnaParser state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a}.
ParsRec state result s p a
-> (Bool, Either a (ParsRec state result s p a))
-> AnaParser state result s p a
pEmpty (a -> ParsRec state result s p a
forall {result :: * -> * -> *} {a} {state} {s} {p}.
OutputState result =>
a -> ParsRec state result s p a
libSucceed a
v) (Bool
False, a -> Either a (ParsRec state result s p a)
forall a b. a -> Either a b
Left a
v)
anaLow :: a -> AnaParser state result s p a
anaLow      a
v = ParsRec state result s p a
-> (Bool, Either a (ParsRec state result s p a))
-> AnaParser state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a}.
ParsRec state result s p a
-> (Bool, Either a (ParsRec state result s p a))
-> AnaParser state result s p a
pEmpty (a -> ParsRec state result s p a
forall {result :: * -> * -> *} {a} {state} {s} {p}.
OutputState result =>
a -> ParsRec state result s p a
libSucceed a
v) (Bool
True,  a -> Either a (ParsRec state result s p a)
forall a b. a -> Either a b
Left a
v)
anaDynE :: ParsRec state result s p a -> AnaParser state result s p a
anaDynE     ParsRec state result s p a
p = ParsRec state result s p a
-> (Bool, Either a (ParsRec state result s p a))
-> AnaParser state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a}.
ParsRec state result s p a
-> (Bool, Either a (ParsRec state result s p a))
-> AnaParser state result s p a
pEmpty ParsRec state result s p a
p              (Bool
False, ParsRec state result s p a -> Either a (ParsRec state result s p a)
forall a b. b -> Either a b
Right ParsRec state result s p a
p)
anaDynL :: ParsRec state result s p a -> AnaParser state result s p a
anaDynL     ParsRec state result s p a
p = ParsRec state result s p a
-> (Bool, Either a (ParsRec state result s p a))
-> AnaParser state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a}.
ParsRec state result s p a
-> (Bool, Either a (ParsRec state result s p a))
-> AnaParser state result s p a
pEmpty ParsRec state result s p a
p              (Bool
True , ParsRec state result s p a -> Either a (ParsRec state result s p a)
forall a b. b -> Either a b
Right ParsRec state result s p a
p)
--anaDynN  fi len range p = mkParser  Nothing (OneDescr len fi [(range, p)]) 

anaOr :: AnaParser state result s p a
-> AnaParser state result s p a -> AnaParser state result s p a
anaOr ld :: AnaParser state result s p a
ld@(AnaParser ParsRec state result s p a
_ Nat
ll Maybe (Bool, Either a (ParsRec state result s p a))
zl OneDescr state result s p a
ol)  rd :: AnaParser state result s p a
rd@(AnaParser ParsRec state result s p a
_ Nat
lr Maybe (Bool, Either a (ParsRec state result s p a))
zr OneDescr state result s p a
or)
 = Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
forall state s p (result :: * -> * -> *) a.
(InputState state s p, Symbol s, Ord s, OutputState result) =>
Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
mkParser Nat
newlength Maybe (Bool, Either a (ParsRec state result s p a))
newZeroDescr OneDescr state result s p a
newOneDescr 
   where (Nat
newlength, (b -> b -> c) -> b -> b -> c
maybeswap) = Nat
ll Nat -> Nat -> (Nat, (b -> b -> c) -> b -> b -> c)
forall {b} {c}. Nat -> Nat -> (Nat, (b -> b -> c) -> b -> b -> c)
`nat_min` Nat
lr
         newZeroDescr :: Maybe (Bool, Either a (ParsRec state result s p a))
newZeroDescr  = case Maybe (Bool, Either a (ParsRec state result s p a))
zl of {Maybe (Bool, Either a (ParsRec state result s p a))
Nothing -> Maybe (Bool, Either a (ParsRec state result s p a))
zr
                                    ;Maybe (Bool, Either a (ParsRec state result s p a))
_       -> case Maybe (Bool, Either a (ParsRec state result s p a))
zr of {Maybe (Bool, Either a (ParsRec state result s p a))
Nothing -> Maybe (Bool, Either a (ParsRec state result s p a))
zl
                                                           ;Maybe (Bool, Either a (ParsRec state result s p a))
_       -> [Char] -> Maybe (Bool, Either a (ParsRec state result s p a))
forall {a}. [Char] -> a
usererror ([Char]
"Two empty alternatives")
                                    }                      }
         newOneDescr :: OneDescr state result s p a
newOneDescr   =  (OneDescr state result s p a
 -> OneDescr state result s p a
 -> Bool
 -> OneDescr state result s p a)
-> OneDescr state result s p a
-> OneDescr state result s p a
-> Bool
-> OneDescr state result s p a
forall {b} {c}. (b -> b -> c) -> b -> b -> c
maybeswap OneDescr state result s p a
-> OneDescr state result s p a
-> Bool
-> OneDescr state result s p a
forall {s} {state} {result :: * -> * -> *} {p} {a}.
Ord s =>
OneDescr state result s p a
-> OneDescr state result s p a
-> Bool
-> OneDescr state result s p a
orOneOneDescr OneDescr state result s p a
ol OneDescr state result s p a
or Bool
False

{-
{-# INLINE anaSeq #-}
-}
anaSeq :: (a -> ParsRec state result s p a -> ParsRec state result s p a)
-> (ParsRec state result s p a
    -> ParsRec state result s p a -> ParsRec state result s p a)
-> (a -> a -> a)
-> AnaParser state result s p a
-> AnaParser state result s p a
-> AnaParser state result s p a
anaSeq a -> ParsRec state result s p a -> ParsRec state result s p a
libdollar ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
libseq a -> a -> a
comb (AnaParser  ParsRec state result s p a
pl Nat
ll Maybe (Bool, Either a (ParsRec state result s p a))
zl OneDescr state result s p a
ol)  ~rd :: AnaParser state result s p a
rd@(AnaParser ParsRec state result s p a
pr Nat
lr Maybe (Bool, Either a (ParsRec state result s p a))
zr OneDescr state result s p a
or)
 = case Maybe (Bool, Either a (ParsRec state result s p a))
zl of
   Just (Bool
b, Either a (ParsRec state result s p a)
zp ) -> let newZeroDescr :: Maybe (Bool, Either a (ParsRec state result s p a))
newZeroDescr = Maybe (Bool, Either a (ParsRec state result s p a))
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> (a -> ParsRec state result s p a -> ParsRec state result s p a)
-> (ParsRec state result s p a
    -> ParsRec state result s p a -> ParsRec state result s p a)
-> (a -> a -> a)
-> Maybe (Bool, Either a (ParsRec state result s p a))
forall {result :: * -> * -> *} {t} {t} {a} {state} {s} {p} {b} {a}.
OutputState result =>
Maybe (Bool, Either t t)
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> (t -> ParsRec state result s p a -> b)
-> (t -> ParsRec state result s p a -> b)
-> (t -> a -> a)
-> Maybe (Bool, Either a b)
seqZeroZero Maybe (Bool, Either a (ParsRec state result s p a))
zl Maybe (Bool, Either a (ParsRec state result s p a))
zr   a -> ParsRec state result s p a -> ParsRec state result s p a
libdollar ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
libseq a -> a -> a
comb
                        newOneDescr :: OneDescr state result s p a
newOneDescr = let newOneOne :: OneDescr state result s p a
newOneOne  = (ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a} {state}
       {result :: * -> * -> *} {p} {a}.
(ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
mapOnePars (   ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
`libseq` ParsRec state result s p a
pr) OneDescr state result s p a
ol
                                          newZeroOne :: OneDescr state result s p a
newZeroOne = case Either a (ParsRec state result s p a)
zp of
                                                       Left  a
f -> (ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a} {state}
       {result :: * -> * -> *} {p} {a}.
(ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
mapOnePars (a
f a -> ParsRec state result s p a -> ParsRec state result s p a
`libdollar`   )  OneDescr state result s p a
or
                                                       Right ParsRec state result s p a
p -> (ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a} {state}
       {result :: * -> * -> *} {p} {a}.
(ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
mapOnePars (ParsRec state result s p a
p ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
`libseq`      )  OneDescr state result s p a
or
                                      in OneDescr state result s p a
-> OneDescr state result s p a
-> Bool
-> OneDescr state result s p a
forall {s} {state} {result :: * -> * -> *} {p} {a}.
Ord s =>
OneDescr state result s p a
-> OneDescr state result s p a
-> Bool
-> OneDescr state result s p a
orOneOneDescr OneDescr state result s p a
newZeroOne OneDescr state result s p a
newOneOne  Bool
b -- left one is shortest
                    in Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
forall state s p (result :: * -> * -> *) a.
(InputState state s p, Symbol s, Ord s, OutputState result) =>
Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
mkParser Nat
lr Maybe (Bool, Either a (ParsRec state result s p a))
newZeroDescr OneDescr state result s p a
newOneDescr
   Maybe (Bool, Either a (ParsRec state result s p a))
_            ->  ParsRec state result s p a
-> Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
forall state (result :: * -> * -> *) s p a.
ParsRec state result s p a
-> Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
AnaParser  (ParsRec state result s p a
pl ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
`libseq` ParsRec state result s p a
pr) (Nat
ll Nat -> Nat -> Nat
`nat_add` Nat
lr) Maybe (Bool, Either a (ParsRec state result s p a))
forall a. Maybe a
Nothing  ((ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
forall {state} {result :: * -> * -> *} {s} {p} {a} {state}
       {result :: * -> * -> *} {p} {a}.
(ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
mapOnePars (ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
`libseq` ParsRec state result s p a
pr) OneDescr state result s p a
ol)

seqZeroZero :: Maybe (Bool, Either t t)
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> (t -> ParsRec state result s p a -> b)
-> (t -> ParsRec state result s p a -> b)
-> (t -> a -> a)
-> Maybe (Bool, Either a b)
seqZeroZero Maybe (Bool, Either t t)
Nothing             Maybe (Bool, Either a (ParsRec state result s p a))
_                    t -> ParsRec state result s p a -> b
_          t -> ParsRec state result s p a -> b
_      t -> a -> a
_   = Maybe (Bool, Either a b)
forall a. Maybe a
Nothing
seqZeroZero Maybe (Bool, Either t t)
_                   Maybe (Bool, Either a (ParsRec state result s p a))
Nothing              t -> ParsRec state result s p a -> b
_          t -> ParsRec state result s p a -> b
_      t -> a -> a
_   = Maybe (Bool, Either a b)
forall a. Maybe a
Nothing 
seqZeroZero (Just (Bool
llow, Either t t
left)) (Just (Bool
rlow, Either a (ParsRec state result s p a)
right))  t -> ParsRec state result s p a -> b
libdollar t -> ParsRec state result s p a -> b
libseq t -> a -> a
comb
    = (Bool, Either a b) -> Maybe (Bool, Either a b)
forall a. a -> Maybe a
Just      ( Bool
llow Bool -> Bool -> Bool
|| Bool
rlow
               , case Either t t
left of
                 Left  t
lv  -> case Either a (ParsRec state result s p a)
right of
                              Left  a
rv -> a -> Either a b
forall a b. a -> Either a b
Left (t -> a -> a
comb t
lv a
rv)
                              Right ParsRec state result s p a
rp -> b -> Either a b
forall a b. b -> Either a b
Right (t
lv t -> ParsRec state result s p a -> b
`libdollar` ParsRec state result s p a
rp)
                 Right t
lp  -> case Either a (ParsRec state result s p a)
right of
                              Left  a
rv  -> b -> Either a b
forall a b. b -> Either a b
Right (t
lp t -> ParsRec state result s p a -> b
`libseq` a -> ParsRec state result s p a
forall {result :: * -> * -> *} {a} {state} {s} {p}.
OutputState result =>
a -> ParsRec state result s p a
libSucceed a
rv)
                              Right ParsRec state result s p a
rp  -> b -> Either a b
forall a b. b -> Either a b
Right (t
lp t -> ParsRec state result s p a -> b
`libseq` ParsRec state result s p a
rp)
               )

orOneOneDescr :: OneDescr state result s p a
-> OneDescr state result s p a
-> Bool
-> OneDescr state result s p a
orOneOneDescr ~(OneDescr Expecting s
fl [(SymbolR s, TableEntry state result s p a)]
tl) ~(OneDescr Expecting s
fr [(SymbolR s, TableEntry state result s p a)]
tr)  Bool
b
                  = let keystr :: [SymbolR s]
keystr          = ((SymbolR s, TableEntry state result s p a) -> SymbolR s)
-> [(SymbolR s, TableEntry state result s p a)] -> [SymbolR s]
forall a b. (a -> b) -> [a] -> [b]
map (SymbolR s, TableEntry state result s p a) -> SymbolR s
forall a b. (a, b) -> a
fst [(SymbolR s, TableEntry state result s p a)]
tr
                        lefttab :: [(SymbolR s, TableEntry state result s p a)]
lefttab         = if Bool
b then [(SymbolR s, TableEntry state result s p a)
r | r :: (SymbolR s, TableEntry state result s p a)
r@(SymbolR s
k,TableEntry state result s p a
_) <- [(SymbolR s, TableEntry state result s p a)]
tl, Bool -> Bool
not (SymbolR s
k SymbolR s -> [SymbolR s] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SymbolR s]
keystr)] else [(SymbolR s, TableEntry state result s p a)]
tl
                    in Expecting s
-> [(SymbolR s, TableEntry state result s p a)]
-> OneDescr state result s p a
forall state (result :: * -> * -> *) s p a.
Expecting s
-> [(SymbolR s, TableEntry state result s p a)]
-> OneDescr state result s p a
OneDescr (Expecting s
fl Expecting s -> Expecting s -> Expecting s
forall a. Ord a => Expecting a -> Expecting a -> Expecting a
`eor` Expecting s
fr) ([(SymbolR s, TableEntry state result s p a)]
lefttab [(SymbolR s, TableEntry state result s p a)]
-> [(SymbolR s, TableEntry state result s p a)]
-> [(SymbolR s, TableEntry state result s p a)]
forall a. [a] -> [a] -> [a]
++ [(SymbolR s, TableEntry state result s p a)]
tr)

anaCostRange :: Int# -> d -> SymbolR d -> AnaParser b a d p d
anaCostRange Int#
_        d
_     SymbolR d
EmptyR = AnaParser b a d p d
forall (a :: * -> * -> *) b c p d.
OutputState a =>
AnaParser b a c p d
anaFail
anaCostRange Int#
ins_cost d
ins_sym SymbolR d
range
  = Nat
-> Maybe (Bool, Either d (ParsRec b a d p d))
-> OneDescr b a d p d
-> AnaParser b a d p d
forall state s p (result :: * -> * -> *) a.
(InputState state s p, Symbol s, Ord s, OutputState result) =>
Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
mkParser (Nat -> Nat
Succ Nat
Zero) Maybe (Bool, Either d (ParsRec b a d p d))
forall a. Maybe a
Nothing ( Expecting d
-> [(SymbolR d, TableEntry b a d p d)] -> OneDescr b a d p d
forall state (result :: * -> * -> *) s p a.
Expecting s
-> [(SymbolR s, TableEntry state result s p a)]
-> OneDescr state result s p a
OneDescr  (SymbolR d -> Expecting d
forall s. SymbolR s -> Expecting s
ESym SymbolR d
range) [(SymbolR d
range, ParsRec b a d p d
-> (Expecting d -> ParsRec b a d p d) -> TableEntry b a d p d
forall state (result :: * -> * -> *) s p a.
ParsRec state result s p a
-> (Expecting s -> ParsRec state result s p a)
-> TableEntry state result s p a
TableEntry  ParsRec b a d p d
forall (a :: * -> * -> *) b s p.
(OutputState a, InputState b s p) =>
ParsRec b a s p s
libAccept 
                                                                              (Int# -> d -> Expecting d -> ParsRec b a d p d
forall {result :: * -> * -> *} {state} {a} {p}.
(OutputState result, InputState state a p) =>
Int# -> a -> Expecting a -> ParsRec state result a p a
libInsert Int#
ins_cost d
ins_sym)
                                                         )]) 

--anaCostSym   i ins sym = pCostRange i ins (Range sym sym)

anaGetFirsts :: AnaParser state result s p a -> Expecting s
anaGetFirsts (AnaParser  ParsRec state result s p a
p Nat
l Maybe (Bool, Either a (ParsRec state result s p a))
z OneDescr state result s p a
od) = OneDescr state result s p a -> Expecting s
forall state (result :: * -> * -> *) s p a.
OneDescr state result s p a -> Expecting s
firsts OneDescr state result s p a
od

anaSetFirsts :: Expecting s
-> AnaParser state result s p a -> AnaParser state result s p a
anaSetFirsts Expecting s
newexp (AnaParser  ParsRec state result s p a
_ Nat
l Maybe (Bool, Either a (ParsRec state result s p a))
zd OneDescr state result s p a
od)
 = Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
forall state s p (result :: * -> * -> *) a.
(InputState state s p, Symbol s, Ord s, OutputState result) =>
Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
mkParser Nat
l Maybe (Bool, Either a (ParsRec state result s p a))
zd (OneDescr state result s p a
od{firsts = newexp })

-- =======================================================================================
-- ===== UTILITIES ========================================================================
-- =======================================================================================
mapOnePars :: (ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
mapOnePars ParsRec state result s p a -> ParsRec state result s p a
fp    ~(OneDescr   Expecting s
fi [(SymbolR s, TableEntry state result s p a)]
t) = Expecting s
-> [(SymbolR s, TableEntry state result s p a)]
-> OneDescr state result s p a
forall state (result :: * -> * -> *) s p a.
Expecting s
-> [(SymbolR s, TableEntry state result s p a)]
-> OneDescr state result s p a
OneDescr  Expecting s
fi [ (SymbolR s
k, ParsRec state result s p a
-> (Expecting s -> ParsRec state result s p a)
-> TableEntry state result s p a
forall state (result :: * -> * -> *) s p a.
ParsRec state result s p a
-> (Expecting s -> ParsRec state result s p a)
-> TableEntry state result s p a
TableEntry (ParsRec state result s p a -> ParsRec state result s p a
fp ParsRec state result s p a
p) (ParsRec state result s p a -> ParsRec state result s p a
fp(ParsRec state result s p a -> ParsRec state result s p a)
-> (Expecting s -> ParsRec state result s p a)
-> Expecting s
-> ParsRec state result s p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Expecting s -> ParsRec state result s p a
corr))
                                                   | (SymbolR s
k, TableEntry     ParsRec state result s p a
p      Expecting s -> ParsRec state result s p a
corr ) <- [(SymbolR s, TableEntry state result s p a)]
t
                                                   ]

-- =======================================================================================
-- ===== MKPARSER ========================================================================
-- =======================================================================================
mkParser :: (InputState state s p, Symbol s, Ord s, OutputState result) =>
            Nat -> Maybe (Bool, Either a (ParsRec state result s p a)) -> OneDescr state result s p a -> AnaParser state result s p a
mkParser :: forall state s p (result :: * -> * -> *) a.
(InputState state s p, Symbol s, Ord s, OutputState result) =>
Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
mkParser Nat
length Maybe (Bool, Either a (ParsRec state result s p a))
zd ~descr :: OneDescr state result s p a
descr@(OneDescr Expecting s
firsts [(SymbolR s, TableEntry state result s p a)]
tab) -- pattern matching should be lazy for lazy computation of length for empty parsers
 = let parstab :: [(SymbolR s, ParsRec state result s p a)]
parstab    = ([(SymbolR s, ParsRec state result s p a)]
 -> [(SymbolR s, ParsRec state result s p a)]
 -> [(SymbolR s, ParsRec state result s p a)])
-> [[(SymbolR s, ParsRec state result s p a)]]
-> [(SymbolR s, ParsRec state result s p a)]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 [(SymbolR s, ParsRec state result s p a)]
-> [(SymbolR s, ParsRec state result s p a)]
-> [(SymbolR s, ParsRec state result s p a)]
forall {a} {result :: * -> * -> *} {s} {state} {p} {a}.
(Symbol a, OutputState result, Ord a, Ord s) =>
[(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
mergeTables  [[(SymbolR s
k, ParsRec state result s p a
p)]| (SymbolR s
k, TableEntry ParsRec state result s p a
p Expecting s -> ParsRec state result s p a
_) <- [(SymbolR s, TableEntry state result s p a)]
tab]
       mkactualparser :: (ParsRec state result s p a -> t -> t -> Steps d s p)
-> t -> t -> Steps d s p
mkactualparser ParsRec state result s p a -> t -> t -> Steps d s p
getp 
         = let ptab :: [(SymbolR s, t -> t -> Steps d s p)]
ptab = [(SymbolR s
k, (ParsRec state result s p a -> t -> t -> Steps d s p
getp ParsRec state result s p a
pr) )| (SymbolR s
k, ParsRec state result s p a
pr) <- [(SymbolR s, ParsRec state result s p a)]
parstab]
               find :: s -> Maybe (t -> t -> Steps d s p)
find       = case  [(SymbolR s, t -> t -> Steps d s p)]
ptab of
                            [(SymbolR s
s1,  t -> t -> Steps d s p
p1)]                      ->  ({-# SCC "Locating" #-}\ s
s -> if s -> Bool
r1 s
s then (t -> t -> Steps d s p) -> Maybe (t -> t -> Steps d s p)
forall a. a -> Maybe a
Just t -> t -> Steps d s p
p1 else Maybe (t -> t -> Steps d s p)
forall a. Maybe a
Nothing )                                           
                                                                where  r1 :: s -> Bool
r1 = SymbolR s -> s -> Bool
forall {a}. Ord a => SymbolR a -> a -> Bool
symInRange SymbolR s
s1
                            [(SymbolR s
s1,  t -> t -> Steps d s p
p1), (SymbolR s
s2, t -> t -> Steps d s p
p2)]            -> ({-# SCC "Locating" #-} \ s
s -> if s -> Bool
r1 s
s then (t -> t -> Steps d s p) -> Maybe (t -> t -> Steps d s p)
forall a. a -> Maybe a
Just t -> t -> Steps d s p
p1 else 
                                                                                               if s -> Bool
r2 s
s then (t -> t -> Steps d s p) -> Maybe (t -> t -> Steps d s p)
forall a. a -> Maybe a
Just t -> t -> Steps d s p
p2 else Maybe (t -> t -> Steps d s p)
forall a. Maybe a
Nothing) 
                                                                where  r1 :: s -> Bool
r1 = SymbolR s -> s -> Bool
forall {a}. Ord a => SymbolR a -> a -> Bool
symInRange SymbolR s
s1
                                                                       r2 :: s -> Bool
r2 = SymbolR s -> s -> Bool
forall {a}. Ord a => SymbolR a -> a -> Bool
symInRange SymbolR s
s2
                            [(SymbolR s
s1,  t -> t -> Steps d s p
p1), (SymbolR s
s2, t -> t -> Steps d s p
p2), (SymbolR s
s3, t -> t -> Steps d s p
p3)]  -> ({-# SCC "Locating" #-}\ s
s -> if s -> Bool
r1 s
s then (t -> t -> Steps d s p) -> Maybe (t -> t -> Steps d s p)
forall a. a -> Maybe a
Just t -> t -> Steps d s p
p1 else 
                                                                                              if s -> Bool
r2 s
s then (t -> t -> Steps d s p) -> Maybe (t -> t -> Steps d s p)
forall a. a -> Maybe a
Just t -> t -> Steps d s p
p2 else 
                                                                                              if s -> Bool
r3 s
s then (t -> t -> Steps d s p) -> Maybe (t -> t -> Steps d s p)
forall a. a -> Maybe a
Just t -> t -> Steps d s p
p3 else Maybe (t -> t -> Steps d s p)
forall a. Maybe a
Nothing)
                                                                where  r1 :: s -> Bool
r1 = SymbolR s -> s -> Bool
forall {a}. Ord a => SymbolR a -> a -> Bool
symInRange SymbolR s
s1
                                                                       r2 :: s -> Bool
r2 = SymbolR s -> s -> Bool
forall {a}. Ord a => SymbolR a -> a -> Bool
symInRange SymbolR s
s2
                                                                       r3 :: s -> Bool
r3 = SymbolR s -> s -> Bool
forall {a}. Ord a => SymbolR a -> a -> Bool
symInRange SymbolR s
s3                                           
                            [(SymbolR s, t -> t -> Steps d s p)]
_           -> BinSearchTree (SymbolR s, t -> t -> Steps d s p)
-> s -> Maybe (t -> t -> Steps d s p)
forall a b. Ord a => BinSearchTree (SymbolR a, b) -> a -> Maybe b
lookupSym ([(SymbolR s, t -> t -> Steps d s p)]
-> BinSearchTree (SymbolR s, t -> t -> Steps d s p)
forall av. [av] -> BinSearchTree av
tab2tree [(SymbolR s, t -> t -> Steps d s p)]
ptab)
               zerop :: t -> t -> Steps d s p
zerop      = ParsRec state result s p a -> t -> t -> Steps d s p
getp (case Maybe (Bool, Either a (ParsRec state result s p a))
zd of
                                 Maybe (Bool, Either a (ParsRec state result s p a))
Nothing           -> ParsRec state result s p a
forall (a :: * -> * -> *) b c p d.
OutputState a =>
ParsRec b a c p d
libFail
                                 Just (Bool
_, Left a
v)  -> a -> ParsRec state result s p a
forall {result :: * -> * -> *} {a} {state} {s} {p}.
OutputState result =>
a -> ParsRec state result s p a
libSucceed a
v
                                 Just (Bool
_, Right ParsRec state result s p a
p) -> ParsRec state result s p a
p
                                 )
-- SDS/AD 20050603: only the shortest alternative in possible corrections now is taken
--               insertsyms = foldr1 lib_correct [   getp (pr firsts)| (_ , TableEntry _ pr) <- tab    ]
               insertsyms :: t -> t -> Steps d s p
insertsyms = [t -> t -> Steps d s p] -> t -> t -> Steps d s p
forall a. HasCallStack => [a] -> a
head [   ParsRec state result s p a -> t -> t -> Steps d s p
getp (Expecting s -> ParsRec state result s p a
pr Expecting s
firsts)| (SymbolR s
_ , TableEntry ParsRec state result s p a
_ Expecting s -> ParsRec state result s p a
pr) <- [(SymbolR s, TableEntry state result s p a)]
tab    ]
               correct :: t -> t -> Steps d s p
correct t
k t
inp
                 = case t -> (# s, t #)
forall state s pos.
InputState state s pos =>
state -> (# s, state #)
splitState t
inp of
                       (# s
s, t
ss #) -> let { msg :: Message s p
msg = Expecting s -> p -> Action s -> Message s p
forall sym pos.
Expecting sym -> pos -> Action sym -> Message sym pos
Msg Expecting s
firsts (t -> p
forall state s pos. InputState state s pos => state -> pos
getPosition t
inp) (s -> Action s
forall s. s -> Action s
Delete s
s)
                                          ; newinp :: t
newinp = s -> t -> t
forall state s pos. InputState state s pos => s -> state -> state
deleteSymbol s
s (Message s p -> t -> t
forall state s pos.
InputState state s pos =>
Message s pos -> state -> state
reportError Message s p
msg t
ss)
                                          }
                                      in Steps d s p -> Steps d s p -> (d -> d) -> (d -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libCorrect (Int# -> Message s p -> Steps d s p -> Steps d s p
forall val s p.
Int# -> Message s p -> Steps val s p -> Steps val s p
StRepair (s -> Int#
forall s. Symbol s => s -> Int#
deleteCost s
s) Message s p
msg (t -> t -> Steps d s p
result t
k t
newinp))
                                                              (t -> t -> Steps d s p
insertsyms t
k t
inp) d -> d
forall a. a -> a
id d -> d
forall a. a -> a
id
               result :: t -> t -> Steps d s p
result = if [(SymbolR s, TableEntry state result s p a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SymbolR s, TableEntry state result s p a)]
tab then t -> t -> Steps d s p
zerop
                        else case Maybe (Bool, Either a (ParsRec state result s p a))
zd of
                        Maybe (Bool, Either a (ParsRec state result s p a))
Nothing        ->({-# SCC "mkParser1" #-}\t
k t
inp -> 
                                         case t -> Either' t s
forall state s pos.
InputState state s pos =>
state -> Either' state s
splitStateE t
inp of
                                                    Left' s
s t
ss -> case s -> Maybe (t -> t -> Steps d s p)
find s
s of 
                                                                  Just t -> t -> Steps d s p
p  ->  t -> t -> Steps d s p
p t
k t
inp
                                                                  Maybe (t -> t -> Steps d s p)
Nothing -> t -> t -> Steps d s p
correct t
k t
inp
                                                    Right' t
ss  -> t -> t -> Steps d s p
insertsyms   t
k t
ss)
                        Just (Bool
True, Either a (ParsRec state result s p a)
_) ->({-# SCC "mkParser2" #-}\t
k t
inp -> 
                                         case t -> Either' t s
forall state s pos.
InputState state s pos =>
state -> Either' state s
splitStateE t
inp of
                                                    Left' s
s t
ss -> case s -> Maybe (t -> t -> Steps d s p)
find s
s of 
                                                                  Just t -> t -> Steps d s p
p  -> t -> t -> Steps d s p
p t
k t
inp 
                                                                  Maybe (t -> t -> Steps d s p)
Nothing -> let r :: Steps d s p
r = t -> t -> Steps d s p
zerop t
k t
inp 
                                                                             in if Steps d s p -> Bool
forall a s p. Steps a s p -> Bool
hasSuccess Steps d s p
r then Steps d s p
r else Steps d s p -> Steps d s p -> (d -> d) -> (d -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libCorrect Steps d s p
r (t -> t -> Steps d s p
correct t
k t
inp) d -> d
forall a. a -> a
id d -> d
forall a. a -> a
id
                                                    Right'  t
ss -> t -> t -> Steps d s p
zerop t
k t
ss)
                        Just (Bool
False, Either a (ParsRec state result s p a)
_) ->({-# SCC "mkParser3" #-}\t
k t
inp -> 
                                          case t -> Either' t s
forall state s pos.
InputState state s pos =>
state -> Either' state s
splitStateE t
inp of
                                                    Left' s
s t
ss -> case s -> Maybe (t -> t -> Steps d s p)
find s
s of 
                                                                  Just t -> t -> Steps d s p
p  -> t -> t -> Steps d s p
p t
k t
inp Steps d s p -> Steps d s p -> Steps d s p
forall s b p. Ord s => Steps b s p -> Steps b s p -> Steps b s p
`libBest` t -> t -> Steps d s p
zerop t
k t
inp
                                                                  Maybe (t -> t -> Steps d s p)
Nothing -> let r :: Steps d s p
r = t -> t -> Steps d s p
zerop t
k t
inp 
                                                                             in if Steps d s p -> Bool
forall a s p. Steps a s p -> Bool
hasSuccess Steps d s p
r then Steps d s p
r else Steps d s p -> Steps d s p -> (d -> d) -> (d -> d) -> Steps d s p
forall s b p c d.
Ord s =>
Steps b s p -> Steps c s p -> (b -> d) -> (c -> d) -> Steps d s p
libCorrect Steps d s p
r (t -> t -> Steps d s p
correct t
k t
inp) d -> d
forall a. a -> a
id d -> d
forall a. a -> a
id
                                                    Right' t
ss  -> t -> t -> Steps d s p
zerop t
k t
ss)
           in t -> t -> Steps d s p
result
       res :: ParsRec state result s p a
res    = (RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ((forall r' r''.
 (a -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state 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'
acc ->  (ParsRec state result s p a
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall {t} {p} {t} {d}.
InputState t s p =>
(ParsRec state result s p a -> t -> t -> Steps d s p)
-> t -> t -> Steps d s p
mkactualparser (\ (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p, RealRecogn state s p
_  , RealAccept state result s p a
_)) -> (a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p a -> r'' -> r'
acc))
                     ,(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R (           (ParsRec state result s p a
 -> (state -> Steps r s p) -> state -> Steps r s p)
-> (state -> Steps r s p) -> state -> Steps r s p
forall {t} {p} {t} {d}.
InputState t s p =>
(ParsRec state result s p a -> t -> t -> Steps d s p)
-> t -> t -> Steps d s p
mkactualparser (\ (PR (RealParser state s p a
_  , R forall r. (state -> Steps r s p) -> state -> Steps r s p
p, RealAccept state result s p a
_)) -> (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
p    ))
                     )            
   in ParsRec state result s p a
-> Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
forall state (result :: * -> * -> *) s p a.
ParsRec state result s p a
-> Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
AnaParser ParsRec state result s p a
res Nat
length Maybe (Bool, Either a (ParsRec state result s p a))
zd OneDescr state result s p a
descr
   
-- =======================================================================================
-- ===== MINIMAL LENGTHS (lazily formulated) =============================================
-- =======================================================================================
data Nat = Zero
         | Succ Nat
         | Infinite
         deriving (Nat -> Nat -> Bool
(Nat -> Nat -> Bool) -> (Nat -> Nat -> Bool) -> Eq Nat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Nat -> Nat -> Bool
== :: Nat -> Nat -> Bool
$c/= :: Nat -> Nat -> Bool
/= :: Nat -> Nat -> Bool
Eq, Int -> Nat -> ShowS
[Nat] -> ShowS
Nat -> [Char]
(Int -> Nat -> ShowS)
-> (Nat -> [Char]) -> ([Nat] -> ShowS) -> Show Nat
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Nat -> ShowS
showsPrec :: Int -> Nat -> ShowS
$cshow :: Nat -> [Char]
show :: Nat -> [Char]
$cshowList :: [Nat] -> ShowS
showList :: [Nat] -> ShowS
Show)

nat_le :: Nat -> Nat -> Bool
nat_le Nat
Zero      Nat
_        = Bool
True
nat_le Nat
_         Nat
Zero     = Bool
False
nat_le Nat
Infinite  Nat
_        = Bool
False
nat_le Nat
_         Nat
Infinite = Bool
True
nat_le (Succ Nat
l) (Succ Nat
r) = Nat -> Nat -> Bool
nat_le Nat
l Nat
r

nat_min :: Nat -> Nat -> (Nat, (b -> b -> c) -> b -> b -> c)
nat_min Nat
Infinite   Nat
r          = (Nat
r, (b -> b -> c) -> b -> b -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip) 
nat_min Nat
l          Nat
Infinite   = (Nat
l, (b -> b -> c) -> b -> b -> c
forall a. a -> a
id)
nat_min Nat
Zero       Nat
_          = (Nat
Zero, (b -> b -> c) -> b -> b -> c
forall a. a -> a
id)
nat_min Nat
_          Nat
Zero       = (Nat
Zero, (b -> b -> c) -> b -> b -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip) 
nat_min (Succ Nat
ll)  (Succ Nat
rr)  = let (Nat
v, (b -> b -> c) -> b -> b -> c
fl) = Nat
ll Nat -> Nat -> (Nat, (b -> b -> c) -> b -> b -> c)
`nat_min` Nat
rr in (Nat -> Nat
Succ Nat
v, (b -> b -> c) -> b -> b -> c
fl)

nat_add :: Nat -> Nat -> Nat
nat_add Nat
Infinite  Nat
_ = Nat
Infinite
nat_add Nat
Zero      Nat
r = Nat
r
nat_add (Succ Nat
l)  Nat
r = Nat -> Nat
Succ (Nat -> Nat -> Nat
nat_add Nat
l Nat
r)
-- =======================================================================================
-- ===== CHOICE STRUCTURES   =============================================================
-- =======================================================================================
mergeTables :: [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
mergeTables [(SymbolR a, ParsRec state result s p a)]
l []  = [(SymbolR a, ParsRec state result s p a)]
l
mergeTables [] [(SymbolR a, ParsRec state result s p a)]
r  = [(SymbolR a, ParsRec state result s p a)]
r
mergeTables lss :: [(SymbolR a, ParsRec state result s p a)]
lss@(l :: (SymbolR a, ParsRec state result s p a)
l@(le :: SymbolR a
le@(Range a
a a
b),ParsRec state result s p a
ct ):[(SymbolR a, ParsRec state result s p a)]
ls) rss :: [(SymbolR a, ParsRec state result s p a)]
rss@(r :: (SymbolR a, ParsRec state result s p a)
r@(re :: SymbolR a
re@(Range a
c a
d),ParsRec state result s p a
ct'):[(SymbolR a, ParsRec state result s p a)]
rs)
 = let ct'' :: ParsRec state result s p a
ct'' =  ParsRec state result s p a
ct ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
forall {result :: * -> * -> *} {s} {state} {result :: * -> * -> *}
       {p} {a} {result :: * -> * -> *}.
(OutputState result, Ord s) =>
ParsRec state result s p a
-> ParsRec state result s p a -> ParsRec state result s p a
`libOr` ParsRec state result s p a
ct'
   in  if      a
ca -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
a then   [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
mergeTables [(SymbolR a, ParsRec state result s p a)]
rss [(SymbolR a, ParsRec state result s p a)]
lss     -- swap
       else if a
ba -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
c then (SymbolR a, ParsRec state result s p a)
l(SymbolR a, ParsRec state result s p a)
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
forall a. a -> [a] -> [a]
:[(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
mergeTables [(SymbolR a, ParsRec state result s p a)]
ls  [(SymbolR a, ParsRec state result s p a)]
rss     -- disjoint case
       else if a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
c then (a -> a -> SymbolR a
forall s. s -> s -> SymbolR s
Range a
a (a -> a
forall s. Symbol s => s -> s
symBefore a
c),ParsRec state result s p a
ct) (SymbolR a, ParsRec state result s p a)
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
forall a. a -> [a] -> [a]
:[(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
mergeTables ((a -> a -> SymbolR a
forall s. s -> s -> SymbolR s
Range a
c a
b,ParsRec state result s p a
ct)(SymbolR a, ParsRec state result s p a)
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
forall a. a -> [a] -> [a]
:[(SymbolR a, ParsRec state result s p a)]
ls)             [(SymbolR a, ParsRec state result s p a)]
rss
       else if a
ba -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
d then (a -> a -> SymbolR a
forall s. s -> s -> SymbolR s
Range a
a a
b,ParsRec state result s p a
ct'')           (SymbolR a, ParsRec state result s p a)
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
forall a. a -> [a] -> [a]
:[(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
mergeTables ((a -> a -> SymbolR a
forall s. s -> s -> SymbolR s
Range (a -> a
forall s. Symbol s => s -> s
symAfter a
b) a
d,ParsRec state result s p a
ct')(SymbolR a, ParsRec state result s p a)
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
forall a. a -> [a] -> [a]
:[(SymbolR a, ParsRec state result s p a)]
rs) [(SymbolR a, ParsRec state result s p a)]
ls
       else if a
ba -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
d then [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
mergeTables [(SymbolR a, ParsRec state result s p a)]
rss [(SymbolR a, ParsRec state result s p a)]
lss
                   else (SymbolR a
le,ParsRec state result s p a
ct'') (SymbolR a, ParsRec state result s p a)
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
forall a. a -> [a] -> [a]
: [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
-> [(SymbolR a, ParsRec state result s p a)]
mergeTables [(SymbolR a, ParsRec state result s p a)]
ls [(SymbolR a, ParsRec state result s p a)]
rs-- equals

-- =======================================================================================
-- ===== WRAPPING AND MAPPING ==============================================================
-- =======================================================================================

libMap :: OutputState result =>
             (forall r r'' . (b -> r -> r'') -> state -> Steps (a, r) s p -> ( state, Steps  r'' s p)) 
          -> (forall r     .                    state -> Steps (   r) s p -> ( state, Steps  r   s p))
          -> ParsRec state result s p a -> ParsRec state result s p b
libMap :: forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libMap forall r r''.
(b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
f forall r. state -> Steps r s p -> (state, Steps r s p)
f' (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p, R forall r. (state -> Steps r s p) -> state -> Steps r s p
r, RealAccept state result s p a
_))  = (RealParser state s p b, RealRecogn state s p)
-> ParsRec state result s p b
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ( (forall r' r''.
 (b -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state s p b
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(\b -> r'' -> r'
acc -> let pp :: (state -> Steps r'' s p) -> state -> Steps (a, r'') s p
pp   = (a -> r'' -> (a, r''))
-> (state -> Steps r'' s p) -> state -> Steps (a, r'') s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p (,)
                                                       facc :: state -> Steps (a, r'') s p -> (state, Steps r' s p)
facc = (b -> r'' -> r')
-> state -> Steps (a, r'') s p -> (state, Steps r' s p)
forall r r''.
(b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
f b -> r'' -> r'
acc 
                                                   in \ state -> Steps r'' s p
k state
instate  -> let inresult :: Steps (a, r'') s p
inresult = (state -> Steps r'' s p) -> state -> Steps (a, r'') s p
forall {r''}.
(state -> Steps r'' s p) -> state -> Steps (a, r'') s p
pp state -> Steps r'' s p
k state
outstate
                                                                          (state
outstate, Steps r' s p
outresult) = state -> Steps (a, r'') s p -> (state, Steps r' s p)
facc state
instate Steps (a, r'') s p
inresult
                                                                      in Steps r' s p
outresult
                                          )
                                       , (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R(\ state -> Steps r s p
k state
instate  -> let inresult :: Steps r s p
inresult = (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
r state -> Steps r s p
k state
outstate
                                                               (state
outstate, Steps r s p
outresult) = state -> Steps r s p -> (state, Steps r s p)
forall r. state -> Steps r s p -> (state, Steps r s p)
f' state
instate Steps r s p
inresult
                                                           in Steps r s p
outresult)
                                       )

pMap ::    OutputState result =>
             (forall r r'' . (b -> r -> r'') -> state -> Steps (a, r) s p -> ( state, Steps r'' s p)) 
          -> (forall r     .                    state -> Steps (   r) s p -> ( state, Steps r   s p))
          ->  AnaParser state result s p a -> AnaParser state result s p b

pMap :: forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> AnaParser state result s p a
-> AnaParser state result s p b
pMap forall r r''.
(b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
f forall r. state -> Steps r s p -> (state, Steps r s p)
f'  (AnaParser ParsRec state result s p a
p Nat
l Maybe (Bool, Either a (ParsRec state result s p a))
z OneDescr state result s p a
o) = ParsRec state result s p b
-> Nat
-> Maybe (Bool, Either b (ParsRec state result s p b))
-> OneDescr state result s p b
-> AnaParser state result s p b
forall state (result :: * -> * -> *) s p a.
ParsRec state result s p a
-> Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
AnaParser ((forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libMap (b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
forall r r''.
(b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
f state -> Steps r s p -> (state, Steps r s p)
forall r. state -> Steps r s p -> (state, Steps r s p)
f' ParsRec state result s p a
p)
                                           Nat
l
                                          (case Maybe (Bool, Either a (ParsRec state result s p a))
z of
                                           Maybe (Bool, Either a (ParsRec state result s p a))
Nothing     -> Maybe (Bool, Either b (ParsRec state result s p b))
forall a. Maybe a
Nothing
                                           Just (Bool
b, Either a (ParsRec state result s p a)
v) -> (Bool, Either b (ParsRec state result s p b))
-> Maybe (Bool, Either b (ParsRec state result s p b))
forall a. a -> Maybe a
Just (Bool
b, case Either a (ParsRec state result s p a)
v of
                                                                   Left a
w   -> ParsRec state result s p b -> Either b (ParsRec state result s p b)
forall a b. b -> Either a b
Right ((forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libMap (b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
forall r r''.
(b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
f state -> Steps r s p -> (state, Steps r s p)
forall r. state -> Steps r s p -> (state, Steps r s p)
f' (a -> ParsRec state result s p a
forall {result :: * -> * -> *} {a} {state} {s} {p}.
OutputState result =>
a -> ParsRec state result s p a
libSucceed a
w))
                                                                   Right ParsRec state result s p a
pp -> ParsRec state result s p b -> Either b (ParsRec state result s p b)
forall a b. b -> Either a b
Right ((forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libMap (b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
forall r r''.
(b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
f state -> Steps r s p -> (state, Steps r s p)
forall r. state -> Steps r s p -> (state, Steps r s p)
f' ParsRec state result s p a
pp)))
                                          ((ParsRec state result s p a -> ParsRec state result s p b)
-> OneDescr state result s p a -> OneDescr state result s p b
forall {state} {result :: * -> * -> *} {s} {p} {a} {state}
       {result :: * -> * -> *} {p} {a}.
(ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
mapOnePars ((forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state -> Steps (a, r) s p -> (state, Steps r'' s p))
-> (forall r. state -> Steps r s p -> (state, Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libMap (b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
forall r r''.
(b -> r -> r'')
-> state -> Steps (a, r) s p -> (state, Steps r'' s p)
f state -> Steps r s p -> (state, Steps r s p)
forall r. state -> Steps r s p -> (state, Steps r s p)
f')  OneDescr state result s p a
o)


libWrap :: OutputState result =>
           (forall r r'' .  (b -> r -> r'') 
                                    -> state 
                                    -> Steps (a, r) s p
                                    -> (state -> Steps r s p) 
                                    -> (state, Steps r'' s p, state -> Steps r s p))
           -> (forall r        .   state 
                                -> Steps r s p 
                                -> (state -> Steps r s p) 
                                -> (state, Steps r s p, state -> Steps r s p)) 
           -> ParsRec state result s p a -> ParsRec state result s p b
libWrap :: forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libWrap forall r r''.
(b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
f forall r.
state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
f' (PR (P forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p, R forall r. (state -> Steps r s p) -> state -> Steps r s p
r, RealAccept state result s p a
_)) = (RealParser state s p b, RealRecogn state s p)
-> ParsRec state result s p b
forall {result :: * -> * -> *} {state} {s} {p} {a}.
OutputState result =>
(RealParser state s p a, RealRecogn state s p)
-> ParsRec state result s p a
mkPR ( (forall r' r''.
 (b -> r'' -> r')
 -> (state -> Steps r'' s p) -> state -> Steps r' s p)
-> RealParser state s p b
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(\ b -> r'' -> r'
acc -> let pp :: (state -> Steps r'' s p) -> state -> Steps (a, r'') s p
pp = (a -> r'' -> (a, r''))
-> (state -> Steps r'' s p) -> state -> Steps (a, r'') s p
forall r' r''.
(a -> r'' -> r')
-> (state -> Steps r'' s p) -> state -> Steps r' s p
p (,)
                                                        facc :: state
-> Steps (a, r'') s p
-> (state -> Steps r'' s p)
-> (state, Steps r' s p, state -> Steps r'' s p)
facc = (b -> r'' -> r')
-> state
-> Steps (a, r'') s p
-> (state -> Steps r'' s p)
-> (state, Steps r' s p, state -> Steps r'' s p)
forall r r''.
(b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
f b -> r'' -> r'
acc
                                                    in \ state -> Steps r'' s p
k state
instate  -> let (state
stl, Steps r' s p
ar, state -> Steps r'' s p
str2rr) = state
-> Steps (a, r'') s p
-> (state -> Steps r'' s p)
-> (state, Steps r' s p, state -> Steps r'' s p)
facc state
instate Steps (a, r'') s p
rl state -> Steps r'' s p
k
                                                                           rl :: Steps (a, r'') s p
rl                = (state -> Steps r'' s p) -> state -> Steps (a, r'') s p
forall {r''}.
(state -> Steps r'' s p) -> state -> Steps (a, r'') s p
pp state -> Steps r'' s p
str2rr state
stl
                                                                       in  Steps r' s p
ar
                                     )
                                  , (forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
forall state s p.
(forall r. (state -> Steps r s p) -> state -> Steps r s p)
-> RealRecogn state s p
R(\ state -> Steps r s p
k state
instate  -> let (state
stl, Steps r s p
ar, state -> Steps r s p
str2rr) = state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
forall r.
state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
f' state
instate Steps r s p
rl state -> Steps r s p
k
                                                          rl :: Steps r s p
rl                = (state -> Steps r s p) -> state -> Steps r s p
forall r. (state -> Steps r s p) -> state -> Steps r s p
r state -> Steps r s p
str2rr state
stl
                                                      in  Steps r s p
ar)
                                  )

pWrap ::    OutputState result 
           => (forall r  r'' .   (b -> r -> r'') 
                                    -> state
                                    -> Steps (a, r) s p 
                                    -> (state -> Steps r s p) 
                                    -> (state, Steps r'' s p, state -> Steps r s p))
           -> (forall r        .   state  
                                -> Steps r s p 
                                -> (state -> Steps r s p) 
                                -> (state, Steps r s p, state -> Steps r s p)) 
           -> AnaParser state result s p a -> AnaParser state result s p b

pWrap :: forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> AnaParser state result s p a
-> AnaParser state result s p b
pWrap forall r r''.
(b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
f forall r.
state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
f'  (AnaParser ParsRec state result s p a
p Nat
l Maybe (Bool, Either a (ParsRec state result s p a))
z OneDescr state result s p a
o) = ParsRec state result s p b
-> Nat
-> Maybe (Bool, Either b (ParsRec state result s p b))
-> OneDescr state result s p b
-> AnaParser state result s p b
forall state (result :: * -> * -> *) s p a.
ParsRec state result s p a
-> Nat
-> Maybe (Bool, Either a (ParsRec state result s p a))
-> OneDescr state result s p a
-> AnaParser state result s p a
AnaParser ((forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libWrap (b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
forall r r''.
(b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
f state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
forall r.
state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
f' ParsRec state result s p a
p)
                                          Nat
l
                                          (case Maybe (Bool, Either a (ParsRec state result s p a))
z of
                                           Maybe (Bool, Either a (ParsRec state result s p a))
Nothing     -> Maybe (Bool, Either b (ParsRec state result s p b))
forall a. Maybe a
Nothing
                                           Just (Bool
b, Either a (ParsRec state result s p a)
v) -> (Bool, Either b (ParsRec state result s p b))
-> Maybe (Bool, Either b (ParsRec state result s p b))
forall a. a -> Maybe a
Just (Bool
b, case Either a (ParsRec state result s p a)
v of
                                                                   Left a
w   -> ParsRec state result s p b -> Either b (ParsRec state result s p b)
forall a b. b -> Either a b
Right ((forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libWrap (b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
forall r r''.
(b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
f state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
forall r.
state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
f' (a -> ParsRec state result s p a
forall {result :: * -> * -> *} {a} {state} {s} {p}.
OutputState result =>
a -> ParsRec state result s p a
libSucceed a
w))
                                                                   Right ParsRec state result s p a
pp -> ParsRec state result s p b -> Either b (ParsRec state result s p b)
forall a b. b -> Either a b
Right ((forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libWrap (b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
forall r r''.
(b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
f state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
forall r.
state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
f' ParsRec state result s p a
pp)))
                                          ((ParsRec state result s p a -> ParsRec state result s p b)
-> OneDescr state result s p a -> OneDescr state result s p b
forall {state} {result :: * -> * -> *} {s} {p} {a} {state}
       {result :: * -> * -> *} {p} {a}.
(ParsRec state result s p a -> ParsRec state result s p a)
-> OneDescr state result s p a -> OneDescr state result s p a
mapOnePars ((forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
forall (result :: * -> * -> *) b state a s p.
OutputState result =>
(forall r r''.
 (b -> r -> r'')
 -> state
 -> Steps (a, r) s p
 -> (state -> Steps r s p)
 -> (state, Steps r'' s p, state -> Steps r s p))
-> (forall r.
    state
    -> Steps r s p
    -> (state -> Steps r s p)
    -> (state, Steps r s p, state -> Steps r s p))
-> ParsRec state result s p a
-> ParsRec state result s p b
libWrap (b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
forall r r''.
(b -> r -> r'')
-> state
-> Steps (a, r) s p
-> (state -> Steps r s p)
-> (state, Steps r'' s p, state -> Steps r s p)
f state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
forall r.
state
-> Steps r s p
-> (state -> Steps r s p)
-> (state, Steps r s p, state -> Steps r s p)
f')  OneDescr state result s p a
o)



-- =======================================================================================
-- ===== BINARY SEARCH TREES =============================================================
-- =======================================================================================

lookupSym :: Ord a => BinSearchTree (SymbolR a, b) -> a -> Maybe b
lookupSym :: forall a b. Ord a => BinSearchTree (SymbolR a, b) -> a -> Maybe b
lookupSym = (SymbolR a -> a -> Ordering)
-> BinSearchTree (SymbolR a, b) -> a -> Maybe b
forall a b c.
(a -> b -> Ordering) -> BinSearchTree (a, c) -> b -> Maybe c
btFind SymbolR a -> a -> Ordering
forall {a}. Ord a => SymbolR a -> a -> Ordering
symRS