{-# 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 System.IO.Unsafe
import System.IO
import Control.Applicative
type Parser s = AnaParser [s] Pair s (Maybe s)
class (Applicative p, Alternative p, Functor p) => IsParser p s | p -> s where
pSucceed :: a -> p a
pLow :: a -> p a
pSucceed = a -> p a
forall a. a -> p a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
pFail :: p a
pCostRange :: Int# -> s -> SymbolR s -> p s
pCostSym :: Int# -> s -> s -> p s
pSym :: s -> p s
pRange :: s -> SymbolR s -> p s
getfirsts :: p v -> Expecting s
setfirsts :: Expecting s -> p v -> p v
pFail = p a
forall a. 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 :: p v -> Maybe (p v)
getonep :: p v -> Maybe (p v)
instance (Ord s, Symbol s, InputState state s p, OutputState result) => IsParser (AnaParser state result s p) s where
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 {a :: * -> * -> *} {b} {d} {p}.
(OutputState a, InputState b d p, Symbol d, Ord d) =>
Int# -> d -> SymbolR d -> AnaParser b a d p d
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 {a :: * -> * -> *} {b} {d} {p}.
(OutputState a, InputState b d p, Symbol d, Ord d) =>
Int# -> d -> SymbolR d -> AnaParser b a d p d
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 = libSucceed `either` id $ e
, leng = Zero
, onep = 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 a. [a] -> 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, Ord s, OutputState result1,
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} {b} {a}.
(OutputState result1, OutputState result2) =>
ParsRec state result3 s p (b -> a)
-> ParsRec state result2 s p b -> ParsRec state result1 s p a
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, Ord s, OutputState result1,
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, Ord s, OutputState result1,
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 a. a -> AnaParser state result s p a
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 a b.
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 (() -> r -> r'')
-> inp -> Steps ((), r) sym pos -> (inp, Steps r'' sym pos)
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 inp -> Steps r sym pos -> (inp, Steps r sym pos)
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 a. a -> AnaParser inp out sym pos a
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 (a -> r -> r'')
-> a -> Steps (Any -> Any, r) c d -> (a, Steps r'' c d)
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 a -> Steps r c d -> (a, Steps r c d)
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 a. a -> AnaParser a b c d a
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 {s} {a} {p}.
(Symbol s, InputState a s p) =>
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
forall a b. a -> b -> b
`seq` a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
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
forall a b. a -> b -> b
`seq` a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
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 a. 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 a. 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v