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

module UU.Parsing.Interface 
       ( AnaParser, pWrap, pMap
       , module UU.Parsing.MachineInterface
       , module UU.Parsing.Interface
       , (<*>), (<*), (*>), (<$>), (<$), (<|>)
       ) where

import GHC.Prim
import UU.Parsing.Machine
import UU.Parsing.MachineInterface
--import IOExts
import System.IO.Unsafe
import System.IO
import Control.Applicative

-- ==================================================================================
-- ===== PRIORITIES ======================================================================
-- =======================================================================================

{- 20150402 AD: use of Applicative, Functor, Alternative
infixl 3 <|>:
infixl 4 <*>:, <$>: 
infixl 4 <$:
infixl 4 <*:, *>:
-}

-- =======================================================================================
-- ===== ANAPARSER INSTANCES =============================================================
-- =======================================================================================
type Parser s = AnaParser [s] Pair s (Maybe s)
-- =======================================================================================
-- ===== PARSER CLASSES ==================================================================
-- =======================================================================================

-- | The 'IsParser' class contains the base combinators with which
-- to write parsers. A minimal complete instance definition consists of
-- definitions for '(<*>)', '(<|>)', 'pSucceed', 'pLow', 'pFail', 
-- 'pCostRange', 'pCostSym', 'getfirsts', 'setfirsts', and 'getzerop'.
-- All operators available through 'Applicative', 'Functor", and 'Alternative' have the same names suffixed with ':'.
class (Applicative p, Alternative p, Functor p) => IsParser p s | p -> s where
  {- 20150402 AD: use of Applicative, Functor, Alternative
  -- | Sequential composition. Often used in combination with <$>.
  -- The function returned by parsing the left-hand side is applied 
  -- to the value returned by parsing the right-hand side.
  -- Note: Implementations of this combinator should lazily match on
  -- and evaluate the right-hand side parser. The derived combinators 
  -- for list parsing will explode if they do not.
  (<*>:) :: p (a->b) -> p a -> p b
  -- | Value ignoring versions of sequential composition. These ignore
  -- either the value returned by the parser on the right-hand side or 
  -- the left-hand side, depending on the visual direction of the
  -- combinator.
  (<*: ) :: p a      -> p b -> p a
  ( *>:) :: p a      -> p b -> p b
  -- | Applies the function f to the result of p after parsing p.
  (<$>:) :: (a->b)   -> p a -> p b
  (<$: ) :: b        -> p a -> p b
  -}
  {- 20150402 AD: use of Applicative, Functor, Alternative
  f <$>: p = pSucceed f <*>: p
  f <$:  q = pSucceed f <*  q
  p <*:  q = pSucceed       const  <*>: p <*>: q
  p  *>: q = pSucceed (flip const) <*>: p <*>: q
  -}
  {- 20150402 AD: use of Applicative, Functor, Alternative
  -- | Alternative combinator. Succeeds if either of the two arguments
  -- succeed, and returns the result of the best success parse.
  (<|>:) :: p a -> p a -> p a
  -}
  -- | Two variants of the parser for empty strings. 'pSucceed' parses the
  -- empty string, and fully counts as an alternative parse. It returns the
  -- value passed to it.
  pSucceed :: a -> p a
  -- | 'pLow' parses the empty string, but alternatives to pLow are always
  -- preferred over 'pLow' parsing the empty string.
  pLow     :: a -> p a
  pSucceed = a -> p a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  -- | This parser always fails, and never returns any value at all.
  pFail :: p a
  -- | Parses a range of symbols with an associated cost and the symbol to
  -- insert if no symbol in the range is present. Returns the actual symbol
  -- parsed.
  pCostRange   :: Int# -> s -> SymbolR s -> p s
  -- | Parses a symbol with an associated cost and the symbol to insert if
  -- the symbol to parse isn't present. Returns either the symbol parsed or
  -- the symbol inserted.
  pCostSym     :: Int# -> s -> s         -> p s
  -- | Parses a symbol. Returns the symbol parsed.
  pSym         ::                   s         -> p s
  pRange       ::              s -> SymbolR s -> p s
  -- | Get the firsts set from the parser, i.e. the symbols it expects.
  getfirsts    :: p v -> Expecting s
  -- | Set the firsts set in the parser.
  setfirsts    :: Expecting s -> p v ->  p v
  pFail        =  p a
