Question

I have a type

data Value = Int Integer
           | Float Double
           | Complex (Complex Double)
           | ... (other, non-numeric types)

with an associate error type

data ValueError = TypeMismatch Value | ... (other constructors)

type ThrowsError = Either ValueError

and I want to implement generic binary operations over the type, with automatic coercion to the highest type in the heirarchy, and error signalling in case one of the operands isn’t a numeric type, i.e. a function

binaryOp :: Num a => (a -> a -> a) -> Value -> Value -> ThrowsError Value 

so that I could write, for example,

(binaryOp (+)) (Int 1) (Int 1)      ==> Right (Int 2)
(binaryOp (+)) (Int 1) (Float 1.0)  ==> Right (Float 2.0)
(binaryOp (+)) (Int 1) (String "1") ==> Left (TypeMismatch (String "1"))

Is there a simple way to do this? My first thought was to define something like

data NumType = IntType | FloatType | ComplexType

along with functions

typeOf :: Value -> NumType
typeOf (Int _) = IntType
...

promote :: Value -> Value
promote (Int n)   = Float (fromInteger n)
promote (Float n) = Complex (n :+ 0)

but I’m having difficulty making it work. Any advice?

---

A bit more context. I’m writing a Scheme interpreter, and I want to implement the Scheme numeric tower.

In fact I want to achieve something slightly more complicated than what I explained, because I want something applicable to an arbitrary number of arguments, along the lines of

binaryOp :: Num a => (a -> a -> a) -> [Value] -> ThrowsError Value

which would be implemented with foldl1, but I feel that if I can solve the simpler problem then I will be able to solve this more complicated one.

Answer 1

Something like this:

data NumType = IntType | FloatType | ComplexType | NotANumType
  deriving (Eq, Ord)

binaryOp :: (forall a. Num a => a -> a -> a) -> Number -> Number -> ThrowsError Number
binaryOp op x y
   = case typeOf x `max` typeOf y of
          ComplexType -> Complex (asComplex x `op` asComplex y)
          ...

I think you will need to enable the Rank2Types extension (insert {-# LANGUAGE Rank2Types #-} at the top of your source file) to properly state the type of binaryOp, and I’m not sure I’ve got the syntax right…

The type of binaryOp is more complex than you thought because binaryOp chooses what a is when it calls op. What you wrote would have binaryOp‘s caller choosing what a is, which is not what you want.