Can't you trivially satisfy Eq:

instance Eq b => Eq (a -> b) where
        f == g          = False


John Atwood
---------------------------------------------------------
William Lee Irwin III wrote:
> 
> In analysis, functions are usually taken to be an algebra over the
> reals (or C). This tempted me to define the following:
> 
> module FunctionAlgebra where
> instance Num b => Num (a -> b) where
>       f + g           = \x -> (f x) + (g x)
>       f - g           = \x -> (f x) - (g x)
>       f * g           = \x -> (f x) * (g x)
>       negate f        = negate . f
>       abs f           = abs . f
>       signum f        = signum . f
>       fromInt i       = \x -> fromInt i
>       fromInteger i   = \x -> fromInteger i
> 
> Of course, this fails as class Num requires its members to be of
> observable type (instances of Eq, Show). I think it's something
> interesting which Haskell's type system is apparently capable of
> expressing, even though the prelude types conflict with it. Maybe
> someone will find it interesting enough to include support for it
> in the Prelude. Of course, Open Source means if you think something
> should happen, you can make it happen for yourself. =)
> 
> Bill
> P.S.: How does one contribute binaries to the binary distribution
>       archive?
> 
> 




Reply via email to