[Haskell-cafe] Equality of functions
Thomas Hallgren
hallgren at cse.ogi.edu
Tue Nov 30 21:54:02 EST 2004
Adam Zachary Wyner wrote:
>Hi All,
>
>After some weeks of experimenting and digging around, I understand that
>functions cannot be compared for equality. Thanks to Bjorn Lisper for
>pointing this out. I basically understand (?) the underlying mathematical
>issue, which is that functions in general may have infinite domains...
>
>Other suggestions?
>
>
You can define equality for functions with finite domains. See the
enclosed Haskell module.
Loading package base ... linking ... done.
Compiling Finite ( Finite.hs, interpreted )
Ok, modules loaded: Finite.
*Finite> not == not
True
*Finite> (&&) == (&&)
True
*Finite> (&&) == (||)
False
--
Thomas H
-------------- next part --------------
module Finite where
instance (Finite a, Eq b) => Eq (a->b) where
f == g = and [ f x == g x | x <- allValues ]
-- A class for finite types
class Finite a where
allValues :: [a]
instance Finite () where allValues = [()]
instance Finite Bool where allValues = [False,True]
--instance Finite Ordering where ...
--instance Finite Char where ...
--instance Finite Int where ...
instance (Finite a,Finite b) => Finite (a,b) where
allValues = [ (x,y) | x<-allValues, y<-allValues]
instance Finite a => Finite (Maybe a) where
allValues = Nothing:[Just x|x<-allValues]
instance (Finite a,Finite b) => Finite (Either a b) where
allValues = [Left x|x<-allValues]++[Right y|y<-allValues]
-- ...
More information about the Haskell-Cafe
mailing list