Open coord-e opened 4 years ago
newtype Names e n = Names { unNames :: Expr n e }
instance Functor (Names e) where
fmap f = Names . cata go . unNames
where
go (VariableF n ) = Variable (f n)
go (InfixF n a b ) = Infix (f n) a b
go (PatternF n ps) = Pattern (f n) ps
-- TODO: omit these verbose matches
go WildcardF = Wildcard
go (ValueF e) = Value e
go (PredicateF e) = Predicate e
go (AndF p1 p2 ) = And p1 p2
go (OrF p1 p2 ) = Or p1 p2
go (NotF p1 ) = Not p1
instance Foldable (Names e) where
foldMap f = cata go . unNames
where
go (VariableF n) = f n
go (InfixF n a b) = f n `mappend` a `mappend` b
go (PatternF n ps) = f n `mappend` fold ps
go _ = mempty
instance Traversable (Names e) where
traverse f = fmap Names . cata go . unNames
where
go (VariableF n ) = Variable <$> f n
go (InfixF n a b ) = Infix <$> f n <*> a <*> b
go (PatternF n ps) = Pattern <$> f n <*> sequenceA ps
-- TODO: omit these verbose matches
go WildcardF = pure Wildcard
go (ValueF e) = pure $ Value e
go (PredicateF e) = pure $ Predicate e
go (AndF p1 p2 ) = And <$> p1 <*> p2
go (OrF p1 p2 ) = Or <$> p1 <*> p2
go (NotF p1 ) = Not <$> p1
newtype ValueExprs n e = ValueExprs { unValueExprs :: Expr n e }
instance Functor (ValueExprs n) where
fmap f = ValueExprs . cata go . unValueExprs
where
go (ValueF e) = Value (f e)
go (PredicateF e) = Predicate (f e)
-- TODO: omit these verbose matches
go WildcardF = Wildcard
go (VariableF n ) = Variable n
go (InfixF n p1 p2) = Infix n p1 p2
go (PatternF n ps) = Pattern n ps
go (AndF p1 p2) = And p1 p2
go (OrF p1 p2) = Or p1 p2
go (NotF p1 ) = Not p1
-- | Map over @n@ in @Expr n e@.
mapName :: (n -> n') -> Expr n e -> Expr n' e
mapName f = unNames . fmap f . Names
-- | Map over @e@ in @Expr n e@.
mapValueExpr :: (e -> e') -> Expr n e -> Expr n e'
mapValueExpr f = unValueExprs . fmap f . ValueExprs
https://github.com/coord-e/egison-pattern-src/blob/10e5337d6cf460eac7b39e1305f42bae85d1906f/src/Language/Egison/Syntax/Pattern/Combinator.hs#L43