[Haskell-cafe] Optimizing Fold Expressions
José Pedro Magalhães
jpm at cs.uu.nl
Sat Mar 30 20:56:39 CET 2013
Hi,
Actually, if you really want folds, you should use regular [1] instead.
Here's an example of
a generic fold using regular:
-- Datatype representing logical expressions
data Logic = Var String
| Logic :->: Logic -- implication
| Logic :<->: Logic -- equivalence
| Logic :&&: Logic -- and (conjunction)
| Logic :||: Logic -- or (disjunction)
| Not Logic -- not
| T -- true
| F -- false
deriving Show
-- Instantiating Regular for Logic using TH
$(deriveAll ''Logic "PFLogic")
type instance PF Logic = PFLogic
l1, l2, l3 :: Logic
l1 = Var "p"
l2 = Not l1
l3 = l1 :->: l2
-- Testing folding
ex7 :: Bool
ex7 = fold (alg (\_ -> False)) l3 where
alg env = (env & impl & (==) & (&&) & (||) & not & True & False)
impl p q = not p || q
Cheers,
Pedro
[1] http://hackage.haskell.org/package/regular-0.3.4.2
On Sat, Mar 30, 2013 at 7:36 PM, Roman Cheplyaka <roma at ro-che.info> wrote:
> The solution to this problem is called "scrap your boilerplate".
> There are a few libraries that implement it, in different variations.
>
> Let me show you how to do it using my library, 'traverse-with-class'.
> You'll need install it and the 'tagged' package to run this example.
>
> {-# LANGUAGE TemplateHaskell, ImplicitParams, OverlappingInstances,
> MultiParamTypeClasses, ConstraintKinds, UndecidableInstances #-}
>
> import Data.Generics.Traversable
> import Data.Generics.Traversable.TH
> import Data.Proxy
>
> data Expr = Add Expr Expr
> | Sub Expr Expr
> | Mul Expr Expr
> | Eq Expr Expr
> | B Bool
> | I Int
> deriving Show
>
> -- derive a GTraversable instance for our type
> deriveGTraversable ''Expr
>
> -- class to perform our operation
> class IntToBool a where
> intToBool :: a -> a
>
> -- case for expressions: no recursion, we care only about the one level.
> -- The "everywhere" function will do recursion for us.
> instance IntToBool Expr where
> intToBool (I x) = B $ if x == 0 then False else True
> intToBool e = e -- default case for non-I constructors
>
> -- default case for non-expression types (such as Int): do nothing
> instance IntToBool a where
> intToBool = id
>
> -- the final implementation
> replaceIntByBool :: Expr -> Expr
> replaceIntByBool =
> let ?c = Proxy :: Proxy IntToBool in
> everywhere intToBool
>
> Roman
>
> * J. J. W. <bsc.j.j.w at gmail.com> [2013-03-30 19:45:35+0100]
> > Dear all,
> >
> > I was wondering whether it was possible to write fold expressions more
> > elegantly. Suppose I have the following
> > datastructure:
> >
> > data Expr = Add Expr Expr
> > | Sub Expr Expr
> > | Mul Expr Expr
> > | Eq Expr Expr
> > | B Bool
> > | I Int
> > deriving Show
> >
> > type ExprAlgebra r = (r -> r -> r, -- Add
> > r -> r -> r, -- Sub
> > r -> r -> r, -- Mul
> > r -> r -> r, -- Eq
> > Bool -> r, -- Bool
> > Int -> r -- Int
> > )
> >
> > foldAlgebra :: ExprAlgebra r -> Expr -> r
> > foldAlgebra alg@(a, b, c ,d, e, f) (Add x y) = a (foldAlgebra alg x)
> > (foldAlgebra alg y)
> > foldAlgebra alg@(a, b, c ,d, e, f) (Sub x y) = b (foldAlgebra alg x)
> > (foldAlgebra alg y)
> > foldAlgebra alg@(a, b, c ,d, e, f) (Mul x y) = c (foldAlgebra alg x)
> > (foldAlgebra alg y)
> > foldAlgebra alg@(a, b, c ,d, e, f) (Eq x y) = d (foldAlgebra alg x)
> > (foldAlgebra alg y)
> > foldAlgebra alg@(a, b, c ,d, e, f) (B b') = e b'
> > foldAlgebra alg@(a, b, c ,d, e, f) (I i) = f i
> >
> > If I am correct, this works, however if we for example would like to
> > replace all Int's by booleans (note: this is to illustrate my problem):
> >
> > replaceIntByBool = foldAlgebra (Add, Sub, Mul, Eq, B, \x -> if x == 0
> then
> > B False else B True)
> >
> > As you can see, a lot of "useless" identity code. Can I somehow optimize
> > this? Can someone give me some pointers how I can write this more clearly
> > (or with less code?) So I constantly don't have to write Add, Sub, Mul,
> for
> > those things that I just want an "identity function"?
> >
> > Thanks in advance!
> >
> > Jun Jie
>
> > _______________________________________________
> > Haskell-Cafe mailing list
> > Haskell-Cafe at haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130330/d8366271/attachment.htm>
More information about the Haskell-Cafe
mailing list