{-# 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 s
a       =  Int# -> s -> s -> p s
forall (p :: * -> *) s. IsParser p s => Int# -> s -> s -> p s
pCostSym   Int#
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 Int#
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 :: forall a. 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 Int#
i s
ins 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 :: forall v. 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 :: forall v.
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 :: forall v.
AnaParser state result s p v
-> Maybe (AnaParser state result s p v)
getzerop  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
                 Maybe (Bool, Either v (ParsRec state result s p v))
Nothing     -> Maybe (AnaParser state result s p v)
forall a. Maybe a
Nothing
                 Just (Bool
b,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 :: forall v.
AnaParser state result s p v
-> Maybe (AnaParser state result s p v)
getonep   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
  <*> :: forall a b.
AnaParser state result s p (a -> b)
-> AnaParser state result s p a -> AnaParser state result s p b
(<*>) AnaParser state result s p (a -> b)
p 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 (<*>) #-}
  (<* ) AnaParser state result s p a
p 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 (<*) #-}
  ( *>) AnaParser state result s p a
p 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 :: forall a. 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
  <|> :: forall 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 -> 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 :: forall a. 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 :: forall a b.
(a -> b)
-> AnaParser state result s p a -> AnaParser state result s p b
fmap a -> b
f 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 -> [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
s, [s]
ss #)
 getPosition :: [s] -> Maybe s
getPosition []     = Maybe s
forall a. Maybe a
Nothing
 getPosition (s
s:[s]
ss) = s -> Maybe s
forall a. a -> Maybe a
Just s
s


instance OutputState Pair  where
  acceptR :: forall v rest. v -> rest -> Pair v rest
acceptR            = v -> rest -> Pair v rest
forall v rest. v -> rest -> Pair v rest
Pair
  nextR :: forall a rest rest' b.
(a -> rest -> rest') -> (b -> a) -> Pair b rest -> rest'
nextR       a -> rest -> rest'
acc    = \ b -> a
f   ~(Pair b
a 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 :: forall (out :: * -> * -> *) inp sym pos.
(OutputState out, InputState inp sym pos, Symbol sym, Ord sym) =>
Int# -> AnaParser inp out sym pos ()
pCost 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  a -> b -> val
acc a
inp 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'     a
inp 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 :: forall a c d (b :: * -> * -> *).
(InputState a c d, Symbol c, Ord c, OutputState b) =>
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 t -> b -> b
acc t
inp 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 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  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 String
"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' 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 :: 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 = (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 :: forall s inp p a.
(Symbol s, InputState inp s p) =>
(Message s p -> String) -> AnaParser inp Pair s p a -> inp -> IO a
parseIOMessage Message s p -> String
showMessage AnaParser inp Pair s p a
p inp
inp
 = do  (Pair a
v 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
`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 :: forall s inp p a.
(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
showMessage Int
n AnaParser inp Pair s p a
p inp
inp
 = do  (Pair a
v 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
`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 :: forall s p b. (Message s p -> String) -> Steps b s p -> IO b
evalStepsIO 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 (-Int
1)      
       
evalStepsIO' :: (Message s p -> String) 
            -> Int
            ->  Steps b s p 
            -> IO b
evalStepsIO' :: forall s p b. (Message s p -> String) -> Int -> Steps b s p -> IO b
evalStepsIO' Message s p -> String
showMessage 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 :: forall a. Int -> Steps a s p -> IO a
eval Int
0 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 Int
n Steps a s p
steps = case Steps a s p
steps of
          OkVal a -> a
v        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             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  Int#
_        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 Int#
_ Message s p
msg 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
-Int
1) Steps a s p
rest
          Best Steps a s p
_   Steps a s p
rest   Steps a s p
_   -> 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 a
v       -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v