forall (f :: * -> *) a. Alternative f => f a
empty
  pSym a :: s
a       =  Int# -> s -> s -> p s
forall (p :: * -> *) s. IsParser p s => Int# -> s -> s -> p s
pCostSym   5# s
a s
a
  pRange       =  Int# -> s -> SymbolR s -> p s
forall (p :: * -> *) s.
IsParser p s =>
Int# -> s -> SymbolR s -> p s
pCostRange 5#
  -- | 'getzerop' returns @Nothing@ if the parser can not parse the empty
  -- string, and returns @Just p@ with @p@ a parser that parses the empty 
  -- string and returns the appropriate value.
  getzerop     ::              p v -> Maybe (p v)
  -- | 'getonep' returns @Nothing@ if the parser can only parse the empty
  -- string, and returns @Just p@ with @p@ a parser that does not parse any
  -- empty string.
  getonep      :: p v -> Maybe (p v)


-- =======================================================================================
-- ===== AnaParser =======================================================================
-- =======================================================================================

-- | The fast 'AnaParser' instance of the 'IsParser' class. Note that this
-- requires a functioning 'Ord' for the symbol type s, as tokens are
-- often compared using the 'compare' function in 'Ord' rather than always
-- using '==' rom 'Eq'. The two do need to be consistent though, that is
-- for any two @x1@, @x2@ such that @x1 == x2@ you must have 
-- @compare x1 x2 == EQ@.
instance (Ord s, Symbol s, InputState state s p, OutputState result) => IsParser (AnaParser state result s p) s where
  {- 20150402 AD: use of Applicative, Functor, Alternative
  (<*>:) p q = anaSeq libDollar  libSeq  ($) p q
  (<*: ) p q = anaSeq libDollarL libSeqL const p q
  ( *>:) p q = anaSeq libDollarR libSeqR (flip const) p q
  pSucceed =  anaSucceed
  (<|>:) =  anaOr
  pFail = anaFail
  -}
  pLow :: a -> AnaParser state result s p a
pLow     =  a -> AnaParser state result s p a
forall (result :: * -> * -> *) a state s p.
OutputState result =>
a -> AnaParser state result s p a
anaLow
  pCostRange :: Int# -> s -> SymbolR s -> AnaParser state result s p s
pCostRange   = Int# -> s -> SymbolR s -> AnaParser state result s p s
forall b s p (a :: * -> * -> *).
(InputState b s p, OutputState a, Symbol s, Ord s) =>
Int# -> s -> SymbolR s -> AnaParser b a s p s
anaCostRange
  pCostSym :: Int# -> s -> s -> AnaParser state result s p s
pCostSym i :: Int#
i ins :: s
ins sym :: s
sym = Int# -> s -> SymbolR s -> AnaParser state result s p s
forall b s p (a :: * -> * -> *).
(InputState b s p, OutputState a, Symbol s, Ord s) =>
Int# -> s -> SymbolR s -> AnaParser b a s p s
anaCostRange Int#
i s
ins (s -> s -> SymbolR s
forall s. Ord s => s -> s -> SymbolR s
mk_range s
sym s
sym)
  getfirsts :: AnaParser state result s p v -> Expecting s
getfirsts    = AnaParser state result s p v -> Expecting s
forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a -> Expecting s
anaGetFirsts
  setfirsts :: Expecting s
-> AnaParser state result s p v -> AnaParser state result s p v
setfirsts    = Expecting s
-> AnaParser state result s p v -> AnaParser state result s p v
forall state s p (result :: * -> * -> *) a.
(InputState state s p, Symbol s, Ord s, OutputState result) =>
Expecting s
-> AnaParser state result s p a -> AnaParser state result s p a
anaSetFirsts
  getzerop :: AnaParser state result s p v
-> Maybe (AnaParser state result s p v)
getzerop  p :: AnaParser state result s p v
p  = case AnaParser state result s p v
-> Maybe (Bool, Either v (ParsRec state result s p v))
forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a
-> Maybe (Bool, Either a (ParsRec state result s p a))
zerop AnaParser state result s p v
p of
                 Nothing     -> Maybe (AnaParser state result s p v)
