On 09/23/08 01:01, Jake Mcarthur wrote:
> -----BEGIN PGP SIGNED MESSAGE-----
> Hash: SHA1
>
> The first thing I thought of was to try to apply one of the recursion
> schemes
> in the category-extras package. Here is what I managed using
catamorphism.
>
> - - Jake
>
> -
>
--------------------------------------------------------------------------------
>
>
> data Expr' a
> = Quotient a a
> | Product a a
> | Sum a a
> | Difference a a
> | Lit Double
> | Var Char
>
> type Expr = FixF Expr'
>
> instance Functor Expr' where
> fmap f (a `Quotient` b) = f a `Quotient` f b
> fmap f (a `Product` b) = f a `Product` f b
> fmap f (a `Sum` b) = f a `Sum` f b
> fmap f (a `Difference` b) = f a `Difference` f b
> fmap _ (Lit x) = Lit x
> fmap _ (Var x) = Var x
>
> identity = cata ident
> where ident (a `Quotient` InF (Lit 1)) = a
> ident (a `Product` InF (Lit 1)) = a
> ident (InF (Lit 1) `Product` b) = b
> ident (a `Sum` InF (Lit 0)) = a
> ident (InF (Lit 0) `Sum` b) = b
> ident (a `Difference` InF (Lit 0)) = a
> ident (Lit x) = InF $ Lit x
> ident (Var x) = InF $ Var x
According to:
cata :: Functor f => Algebra f a -> FixF f -> a
from:
http://comonad.com/reader/2008/catamorphism
ident must be:
Algebra f a
for some Functor f; however, I don't see any declaration
of ident as an Algebra f a. Could you please elaborate.
I'm trying to apply this to a simple boolean simplifier
shown in the attachement. As near as I can figure,
maybe the f could be the ArityN in the attachment and
maybe the a would be (Arity0 ConBool var). The output
of the last line of attachment is:
bool_eval:f+f+v0=(:+) (Op0 (OpCon BoolFalse)) (Op0 (OpVar V0))
however, what I want is a complete reduction to:
(OpVar V0)
How can this be done using catamorphisms?
{-# LANGUAGE PatternSignatures #-}
{-
Purpose:
"Try out" the use of catamorphism to simplify an expression
as far as possible.
Reference:
Post:
http://www.nabble.com/Re%3A-Is-there-already-an-abstraction-for-this--p19641692.html
Headers:
From: wren ng thornton
Newsgroups: gmane.comp.lang.haskell.cafe
Subject: Re: Is there already an abstraction for this?
Date: Wed, 24 Sep 2008 00:10:29 -0400
-}
module Main where
import Array
data Arity0 con var --nullary operators
= OpCon con -- constant
| OpVar var -- variable
deriving(Show)
data ArityN arity0
= Op0 arity0
| (:+) (ArityN arity0) (ArityN arity0)
| (:*) (ArityN arity0) (ArityN arity0)
deriving(Show)
infixl 6 :+
infixl 7 :*
instance Functor ArityN where
fmap f (Op0 e) = Op0 (f e)
fmap f ((:+) e0 e1) = (:+) (fmap f e0) (fmap f e1)
fmap f ((:*) e0 e1) = (:*) (fmap f e0) (fmap f e1)
data ConBool --boolean constants
= BoolFalse
| BoolTrue
deriving(Enum,Show,Ord,Eq,Bounded,Ix)
data VarName --varable names
= V0
| V1
| V2
deriving(Enum,Show,Ord,Eq,Bounded,Ix)
bool_eval :: ArityN (Arity0 ConBool var) -> ArityN (Arity0 ConBool var)
bool_eval e = case e of
{ (Op0 (OpCon BoolTrue ) :+ _ ) -> Op0 (OpCon BoolTrue)
; (_ :+ Op0 (OpCon BoolTrue ) ) -> Op0 (OpCon BoolTrue)
; (Op0 (OpCon BoolFalse) :+ e1 ) -> e1
; (e0 :+ Op0 (OpCon BoolFalse) ) -> e0
; (Op0 (OpCon BoolFalse) :* _ ) -> Op0 (OpCon BoolFalse)
; (_ :* Op0 (OpCon BoolFalse) ) -> Op0 (OpCon BoolFalse)
; (e0 :+ e1 ) -> (bool_eval e0) :+ (bool_eval e1)
; (e0 :* e1 ) -> (bool_eval e0) :* (bool_eval e1)
; e -> e
}
main = do
let bool_f::ArityN (Arity0 ConBool VarName) = Op0 (OpCon BoolFalse)
let bool_expr_f_plus_v0 = bool_f :+ Op0 (OpVar V0)
putStr "bool_expr:f+v0="
print bool_expr_f_plus_v0
let bool_eval_f_plus_v0 = bool_eval bool_expr_f_plus_v0
putStr "bool_eval:f+v0="
print bool_eval_f_plus_v0
let bool_expr_f_plus_f_plus_v0 = bool_f :+ bool_expr_f_plus_v0
putStr "bool_expr:f+f+f+v0="
print bool_expr_f_plus_f_plus_v0
let bool_eval_f_plus_f_plus_v0 = bool_eval bool_expr_f_plus_f_plus_v0
putStr "bool_eval:f+f+v0="
print bool_eval_f_plus_f_plus_v0
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
