module Language.Egison.Syntax.Pattern.Combinator
( unAnnotate
, foldExpr
, mapName
, mapVarName
, mapValueExpr
, variables
)
where
import Control.Applicative ( Alternative(..) )
import Data.Foldable ( asum )
import Data.Functor.Foldable ( cata
, embed
)
import Control.Comonad.Cofree ( Cofree )
import Control.Comonad.Trans.Cofree ( CofreeF(..) )
import Language.Egison.Syntax.Pattern.Expr
( Expr(..) )
import Language.Egison.Syntax.Pattern.Base
( ExprF(..) )
unAnnotate :: Cofree (ExprF n v e) a -> Expr n v e
unAnnotate :: Cofree (ExprF n v e) a -> Expr n v e
unAnnotate = (Base (Cofree (ExprF n v e) a) (Expr n v e) -> Expr n v e)
-> Cofree (ExprF n v e) a -> Expr n v e
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Cofree (ExprF n v e) a) (Expr n v e) -> Expr n v e
forall t a. Corecursive t => CofreeF (Base t) a t -> t
go where go :: CofreeF (Base t) a t -> t
go (a
_ :< Base t t
x) = Base t t -> t
forall t. Corecursive t => Base t t -> t
embed Base t t
x
foldExpr :: (ExprF n v e a -> a) -> Expr n v e -> a
foldExpr :: (ExprF n v e a -> a) -> Expr n v e -> a
foldExpr = (ExprF n v e a -> a) -> Expr n v e -> a
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata
mapName :: (n -> n') -> Expr n v e -> Expr n' v e
mapName :: (n -> n') -> Expr n v e -> Expr n' v e
mapName n -> n'
f = (Base (Expr n v e) (Expr n' v e) -> Expr n' v e)
-> Expr n v e -> Expr n' v e
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Expr n v e) (Expr n' v e) -> Expr n' v e
ExprF n v e (Expr n' v e) -> Expr n' v e
go
where
go :: ExprF n v e (Expr n' v e) -> Expr n' v e
go (InfixF n
n Expr n' v e
a Expr n' v e
b ) = n' -> Expr n' v e -> Expr n' v e -> Expr n' v e
forall n v e. n -> Expr n v e -> Expr n v e -> Expr n v e
Infix (n -> n'
f n
n) Expr n' v e
a Expr n' v e
b
go (PatternF n
n [Expr n' v e]
ps) = n' -> [Expr n' v e] -> Expr n' v e
forall n v e. n -> [Expr n v e] -> Expr n v e
Pattern (n -> n'
f n
n) [Expr n' v e]
ps
go ExprF n v e (Expr n' v e)
WildcardF = Expr n' v e
forall n v e. Expr n v e
Wildcard
go (VariableF v
n ) = v -> Expr n' v e
forall n v e. v -> Expr n v e
Variable v
n
go (ValueF e
e ) = e -> Expr n' v e
forall n v e. e -> Expr n v e
Value e
e
go (PredicateF e
e ) = e -> Expr n' v e
forall n v e. e -> Expr n v e
Predicate e
e
go (AndF Expr n' v e
p1 Expr n' v e
p2 ) = Expr n' v e -> Expr n' v e -> Expr n' v e
forall n v e. Expr n v e -> Expr n v e -> Expr n v e
And Expr n' v e
p1 Expr n' v e
p2
go (OrF Expr n' v e
p1 Expr n' v e
p2 ) = Expr n' v e -> Expr n' v e -> Expr n' v e
forall n v e. Expr n v e -> Expr n v e -> Expr n v e
Or Expr n' v e
p1 Expr n' v e
p2
go (NotF Expr n' v e
p1) = Expr n' v e -> Expr n' v e
forall n v e. Expr n v e -> Expr n v e
Not Expr n' v e
p1
go (CollectionF [Expr n' v e]
ps) = [Expr n' v e] -> Expr n' v e
forall n v e. [Expr n v e] -> Expr n v e
Collection [Expr n' v e]
ps
go (TupleF [Expr n' v e]
ps) = [Expr n' v e] -> Expr n' v e
forall n v e. [Expr n v e] -> Expr n v e
Tuple [Expr n' v e]
ps
mapVarName :: (v -> v') -> Expr n v e -> Expr n v' e
mapVarName :: (v -> v') -> Expr n v e -> Expr n v' e
mapVarName v -> v'
f = (Base (Expr n v e) (Expr n v' e) -> Expr n v' e)
-> Expr n v e -> Expr n v' e
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Expr n v e) (Expr n v' e) -> Expr n v' e
ExprF n v e (Expr n v' e) -> Expr n v' e
go
where
go :: ExprF n v e (Expr n v' e) -> Expr n v' e
go (VariableF v
v) = v' -> Expr n v' e
forall n v e. v -> Expr n v e
Variable (v -> v'
f v
v)
go ExprF n v e (Expr n v' e)
WildcardF = Expr n v' e
forall n v e. Expr n v e
Wildcard
go (ValueF e
e ) = e -> Expr n v' e
forall n v e. e -> Expr n v e
Value e
e
go (PredicateF e
e ) = e -> Expr n v' e
forall n v e. e -> Expr n v e
Predicate e
e
go (AndF Expr n v' e
p1 Expr n v' e
p2 ) = Expr n v' e -> Expr n v' e -> Expr n v' e
forall n v e. Expr n v e -> Expr n v e -> Expr n v e
And Expr n v' e
p1 Expr n v' e
p2
go (OrF Expr n v' e
p1 Expr n v' e
p2 ) = Expr n v' e -> Expr n v' e -> Expr n v' e
forall n v e. Expr n v e -> Expr n v e -> Expr n v e
Or Expr n v' e
p1 Expr n v' e
p2
go (NotF Expr n v' e
p1) = Expr n v' e -> Expr n v' e
forall n v e. Expr n v e -> Expr n v e
Not Expr n v' e
p1
go (CollectionF [Expr n v' e]
ps) = [Expr n v' e] -> Expr n v' e
forall n v e. [Expr n v e] -> Expr n v e
Collection [Expr n v' e]
ps
go (TupleF [Expr n v' e]
ps) = [Expr n v' e] -> Expr n v' e
forall n v e. [Expr n v e] -> Expr n v e
Tuple [Expr n v' e]
ps
go (InfixF n
n Expr n v' e
a Expr n v' e
b ) = n -> Expr n v' e -> Expr n v' e -> Expr n v' e
forall n v e. n -> Expr n v e -> Expr n v e -> Expr n v e
Infix n
n Expr n v' e
a Expr n v' e
b
go (PatternF n
n [Expr n v' e]
ps ) = n -> [Expr n v' e] -> Expr n v' e
forall n v e. n -> [Expr n v e] -> Expr n v e
Pattern n
n [Expr n v' e]
ps
mapValueExpr :: (e -> e') -> Expr n v e -> Expr n v e'
mapValueExpr :: (e -> e') -> Expr n v e -> Expr n v e'
mapValueExpr e -> e'
f = (Base (Expr n v e) (Expr n v e') -> Expr n v e')
-> Expr n v e -> Expr n v e'
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Expr n v e) (Expr n v e') -> Expr n v e'
ExprF n v e (Expr n v e') -> Expr n v e'
go
where
go :: ExprF n v e (Expr n v e') -> Expr n v e'
go (ValueF e
e) = e' -> Expr n v e'
forall n v e. e -> Expr n v e
Value (e -> e'
f e
e)
go (PredicateF e
e) = e' -> Expr n v e'
forall n v e. e -> Expr n v e
Predicate (e -> e'
f e
e)
go ExprF n v e (Expr n v e')
WildcardF = Expr n v e'
forall n v e. Expr n v e
Wildcard
go (VariableF v
n ) = v -> Expr n v e'
forall n v e. v -> Expr n v e
Variable v
n
go (CollectionF [Expr n v e']
ps) = [Expr n v e'] -> Expr n v e'
forall n v e. [Expr n v e] -> Expr n v e
Collection [Expr n v e']
ps
go (TupleF [Expr n v e']
ps) = [Expr n v e'] -> Expr n v e'
forall n v e. [Expr n v e] -> Expr n v e
Tuple [Expr n v e']
ps
go (InfixF n
n Expr n v e'
p1 Expr n v e'
p2) = n -> Expr n v e' -> Expr n v e' -> Expr n v e'
forall n v e. n -> Expr n v e -> Expr n v e -> Expr n v e
Infix n
n Expr n v e'
p1 Expr n v e'
p2
go (PatternF n
n [Expr n v e']
ps) = n -> [Expr n v e'] -> Expr n v e'
forall n v e. n -> [Expr n v e] -> Expr n v e
Pattern n
n [Expr n v e']
ps
go (AndF Expr n v e'
p1 Expr n v e'
p2) = Expr n v e' -> Expr n v e' -> Expr n v e'
forall n v e. Expr n v e -> Expr n v e -> Expr n v e
And Expr n v e'
p1 Expr n v e'
p2
go (OrF Expr n v e'
p1 Expr n v e'
p2) = Expr n v e' -> Expr n v e' -> Expr n v e'
forall n v e. Expr n v e -> Expr n v e -> Expr n v e
Or Expr n v e'
p1 Expr n v e'
p2
go (NotF Expr n v e'
p1 ) = Expr n v e' -> Expr n v e'
forall n v e. Expr n v e -> Expr n v e
Not Expr n v e'
p1
variables :: Alternative f => Expr n v e -> f v
variables :: Expr n v e -> f v
variables = (Base (Expr n v e) (f v) -> f v) -> Expr n v e -> f v
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Expr n v e) (f v) -> f v
forall (f :: * -> *) n a e.
Alternative f =>
ExprF n a e (f a) -> f a
go
where
go :: ExprF n a e (f a) -> f a
go (VariableF a
n) = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n
go ExprF n a e (f a)
WildcardF = f a
forall (f :: * -> *) a. Alternative f => f a
empty
go (ValueF e
_ ) = f a
forall (f :: * -> *) a. Alternative f => f a
empty
go (PredicateF e
_ ) = f a
forall (f :: * -> *) a. Alternative f => f a
empty
go (AndF f a
p1 f a
p2 ) = f a
p1 f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
p2
go (OrF f a
p1 f a
p2 ) = f a
p1 f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
p2
go (NotF f a
p1 ) = f a
p1
go (InfixF n
_ f a
a f a
b ) = f a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
b
go (PatternF n
_ [f a]
ps ) = [f a] -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [f a]
ps
go (CollectionF [f a]
ps) = [f a] -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [f a]
ps
go (TupleF [f a]
ps) = [f a] -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [f a]
ps