forall a. Maybe a
Nothing
                 Just (b :: Bool
b,e :: Either v (ParsRec state result s p v)
e)  -> AnaParser state result s p v
-> Maybe (AnaParser state result s p v)
forall a. a -> Maybe a
Just AnaParser state result s p v
p { pars :: ParsRec state result s p v
pars = v -> ParsRec state result s p v
forall (result :: * -> * -> *) a state s p.
OutputState result =>
a -> ParsRec state result s p a
libSucceed (v -> ParsRec state result s p v)
-> (ParsRec state result s p v -> ParsRec state result s p v)
-> Either v (ParsRec state result s p v)
-> ParsRec state result s p v
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
`either` ParsRec state result s p v -> ParsRec state result s p v
forall a. a -> a
id (Either v (ParsRec state result s p v)
 -> ParsRec state result s p v)
-> Either v (ParsRec state result s p v)
-> ParsRec state result s p v
forall a b. (a -> b) -> a -> b
$ Either v (ParsRec state result s p v)
e
                                       , leng :: Nat
leng = Nat
Zero
                                       , onep :: OneDescr state result s p v
onep = OneDescr state result s p v
forall state (result :: * -> * -> *) s p a.
OneDescr state result s p a
noOneParser
                                       }
  getonep :: AnaParser state result s p v
-> Maybe (AnaParser state result s p v)
getonep   p :: AnaParser state result s p v
p = let tab :: [(SymbolR s, TableEntry state result s p v)]
tab = OneDescr state result s p v
-> [(SymbolR s, TableEntry state result s p v)]
forall state (result :: * -> * -> *) s p a.
OneDescr state result s p a
-> [(SymbolR s, TableEntry state result s p a)]
table (AnaParser state result s p v -> OneDescr state result s p v
forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a -> OneDescr state result s p a
onep AnaParser state result s p v
p)
                in if [(SymbolR s, TableEntry state result s p v)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SymbolR s, TableEntry state result s p v)]
tab then Maybe (AnaParser state result s p v)
forall a. Maybe a
Nothing else AnaParser state result s p v
-> Maybe (AnaParser state result s p v)
forall a. a -> Maybe a
Just (Nat
-> Maybe (Bool, Either v (ParsRec state result s p v))
-> OneDescr state result s p v
-> AnaParser state result s p v
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 (AnaParser state result s p v -> Nat
forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a -> Nat
leng AnaParser state result s p v
p) Maybe (Bool, Either v (ParsRec state result s p v))
forall a. Maybe a
Nothing (AnaParser state result s p v -> OneDescr state result s p v
forall state (result :: * -> * -> *) s p a.
AnaParser state result s p a -> OneDescr state result s p a
onep AnaParser state result s p v
p))

instance (Ord s, Symbol s, InputState state s p, OutputState result) => Applicative (AnaParser state result s p) where
  <*> :: AnaParser state result s p (a -> b)
-> AnaParser state result s p a -> AnaParser state result s p b
(<*>) p :: AnaParser state result s p (a -> b)
p q :: AnaParser state result s p a
q = ((a -> b)
 -> ParsRec state result s p a -> ParsRec state result s p b)
-> (ParsRec state result s p (a -> b)
    -> ParsRec state result s p a -> ParsRec state result s p b)
-> ((a -> b) -> a -> b)
-> AnaParser state result s p (a -> b)
-> AnaParser state result s p a
-> AnaParser state result s p b
forall state1 s p1 (result1 :: * -> * -> *)
       (result2 :: * -> * -> *) a1 state2 p2 a2 a3 state3
       (result3 :: * -> * -> *) p3.
(InputState state1 s p1, Symbol s, OutputState result1, Ord s,
 OutputState result2) =>
(a1
 -> ParsRec state2 result2 s p2 a2
 -> ParsRec state1 result1 s p1 a3)
-> (ParsRec state3 result3 s p3 a1
    -> ParsRec state2 result2 s p2 a2
    -> ParsRec state1 result1 s p1 a3)
-> (a1 -> a2 -> a3)
-> AnaParser state3 result3 s p3 a1
-> AnaParser state2 result2 s p2 a2
-> AnaParser state1 result1 s p1 a3
anaSeq (a -> b)
-> ParsRec state result s p a -> ParsRec state result s p b
forall (result1 :: * -> * -> *) a1 a2 state
       (result2 :: * -> * -> *) s p.
OutputState result1 =>
(a1 -> a2)
-> ParsRec state result2 s p a1 -> ParsRec state result1 s p a2
libDollar  ParsRec state result s p (a -> b)
-> ParsRec state result s p a -> ParsRec state result s p b
forall (result1 :: * -> * -> *) (result2 :: * -> * -> *) state
       (result3 :: * -> * -> *) s p a1 a2.
