[Haskell-cafe] Fwd: Transforming ASTs
Sergey Vinokurov
serg.foo at gmail.com
Fri May 15 17:26:57 UTC 2015
Hi anakreon,
You should look at paramorphism and histomorphism recursion schemes.
Paramorphism has type f (a, Fix f) -> a, and thus allows you to
pattern match on the subtree that produced the result.
But it's not enough to write simplification of (Not (Not x)) -> x
because it'll have to access simplification result that is more than
one level deep. But this recursion scheme would be helpful for
simpler transformations like (And True x) -> x.
As for original optimization of double negation I'd suggest to use
histomorphism where you'll have access to all the expression
subtrees annotated with intermediate results.
E.g.
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
data Cofree f a = a :< f (Cofree f a)
deriving (Functor)
strip :: (Functor f) => Cofree f a -> Fix f
strip (_ :< x) = Fix $ fmap strip x
newtype Fix f = Fix (f (Fix f))
deriving instance (Show (f (Fix f))) => Show (Fix f)
unFix :: Fix f -> f (Fix f)
unFix (Fix x) = x
histo :: (Functor f) => (f (Cofree f a) -> a) -> Fix f -> a
histo alg x = case histo' alg x of y :< _ -> y
histo' :: (Functor f) => (f (Cofree f a) -> a) -> Fix f -> Cofree f a
histo' alg = (\x -> alg x :< x) . fmap (histo' alg) . unFix
simplify :: Fix BExpr -> Fix BExpr
simplify = histo alg
where
alg :: BExpr (Cofree BExpr Expr) -> Expr
alg (Not (_ :< (Not (x :< _)))) = x
alg x = Fix $ fmap strip x
main :: IO ()
main = do
print $ simplify $ Fix (Not (Fix (Not (Fix (Not (Fix (And (Fix
BTrue) (Fix BFalse))))))))
For more detailed exposition I'd suggest to look into
https://github.com/willtim/recursion-schemes/raw/master/slides-final.pdf
Sergey.
On Fri, May 15, 2015 at 7:08 PM, anakreon <anakreonmejdi at gmail.com> wrote:
> This might be a duplicated message. The first time I posted it I had not
> subscribed to haskell cafe.
>
> Suppose the following data type for encoding Boolean expressions:
>
> data BExpr a = BTrue
> | BFalse
> | Id String
> | Not a
> | And a a
> | Or a a
> | BEq a a
> deriving (Functor)
> type Expr = Fix BExpr
>
> It is easy to produce a string representation of an expression or evaluate
> it:
>
> estr :: BExpr String -> String
> eval :: BExpr Bool -> Bool
>
> with the cata function from Data.Functor.Fixedpoint.
>
> Could you suggest a solution for transforming trees encoded as Exp into
> equivalent Expr (e.g Not Not a ~> a)?
> cata does not work since it expects a function f a -> a while a
> transformation would be f a -> f a.
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>
More information about the Haskell-Cafe
mailing list