-- |
--
-- Module:      Language.Egison.Syntax.Pattern.Parser.Combinator
-- Description: Useful combinators to manipulate Egison pattern ASTs
-- Stability:   experimental
--
-- Useful combinators to manipulate Egison pattern ASTs.

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(..) )


-- | Unwrap annotations from AST.
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

-- | fold an v expr.
--
-- Note that this is just a type specialization of 'cata'.
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

-- TODO: Implement 'mapName' and 'mapValueExpr' by adding newtype wrapper for them and making them instances of 'MonoFunctor'

-- | Map over @n@ in @Expr n v e@.
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
  -- TODO: omit these verbose matches
  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

-- | Map over @v@ in @Expr n v e@.
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)
  -- TODO: omit these verbose matches
  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

-- | Map over @e@ in @Expr n v e@.
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)
  -- TODO: omit these verbose matches
  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

-- | List bound pattern variables in a pattern.
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
  -- TODO: omit these verbose matches
  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