(OutputState result1, OutputState result2) =>
ParsRec state result3 s p (a1 -> a2)
-> ParsRec state result2 s p a1 -> ParsRec state result1 s p a2
libSeq  (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) AnaParser state result s p (a -> b)
p AnaParser state result s p a
q
  {-# INLINE (<*>) #-}
  (<* ) p :: AnaParser state result s p a
p q :: AnaParser state result s p b
q = (a -> ParsRec state result s p b -> ParsRec state result s p a)
-> (ParsRec state result s p a
    -> ParsRec state result s p b -> ParsRec state result s p a)
-> (a -> b -> a)
-> AnaParser state result s p a
-> AnaParser state result s p b
-> AnaParser state result s p a
forall state1 s p1 (result1 :: * -> * -> *)
       (result2 :: * -> * -> *) a1 state2 p2 a2 a3 state3
       (result3 :: * -> * -> *) p3.
(InputState state1 s p1, Symbol s, OutputState result1, Ord s,
 OutputState result2) =>
(a1
 -> ParsRec state2 result2 s p2 a2
 -> ParsRec state1 result1 s p1 a3)
-> (ParsRec state3 result3 s p3 a1
    -> ParsRec state2 result2 s p2 a2
    -> ParsRec state1 result1 s p1 a3)
-> (a1 -> a2 -> a3)
-> AnaParser state3 result3 s p3 a1
-> AnaParser state2 result2 s p2 a2
-> AnaParser state1 result1 s p1 a3
anaSeq a -> ParsRec state result s p b -> ParsRec state result s p a
forall (result1 :: * -> * -> *) a1 state (result2 :: * -> * -> *) s
       p a2.
OutputState result1 =>
a1 -> ParsRec state result2 s p a2 -> ParsRec state result1 s p a1
libDollarL ParsRec state result s p a
-> ParsRec state result s p b -> ParsRec state result s p a
forall (result1 :: * -> * -> *) state (result2 :: * -> * -> *) s p
       a1 (result3 :: * -> * -> *) a2.
OutputState result1 =>
ParsRec state result2 s p a1
-> ParsRec state result3 s p a2 -> ParsRec state result1 s p a1
libSeqL a -> b -> a
forall a b. a -> b -> a
const AnaParser state result s p a
p AnaParser state result s p b
q
  {-# INLINE (<*) #-}
  ( *>) p :: AnaParser state result s p a
p q :: AnaParser state result s p b
q = (a -> ParsRec state result s p b -> ParsRec state result s p b)
-> (ParsRec state result s p a
    -> ParsRec state result s p b -> ParsRec state result s p b)
-> (a -> b -> b)
-> AnaParser state result s p a
-> AnaParser state result s p b
-> AnaParser state result s p b
forall state1 s p1 (result1 :: * -> * -> *)
       (result2 :: * -> * -> *) a1 state2 p2 a2 a3 state3
       (result3 :: * -> * -> *) p3.
(InputState state1 s p1, Symbol s, OutputState result1, Ord s,
 OutputState result2) =>
(a1
 -> ParsRec state2 result2 s p2 a2
 -> ParsRec state1 result1 s p1 a3)
-> (ParsRec state3 result3 s p3 a1
    -> ParsRec state2 result2 s p2 a2
    -> ParsRec state1 result1 s p1 a3)
-> (a1 -> a2 -> a3)
-> AnaParser state3 result3 s p3 a1
-> AnaParser state2 result2 s p2 a2
-> AnaParser state1 result1 s p1 a3
anaSeq a -> ParsRec state result s p b -> ParsRec state result s p b
forall (result1 :: * -> * -> *) p1 state (result2 :: * -> * -> *) s
       p2 a.
OutputState result1 =>
p1 -> ParsRec state result2 s p2 a -> ParsRec state result1 s p2 a
libDollarR ParsRec state result s p a
-> ParsRec state result s p b -> ParsRec state result s p b
forall (result1 :: * -> * -> *) state (result2 :: * -> * -> *) s p
       a1 (result3 :: * -> * -> *) a2.
OutputState result1 =>
ParsRec state result2 s p a1
-> ParsRec state result3 s p a2 -> ParsRec state result1 s p a2
libSeqR ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
forall a b. a -> b -> a
const) AnaParser state result s p a
p AnaParser state result s p b
q
  {-# INLINE (*>) #-}
  pure :: a -> AnaParser state result s p a
pure      = a -> AnaParser state result s p a
forall (result :: * -> * -> *) a state s p.
OutputState result =>
a -> AnaParser state result s p a
anaSucceed
  {-# INLINE pure #-}

instance (Ord s, Symbol s, InputState state s p, OutputState result) => Alternative (AnaParser state result s p) where
  <|> :: AnaParser state result s p a
-> AnaParser state result s p a -> AnaParser state result s p a
(<|>) = AnaParser state result s p a
-> AnaParser state result s p a -> AnaParser state result s p a
forall state s p (result :: * -> * -> *) a.
(InputState state s p, Symbol s, OutputState result, Ord s) =>
AnaParser state result s p a
-> AnaParser state result s p a -> AnaParser state result s p a
anaOr
  {-# INLINE (<|>) #-}
  empty :: AnaParser state result s p a
empty = AnaParser state result s p a
forall (a :: * -> * -> *) b c p d.
OutputState a =>
AnaParser b a c p d
anaFail
  {-# INLINE empty #-}

instance (Ord s, Symbol s, InputState state s p, OutputState result, Applicative (AnaParser state result s p)) => Functor (AnaParser state result s p) where
  fmap :: (a -> b)
-> AnaParser state result s p a -> AnaParser state result s p b
fmap f :: a -> b
f p :: AnaParser state result s p a
p = (a -> b) -> AnaParser state result s p (a -> b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> b
f AnaParser state result s p (a -> b)
-> AnaParser state result s p a -> AnaParser state result s p b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AnaParser state result s p a
p
  {-# INLINE fmap #-}

instance InputState [s] s (Maybe s) where
 splitStateE :: [s] -> Either' [s] s
splitStateE []     = [s] -> Either' [s] s
forall state s. state -> Either' state s
Right' []
 splitStateE (s :: s
s:ss :: [s]
ss) = s -> [s] -> Either' [s] s
forall state s. s -> state -> Either' state s
Left'  s
s [s]
ss
 splitState :: [s] -> (# s, [s] #)
splitState  (s :: s
s:ss :: [s]
ss) = (# s
s, [s]
ss #)
 getPosition :: [s] -> Maybe s
getPosition []     = Maybe s
forall a. Maybe a
Nothing
 getPosition (s :: s
s:ss :: [s]
ss) = s -> Maybe s
forall a. a -> Maybe a
Just s
s


instance OutputState Pair  where
  acceptR :: v -> rest -> Pair v rest
acceptR            = v -> rest -> Pair v rest
forall v rest. v -> rest -> Pair v rest
Pair
  nextR :: (a -> rest -> rest') -> (b -> a) -> Pair b rest -> rest'
nextR       acc :: a -> rest -> rest'
acc    = \ f :: b -> a
f   ~(Pair a :: b
a r :: rest
r) -> a -> rest -> rest'
acc  (b -> a
f b
a) rest
r  
  
pCost :: (OutputState out, InputState inp sym pos, Symbol sym, Ord sym) 
      => Int# -> AnaParser inp out sym pos ()
pCost :: Int# -> AnaParser inp out sym pos ()
pCost x :: Int#
x = (forall r r''.
 (() -> r -> r'')
 -> inp -> Steps ((), r) sym pos -> (inp, Steps r'' sym pos))
-> (forall r. inp -> Steps r sym pos -> (inp, Steps r sym pos))
-> AnaParser inp out sym pos ()
-> AnaParser inp out sym pos ()
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''.
(() -> r -> r'')
-> inp -> Steps ((), r) sym pos -> (inp, Steps r'' sym pos)
forall a b val a s p.
(a -> b -> val) -> a -> Steps (a, b) s p -> (a, Steps val s p)
f forall r. inp -> Steps r sym pos -> (inp, Steps r sym pos)
forall a val s p. a -> Steps val s p -> (a, Steps val s p)
f' (() -> AnaParser inp out sym pos ()
forall (p :: * -> *) s a. IsParser p s => a -> p a
pSucceed ())
  where f :: (a -> b -> val) -> a -> Steps (a, b) s p -> (a, Steps val s p)
f  acc :: a -> b -> val
acc inp :: a
inp steps :: Steps (a, b) s p
steps = (a
inp, Int# -> Steps val s p -> Steps val s p
forall val s p. Int# -> Steps val s p -> Steps val s p
Cost Int#
x (((a, b) -> val) -> Steps (a, b) s p -> Steps val s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val ((a -> b -> val) -> (a, b) -> val
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> val
acc) Steps (a, b) s p
steps))
        f' :: a -> Steps val s p -> (a, Steps val s p)
f'     inp :: a
inp steps :: Steps val s p
steps = (a
inp, Int# -> Steps val s p -> Steps val s p
forall val s p. Int# -> Steps val s p -> Steps val s p
Cost Int#
x Steps val s p
steps)

getInputState :: (InputState a c d, Symbol c, Ord c, OutputState b)=>AnaParser a b c d a
getInputState :: AnaParser a b c d a
getInputState = (forall r r''.
 (a -> r -> r'')
 -> a -> Steps (Any -> Any, r) c d -> (a, Steps r'' c d))
-> (forall r. a -> Steps r c d -> (a, Steps r c d))
-> AnaParser a b c d (Any -> Any)
-> AnaParser a b c d a
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''.
(a -> r -> r'')
-> a -> Steps (Any -> Any, r) c d -> (a, Steps r'' c d)
forall t b b a s p.
(t -> b -> b) -> t -> Steps (a, b) s p -> (t, Steps b s p)
f forall r. a -> Steps r c d -> (a, Steps r c d)
forall a b. a -> b -> (a, b)
g ((Any -> Any) -> AnaParser a b c d (Any -> Any)
forall (p :: * -> *) s a. IsParser p s => a -> p a
pSucceed Any -> Any
forall a. a -> a
id)
  where f :: (t -> b -> b) -> t -> Steps (a, b) s p -> (t, Steps b s p)
f acc :: t -> b -> b
acc inp :: t
inp steps :: Steps (a, b) s p
steps = (t
inp, ((a, b) -> b) -> Steps (a, b) s p -> Steps b s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val (t -> b -> b
acc t
inp (b -> b) -> ((a, b) -> b) -> (a, b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
forall a b. (a, b) -> b
snd) Steps (a, b) s p
steps)
        g :: a -> b -> (a, b)
g = (,)

handleEof :: a -> Steps (Pair a ()) s p
handleEof input :: a
input = case a -> Either' a s
forall state s pos.
InputState state s pos =>
state -> Either' state s
splitStateE a
input
                   of Left'  s :: s
s  ss :: a
ss  ->  Int#
-> Message s p -> Steps (Pair a ()) s p -> Steps (Pair a ()) 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)  
                                                 (Expecting s -> p -> Action s -> Message s p
forall sym pos.
Expecting sym -> pos -> Action sym -> Message sym pos
Msg (String -> Expecting s
forall s. String -> Expecting s
EStr "end of file") (a -> p
forall state s pos. InputState state s pos => state -> pos
getPosition a
input) 
                                                                   (s -> Action s
forall s. s -> Action s
Delete s
s)
                                                 ) 
                                                 (a -> Steps (Pair a ()) s p
handleEof a
ss)
                      Right' ss :: a
ss      ->  Pair a () -> Steps (Pair a ()) s p
forall val s p. val -> Steps val s p
NoMoreSteps (a -> () -> Pair a ()
forall v rest. v -> rest -> Pair v rest
Pair a
ss ())

parse :: (Symbol s, InputState inp s pos) 
      => AnaParser inp Pair s pos a 
      -> inp 
      -> Steps (Pair a (Pair inp ())) s pos
parse :: AnaParser inp Pair s pos a
-> inp -> Steps (Pair a (Pair inp ())) s pos
parse = (inp -> Steps (Pair inp ()) s pos)
-> AnaParser inp Pair s pos a
-> inp
-> Steps (Pair a (Pair inp ())) s pos
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 (Pair inp ()) s pos
forall a s p.
(InputState a s p, Symbol s) =>
a -> Steps (Pair a ()) s p
handleEof


parseIOMessage :: ( Symbol s, InputState inp s p) 
               => (Message s p -> String) 
               -> AnaParser inp Pair s p a 
               -> inp 
               -> IO a
parseIOMessage :: (Message s p -> String) -> AnaParser inp Pair s p a -> inp -> IO a
parseIOMessage showMessage :: Message s p -> String
showMessage p :: AnaParser inp Pair s p a
p inp :: inp
inp
 = do  (Pair v :: a
v final :: Pair inp ()
final) <- (Message s p -> String)
-> Steps (Pair a (Pair inp ())) s p -> IO (Pair a (Pair inp ()))
forall s p b. (Message s p -> String) -> Steps b s p -> IO b
evalStepsIO Message s p -> String
showMessage (AnaParser inp Pair s p a -> inp -> Steps (Pair a (Pair inp ())) s p
forall s inp pos a.
(Symbol s, InputState inp s pos) =>
AnaParser inp Pair s pos a
-> inp -> Steps (Pair a (Pair inp ())) s pos
parse AnaParser inp Pair s p a
p inp
inp) 
       Pair inp ()
final Pair inp () -> IO a -> IO a
forall a b. a -> b -> b
`seq` a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v -- in order to force the trailing error messages to be printed
       
parseIOMessageN :: ( Symbol s, InputState inp s p) 
               => (Message s p -> String) 
               -> Int
               -> AnaParser inp Pair s p a 
               -> inp 
               -> IO a
parseIOMessageN :: (Message s p -> String)
-> Int -> AnaParser inp Pair s p a -> inp -> IO a
parseIOMessageN showMessage :: Message s p -> String
showMessage n :: Int
n p :: AnaParser inp Pair s p a
p inp :: inp
inp
 = do  (Pair v :: a
v final :: Pair inp ()
final) <- (Message s p -> String)
-> Int
-> Steps (Pair a (Pair inp ())) s p
-> IO (Pair a (Pair inp ()))
forall s p b. (Message s p -> String) -> Int -> Steps b s p -> IO b
evalStepsIO' Message s p -> String
showMessage Int
n (AnaParser inp Pair s p a -> inp -> Steps (Pair a (Pair inp ())) s p
forall s inp pos a.
(Symbol s, InputState inp s pos) =>
AnaParser inp Pair s pos a
-> inp -> Steps (Pair a (Pair inp ())) s pos
parse AnaParser inp Pair s p a
p inp
inp) 
       Pair inp ()
final Pair inp () -> IO a -> IO a
forall a b. a -> b -> b
`seq` a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v -- in order to force the trailing error messages to be printed

data Pair a r = Pair a r

evalStepsIO :: (Message s p -> String) 
            ->  Steps b s p 
            -> IO b
evalStepsIO :: (Message s p -> String) -> Steps b s p -> IO b
evalStepsIO showMessage :: Message s p -> String
showMessage = (Message s p -> String) -> Int -> Steps b s p -> IO b
forall s p b. (Message s p -> String) -> Int -> Steps b s p -> IO b
evalStepsIO' Message s p -> String
showMessage (-1)      
       
evalStepsIO' :: (Message s p -> String) 
            -> Int
            ->  Steps b s p 
            -> IO b
evalStepsIO' :: (Message s p -> String) -> Int -> Steps b s p -> IO b
evalStepsIO' showMessage :: Message s p -> String
showMessage n :: Int
n (Steps b s p
steps :: Steps b s p) = Int -> Steps b s p -> IO b
forall a. Int -> Steps a s p -> IO a
eval Int
n Steps b s p
steps
  where eval                      :: Int -> Steps a s p -> IO a
        eval :: Int -> Steps a s p -> IO a
eval 0 steps :: Steps a s p
steps               = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Steps a s p -> a
forall a s p. Steps a s p -> a
evalSteps Steps a s p
steps)
        eval n :: Int
n steps :: Steps a s p
steps = case Steps a s p
steps of
          OkVal v :: a -> a
v        rest :: Steps a s p
rest -> do a
arg <- IO a -> IO a
forall a. IO a -> IO a
unsafeInterleaveIO (Int -> Steps a s p -> IO a
forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest)
                                    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
v a
arg)
          Ok             rest :: Steps a s p
rest -> Int -> Steps a s p -> IO a
forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest
          Cost  _        rest :: Steps a s p
rest -> Int -> Steps a s p -> IO a
forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest
          StRepair _ msg :: Message s p
msg rest :: Steps a s p
rest -> do Handle -> String -> IO ()
hPutStr Handle
stderr (Message s p -> String
showMessage Message s p
msg)
                                    Int -> Steps a s p -> IO a
forall a. Int -> Steps a s p -> IO a
eval (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Steps a s p
rest
          Best _   rest :: Steps a s p
rest   _   -> Int -> Steps a s p -> IO a
forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest
          NoMoreSteps v :: a
v       -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v