{-# LANGUAGE OverloadedStrings #-}
module Parsley.Internal.Core.CombinatorAST (module Parsley.Internal.Core.CombinatorAST) where
import Data.Kind (Type)
import Parsley.Internal.Common (IFunctor(..), Fix, Const1(..), cata, intercalateDiff, (:+:))
import Parsley.Internal.Core.Identifiers (MVar, ΣVar)
import Parsley.Internal.Core.CharPred (CharPred)
import Parsley.Internal.Core.Defunc (Defunc)
newtype Parser a = Parser {Parser a -> Fix (Combinator :+: ScopeRegister) a
unParser :: Fix (Combinator :+: ScopeRegister) a}
data Combinator (k :: Type -> Type) (a :: Type) where
Pure :: Defunc a -> Combinator k a
Satisfy :: CharPred -> Combinator k Char
(:<*>:) :: k (a -> b) -> k a -> Combinator k b
(:*>:) :: k a -> k b -> Combinator k b
(:<*:) :: k a -> k b -> Combinator k a
(:<|>:) :: k a -> k a -> Combinator k a
Empty :: Combinator k a
Try :: k a -> Combinator k a
LookAhead :: k a -> Combinator k a
Let :: Bool -> MVar a -> Combinator k a
NotFollowedBy :: k a -> Combinator k ()
Branch :: k (Either a b) -> k (a -> c) -> k (b -> c) -> Combinator k c
Match :: k a -> [Defunc (a -> Bool)] -> [k b] -> k b -> Combinator k b
Loop :: k () -> k a -> Combinator k a
MakeRegister :: ΣVar a -> k a -> k b -> Combinator k b
GetRegister :: ΣVar a -> Combinator k a
PutRegister :: ΣVar a -> k a -> Combinator k ()
Position :: PosSelector -> Combinator k Int
Debug :: String -> k a -> Combinator k a
MetaCombinator :: MetaCombinator -> k a -> Combinator k a
data ScopeRegister (k :: Type -> Type) (a :: Type) where
ScopeRegister :: k a -> (forall r. Reg r a -> k b) -> ScopeRegister k b
data PosSelector where
Line :: PosSelector
Col :: PosSelector
newtype Reg (r :: Type) a = Reg (ΣVar a)
data MetaCombinator where
Cut :: MetaCombinator
RequiresCut :: MetaCombinator
CutImmune :: MetaCombinator
instance IFunctor Combinator where
imap :: (forall j. a j -> b j) -> Combinator a i -> Combinator b i
imap forall j. a j -> b j
_ (Pure Defunc i
x) = Defunc i -> Combinator b i
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure Defunc i
x
imap forall j. a j -> b j
_ (Satisfy CharPred
p) = CharPred -> Combinator b Char
forall (k :: Type -> Type). CharPred -> Combinator k Char
Satisfy CharPred
p
imap forall j. a j -> b j
f (a (a -> i)
p :<*>: a a
q) = a (a -> i) -> b (a -> i)
forall j. a j -> b j
f a (a -> i)
p b (a -> i) -> b a -> Combinator b i
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
:<*>: a a -> b a
forall j. a j -> b j
f a a
q
imap forall j. a j -> b j
f (a a
p :*>: a i
q) = a a -> b a
forall j. a j -> b j
f a a
p b a -> b i -> Combinator b i
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: a i -> b i
forall j. a j -> b j
f a i
q
imap forall j. a j -> b j
f (a i
p :<*: a b
q) = a i -> b i
forall j. a j -> b j
f a i
p b i -> b b -> Combinator b i
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
:<*: a b -> b b
forall j. a j -> b j
f a b
q
imap forall j. a j -> b j
f (a i
p :<|>: a i
q) = a i -> b i
forall j. a j -> b j
f a i
p b i -> b i -> Combinator b i
forall (k :: Type -> Type) a. k a -> k a -> Combinator k a
:<|>: a i -> b i
forall j. a j -> b j
f a i
q
imap forall j. a j -> b j
_ Combinator a i
Empty = Combinator b i
forall (k :: Type -> Type) a. Combinator k a
Empty
imap forall j. a j -> b j
f (Try a i
p) = b i -> Combinator b i
forall (k :: Type -> Type) a. k a -> Combinator k a
Try (a i -> b i
forall j. a j -> b j
f a i
p)
imap forall j. a j -> b j
f (LookAhead a i
p) = b i -> Combinator b i
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead (a i -> b i
forall j. a j -> b j
f a i
p)
imap forall j. a j -> b j
_ (Let Bool
r MVar i
v) = Bool -> MVar i -> Combinator b i
forall a (k :: Type -> Type). Bool -> MVar a -> Combinator k a
Let Bool
r MVar i
v
imap forall j. a j -> b j
f (NotFollowedBy a a
p) = b a -> Combinator b ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy (a a -> b a
forall j. a j -> b j
f a a
p)
imap forall j. a j -> b j
f (Branch a (Either a b)
b a (a -> i)
p a (b -> i)
q) = b (Either a b) -> b (a -> i) -> b (b -> i) -> Combinator b i
forall (k :: Type -> Type) a b c.
k (Either a b) -> k (a -> c) -> k (b -> c) -> Combinator k c
Branch (a (Either a b) -> b (Either a b)
forall j. a j -> b j
f a (Either a b)
b) (a (a -> i) -> b (a -> i)
forall j. a j -> b j
f a (a -> i)
p) (a (b -> i) -> b (b -> i)
forall j. a j -> b j
f a (b -> i)
q)
imap forall j. a j -> b j
f (Match a a
p [Defunc (a -> Bool)]
fs [a i]
qs a i
d) = b a -> [Defunc (a -> Bool)] -> [b i] -> b i -> Combinator b i
forall (k :: Type -> Type) a b.
k a -> [Defunc (a -> Bool)] -> [k b] -> k b -> Combinator k b
Match (a a -> b a
forall j. a j -> b j
f a a
p) [Defunc (a -> Bool)]
fs ((a i -> b i) -> [a i] -> [b i]
forall a b. (a -> b) -> [a] -> [b]
map a i -> b i
forall j. a j -> b j
f [a i]
qs) (a i -> b i
forall j. a j -> b j
f a i
d)
imap forall j. a j -> b j
f (Loop a ()
body a i
exit) = b () -> b i -> Combinator b i
forall (k :: Type -> Type) a. k () -> k a -> Combinator k a
Loop (a () -> b ()
forall j. a j -> b j
f a ()
body) (a i -> b i
forall j. a j -> b j
f a i
exit)
imap forall j. a j -> b j
f (MakeRegister ΣVar a
σ a a
p a i
q) = ΣVar a -> b a -> b i -> Combinator b i
forall a (k :: Type -> Type) b.
ΣVar a -> k a -> k b -> Combinator k b
MakeRegister ΣVar a
σ (a a -> b a
forall j. a j -> b j
f a a
p) (a i -> b i
forall j. a j -> b j
f a i
q)
imap forall j. a j -> b j
_ (GetRegister ΣVar i
σ) = ΣVar i -> Combinator b i
forall a (k :: Type -> Type). ΣVar a -> Combinator k a
GetRegister ΣVar i
σ
imap forall j. a j -> b j
f (PutRegister ΣVar a
σ a a
p) = ΣVar a -> b a -> Combinator b ()
forall a (k :: Type -> Type). ΣVar a -> k a -> Combinator k ()
PutRegister ΣVar a
σ (a a -> b a
forall j. a j -> b j
f a a
p)
imap forall j. a j -> b j
_ (Position PosSelector
sel) = PosSelector -> Combinator b Int
forall (k :: Type -> Type). PosSelector -> Combinator k Int
Position PosSelector
sel
imap forall j. a j -> b j
f (Debug String
name a i
p) = String -> b i -> Combinator b i
forall (k :: Type -> Type) a. String -> k a -> Combinator k a
Debug String
name (a i -> b i
forall j. a j -> b j
f a i
p)
imap forall j. a j -> b j
f (MetaCombinator MetaCombinator
m a i
p) = MetaCombinator -> b i -> Combinator b i
forall (k :: Type -> Type) a.
MetaCombinator -> k a -> Combinator k a
MetaCombinator MetaCombinator
m (a i -> b i
forall j. a j -> b j
f a i
p)
instance Show (Fix Combinator a) where
show :: Fix Combinator a -> String
show = (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") (ShowS -> String)
-> (Fix Combinator a -> ShowS) -> Fix Combinator a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const1 ShowS a -> ShowS
forall a k1 (k2 :: k1). Const1 a k2 -> a
getConst1 (Const1 ShowS a -> ShowS)
-> (Fix Combinator a -> Const1 ShowS a)
-> Fix Combinator a
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall j. Combinator (Const1 ShowS) j -> Const1 ShowS j)
-> Fix Combinator a -> Const1 ShowS a
forall (f :: (Type -> Type) -> Type -> Type) (a :: Type -> Type) i.
IFunctor f =>
(forall j. f a j -> a j) -> Fix f i -> a i
cata (ShowS -> Const1 ShowS j
forall k1 a (k2 :: k1). a -> Const1 a k2
Const1 (ShowS -> Const1 ShowS j)
-> (Combinator (Const1 ShowS) j -> ShowS)
-> Combinator (Const1 ShowS) j
-> Const1 ShowS j
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Combinator (Const1 ShowS) j -> ShowS
forall a. Combinator (Const1 ShowS) a -> ShowS
alg)
where
alg :: Combinator (Const1 ShowS) a -> ShowS
alg (Pure Defunc a
x) = ShowS
"pure " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defunc a -> ShowS
forall a. Show a => a -> ShowS
shows Defunc a
x
alg (Satisfy CharPred
f) = ShowS
"satisfy " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPred -> ShowS
forall a. Show a => a -> ShowS
shows CharPred
f
alg (Const1 pf :<*>: Const1 px) = ShowS
"(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
pf ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" <*> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
px ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (Const1 p :*>: Const1 q) = ShowS
"(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" *> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (Const1 p :<*: Const1 q) = ShowS
"(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" <* " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (Const1 ShowS
p :<|>: Const1 ShowS
q) = ShowS
"(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" <|> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg Combinator (Const1 ShowS) a
Empty = ShowS
"empty"
alg (Try (Const1 ShowS
p)) = ShowS
"try ("ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (LookAhead (Const1 ShowS
p)) = ShowS
"lookAhead (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (Let Bool
False MVar a
v) = ShowS
"let-bound " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> ShowS
forall a. Show a => a -> ShowS
shows MVar a
v
alg (Let Bool
True MVar a
v) = ShowS
"rec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> ShowS
forall a. Show a => a -> ShowS
shows MVar a
v
alg (NotFollowedBy (Const1 ShowS
p)) = ShowS
"notFollowedBy (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (Branch (Const1 ShowS
b) (Const1 ShowS
p) (Const1 ShowS
q)) = ShowS
"branch (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (Match (Const1 ShowS
p) [Defunc (a -> Bool)]
fs [Const1 ShowS a]
qs (Const1 ShowS
def)) = ShowS
"match (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Defunc (a -> Bool)] -> ShowS
forall a. Show a => a -> ShowS
shows [Defunc (a -> Bool)]
fs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> ShowS
forall a. (a -> a) -> [a -> a] -> a -> a
intercalateDiff ShowS
", " ((Const1 ShowS a -> ShowS) -> [Const1 ShowS a] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map Const1 ShowS a -> ShowS
forall a k1 (k2 :: k1). Const1 a k2 -> a
getConst1 [Const1 ShowS a]
qs) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
"] (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
def ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (Loop (Const1 ShowS
body) (Const1 ShowS
exit)) = ShowS
"loop (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
body ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
exit ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (MakeRegister ΣVar a
σ (Const1 ShowS
p) (Const1 ShowS
q)) = ShowS
"make " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΣVar a -> ShowS
forall a. Show a => a -> ShowS
shows ΣVar a
σ ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (GetRegister ΣVar a
σ) = ShowS
"get " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΣVar a -> ShowS
forall a. Show a => a -> ShowS
shows ΣVar a
σ
alg (PutRegister ΣVar a
σ (Const1 ShowS
p)) = ShowS
"put " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΣVar a -> ShowS
forall a. Show a => a -> ShowS
shows ΣVar a
σ ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
alg (Position PosSelector
Line) = ShowS
"line"
alg (Position PosSelector
Col) = ShowS
"col"
alg (Debug String
_ (Const1 ShowS
p)) = ShowS
p
alg (MetaCombinator MetaCombinator
m (Const1 ShowS
p)) = ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaCombinator -> ShowS
forall a. Show a => a -> ShowS
shows MetaCombinator
m ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
"]"
instance IFunctor ScopeRegister where
imap :: (forall j. a j -> b j) -> ScopeRegister a i -> ScopeRegister b i
imap forall j. a j -> b j
f (ScopeRegister a a
p forall r. Reg r a -> a i
g) = b a -> (forall r. Reg r a -> b i) -> ScopeRegister b i
forall (k :: Type -> Type) a b.
k a -> (forall r. Reg r a -> k b) -> ScopeRegister k b
ScopeRegister (a a -> b a
forall j. a j -> b j
f a a
p) (a i -> b i
forall j. a j -> b j
f (a i -> b i) -> (Reg r a -> a i) -> Reg r a -> b i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reg r a -> a i
forall r. Reg r a -> a i
g)
instance Show MetaCombinator where
show :: MetaCombinator -> String
show MetaCombinator
Cut = String
"coins after"
show MetaCombinator
RequiresCut = String
"requires cut"
show MetaCombinator
CutImmune = String
"immune to cuts"
{-# INLINE traverseCombinator #-}
traverseCombinator :: Applicative m => (forall a. f a -> m (k a)) -> Combinator f a -> m (Combinator k a)
traverseCombinator :: (forall a. f a -> m (k a)) -> Combinator f a -> m (Combinator k a)
traverseCombinator forall a. f a -> m (k a)
expose (f (a -> a)
pf :<*>: f a
px) = k (a -> a) -> k a -> Combinator k a
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
(:<*>:) (k (a -> a) -> k a -> Combinator k a)
-> m (k (a -> a)) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> a) -> m (k (a -> a))
forall a. f a -> m (k a)
expose f (a -> a)
pf m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
px
traverseCombinator forall a. f a -> m (k a)
expose (f a
p :*>: f a
q) = k a -> k a -> Combinator k a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
(:*>:) (k a -> k a -> Combinator k a)
-> m (k a) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
q
traverseCombinator forall a. f a -> m (k a)
expose (f a
p :<*: f b
q) = k a -> k b -> Combinator k a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
(:<*:) (k a -> k b -> Combinator k a)
-> m (k a) -> m (k b -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m (k b -> Combinator k a) -> m (k b) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f b -> m (k b)
forall a. f a -> m (k a)
expose f b
q
traverseCombinator forall a. f a -> m (k a)
expose (f a
p :<|>: f a
q) = k a -> k a -> Combinator k a
forall (k :: Type -> Type) a. k a -> k a -> Combinator k a
(:<|>:) (k a -> k a -> Combinator k a)
-> m (k a) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
q
traverseCombinator forall a. f a -> m (k a)
_ Combinator f a
Empty = Combinator k a -> m (Combinator k a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Combinator k a
forall (k :: Type -> Type) a. Combinator k a
Empty
traverseCombinator forall a. f a -> m (k a)
expose (Try f a
p) = k a -> Combinator k a
forall (k :: Type -> Type) a. k a -> Combinator k a
Try (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
expose (LookAhead f a
p) = k a -> Combinator k a
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
expose (NotFollowedBy f a
p) = k a -> Combinator k ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy (k a -> Combinator k ()) -> m (k a) -> m (Combinator k ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
expose (Branch f (Either a b)
b f (a -> a)
p f (b -> a)
q) = k (Either a b) -> k (a -> a) -> k (b -> a) -> Combinator k a
forall (k :: Type -> Type) a b c.
k (Either a b) -> k (a -> c) -> k (b -> c) -> Combinator k c
Branch (k (Either a b) -> k (a -> a) -> k (b -> a) -> Combinator k a)
-> m (k (Either a b))
-> m (k (a -> a) -> k (b -> a) -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Either a b) -> m (k (Either a b))
forall a. f a -> m (k a)
expose f (Either a b)
b m (k (a -> a) -> k (b -> a) -> Combinator k a)
-> m (k (a -> a)) -> m (k (b -> a) -> Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f (a -> a) -> m (k (a -> a))
forall a. f a -> m (k a)
expose f (a -> a)
p m (k (b -> a) -> Combinator k a)
-> m (k (b -> a)) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f (b -> a) -> m (k (b -> a))
forall a. f a -> m (k a)
expose f (b -> a)
q
traverseCombinator forall a. f a -> m (k a)
expose (Match f a
p [Defunc (a -> Bool)]
fs [f a]
qs f a
d) = k a -> [Defunc (a -> Bool)] -> [k a] -> k a -> Combinator k a
forall (k :: Type -> Type) a b.
k a -> [Defunc (a -> Bool)] -> [k b] -> k b -> Combinator k b
Match (k a -> [Defunc (a -> Bool)] -> [k a] -> k a -> Combinator k a)
-> m (k a)
-> m ([Defunc (a -> Bool)] -> [k a] -> k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m ([Defunc (a -> Bool)] -> [k a] -> k a -> Combinator k a)
-> m [Defunc (a -> Bool)] -> m ([k a] -> k a -> Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> [Defunc (a -> Bool)] -> m [Defunc (a -> Bool)]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Defunc (a -> Bool)]
fs m ([k a] -> k a -> Combinator k a)
-> m [k a] -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (f a -> m (k a)) -> [f a] -> m [k a]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse f a -> m (k a)
forall a. f a -> m (k a)
expose [f a]
qs m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
d
traverseCombinator forall a. f a -> m (k a)
expose (Loop f ()
body f a
exit) = k () -> k a -> Combinator k a
forall (k :: Type -> Type) a. k () -> k a -> Combinator k a
Loop (k () -> k a -> Combinator k a)
-> m (k ()) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f () -> m (k ())
forall a. f a -> m (k a)
expose f ()
body m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
exit
traverseCombinator forall a. f a -> m (k a)
expose (MakeRegister ΣVar a
σ f a
p f a
q) = ΣVar a -> k a -> k a -> Combinator k a
forall a (k :: Type -> Type) b.
ΣVar a -> k a -> k b -> Combinator k b
MakeRegister ΣVar a
σ (k a -> k a -> Combinator k a)
-> m (k a) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
q
traverseCombinator forall a. f a -> m (k a)
_ (GetRegister ΣVar a
σ) = Combinator k a -> m (Combinator k a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ΣVar a -> Combinator k a
forall a (k :: Type -> Type). ΣVar a -> Combinator k a
GetRegister ΣVar a
σ)
traverseCombinator forall a. f a -> m (k a)
expose (PutRegister ΣVar a
σ f a
p) = ΣVar a -> k a -> Combinator k ()
forall a (k :: Type -> Type). ΣVar a -> k a -> Combinator k ()
PutRegister ΣVar a
σ (k a -> Combinator k ()) -> m (k a) -> m (Combinator k ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
_ (Position PosSelector
sel) = Combinator k Int -> m (Combinator k Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PosSelector -> Combinator k Int
forall (k :: Type -> Type). PosSelector -> Combinator k Int
Position PosSelector
sel)
traverseCombinator forall a. f a -> m (k a)
expose (Debug String
name f a
p) = String -> k a -> Combinator k a
forall (k :: Type -> Type) a. String -> k a -> Combinator k a
Debug String
name (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
_ (Pure Defunc a
x) = Combinator k a -> m (Combinator k a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Defunc a -> Combinator k a
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure Defunc a
x)
traverseCombinator forall a. f a -> m (k a)
_ (Satisfy CharPred
f) = Combinator k Char -> m (Combinator k Char)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (CharPred -> Combinator k Char
forall (k :: Type -> Type). CharPred -> Combinator k Char
Satisfy CharPred
f)
traverseCombinator forall a. f a -> m (k a)
_ (Let Bool
r MVar a
v) = Combinator k a -> m (Combinator k a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Bool -> MVar a -> Combinator k a
forall a (k :: Type -> Type). Bool -> MVar a -> Combinator k a
Let Bool
r MVar a
v)
traverseCombinator forall a. f a -> m (k a)
expose (MetaCombinator MetaCombinator
m f a
p) = MetaCombinator -> k a -> Combinator k a
forall (k :: Type -> Type) a.
MetaCombinator -> k a -> Combinator k a
MetaCombinator MetaCombinator
m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p