Hi, thank you for your reply but your MulExpr does not support expressions like
(2*3)+5 Radek On Dec 5, 12:48 am, Martijn van Steenbergen <[email protected]> wrote: > Hi Radek, > > Radek Micek wrote: > > I can write a function to simplify the first expression: > > > simplify :: Expr -> Expr > > simplify = {- replaces: > > "a*1" and "1*a" by "a", > > "a+0" and "0+a" by a -} > > > And I would like to use the function simplify for the second type > > AExpr. What can I do is to convert AExpr to Expr, simplify it and > > convert it back. But I don't like this solution because > > conversions take some time. > > Like Luke said, you can probably work out something using explicit fixed > points. > > Or you can "cheat" a little and use generic programming: > > > {-# LANGUAGE DeriveDataTypeable #-} > > > import Data.Generics > > > data AddExpr = Const Int | Add AddExpr AddExpr > > deriving (Eq, Show, Typeable, Data) > > > data MulExpr = AddMul AddExpr | Mul MulExpr MulExpr > > deriving (Eq, Show, Typeable, Data) > > Here you have explicitly encoded MulExpr as an extension of AddExpr > through the constructor AddMul, just like you asked. > > Now we define the simplification steps you mentioned, one for each > datatype. They perform only one simplification step instead of calling > themselves recursively. The type of simplifyAddStep ensures that it > doesn't accidentally introduce multiplications: > > > simplifyAddStep :: AddExpr -> AddExpr > > simplifyAddStep expr = case expr of > > Add (Const 0) y -> y > > Add x (Const 0) -> x > > _ -> expr > > > simplifyMulStep :: MulExpr -> MulExpr > > simplifyMulStep expr = case expr of > > Mul (AddMul (Const 1)) x -> x > > Mul x (AddMul (Const 1)) -> x > > _ -> expr > > Using generic programming, we can combine these two steps and apply them > recursively on entire trees, bottom-up: > > > simplify :: Data a => a -> a > > simplify = everywhere (id `extT` simplifyAddStep `extT` simplifyMulStep) > > An example invocation: > > > *Main> simplify (AddMul (Const 1) `Mul` (AddMul (Const 2 `Add` Const 0))) > > AddMul (Const 2) > > Hope this helps, > > Martijn. > _______________________________________________ > Haskell-Cafe mailing list > [email protected]http://www.haskell.org/mailman/listinfo/haskell-cafe _______________________________________________ Haskell-Cafe mailing list [email protected] http://www.haskell.org/mailman/listinfo/haskell-cafe
