This instance can be made more general without changing the code; change the first line to

instance Num a => Num (e -> a) where

I think this version doesn't even require FlexibleInstances.

This lets you do

f x = if x then 2 else 3
g x = if x then 5 else 10

-- f + g = \x -> if x then 7 else 13

  -- ryan

On Mon, Mar 19, 2012 at 10:38 AM, Ozgur Akgun <ozgurakgun@gmail.com> wrote:
Hi,

If you are feeling adventurous enough, you can define a num instance for functions:

{-# LANGUAGE FlexibleInstances #-}

instance Num a => Num (a -> a) where
    f + g = \ x -> f x + g x
    f - g = \ x -> f x - g x
    f * g = \ x -> f x * g x
    abs f = abs . f
    signum f = signum . f
    fromInteger = const . fromInteger

ghci> let f x = x * 2
ghci> let g x = x * 3
ghci> (f + g) 3
15
ghci> (f+g+2) 2
17

HTH,
Ozgur 


On 19 March 2012 16:57, <sdiyazg@sjtu.edu.cn> wrote:
By arithmetic I mean the everyday arithmetic operations used in engineering.
In signal processing for example, we write a lot of expressions like f(t)=g(t)+h(t)+g'(t) or f(t)=g(t)*h(t).
I feel it would be very natural to have in haskell something like
  g::Float->Float
  --define g here
  h::Float->Float
  --define h here
  f::Float->Float
  f = g+h --instead of f t = g t+h t
  --Of course, f = g+h is defined as f t = g t+h t


_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe