Haskell Type Promotion

Question

I am currently working my way through Write Yourself a Scheme in 48 Hours and am stuck on type promotion.

In short, scheme has a numerical tower (Integer->Rational->Real->Complex) with the numeric promotions one would expect. I modeled numbers with the obvious

data Number = Integer Integer | Rational Rational | Real Double | Complex (Complex Double)

so using Rank2Types seemed like an easy way to make functions work over this range of types. For Num a this looks like

liftNum :: (forall a . Num a => a -> a -> a) -> LispVal -> LispVal -> ThrowsError LispVal
liftNum f a b = case typeEnum a `max` typeEnum b of
  ComplexType  -> return . Number . Complex $ toComplex a `f` toComplex b
  RealType     -> return . Number . Real $ toReal a `f` toReal b
  RationalType -> return . Number . Rational $ toFrac a `f` toFrac b
  IntType      -> return . Number . Integer $ toInt a `f` toInt b
  _            -> typeErr a b "Number"

which works but quickly becomes verbose because a separate block is required for each type class.
Even worse, this implementation of Complex is simplified since scheme can use separate types for the real and complex part. Implementing this would require a custom version holding two Number's which would make the verbosity even worse if I wanted to avoid making the type recursive.

As far as I know there is no way to abstract over the context so I am hoping for a cleaner way to implement this number logic.

Thanks for reading!

Answer 1

Here's a proposal. The primary thing we want your typeEnum function to do that it doesn't yet is bring a Num a dictionary into scope. So let's use GADTs to make that happen. I'll simplify a few things to make it easier to explain the idea and write the code, but nothing essential: I'll focus on Number rather than LispVal and I won't report detailed errors when things go wrong. First some boilerplate:

{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
import Control.Applicative
import Data.Complex

Now, you didn't give your definition of a type enumeration. But I'll give mine, because it's part of the secret sauce: my type enumeration is going to have a connection between Haskell's term level and Haskell's type level via a GADT.

data TypeEnum a where
    Integer  :: TypeEnum Integer
    Rational :: TypeEnum Rational
    Real     :: TypeEnum Double
    Complex  :: TypeEnum (Complex Double)

Because of this connection, my Number type won't need to repeat each of these cases again. (I suspect your TypeEnum and Number types are quite repetitive compared to each other.)

data Number where
    Number :: TypeEnum a -> a -> Number

Now we're going to define a new type that you didn't have, which will tie a TypeEnum together with a Num dictionary for the appropriate type. This will be the return type of our typeEnum function.

data TypeDict where
    TypeDict :: Num a => TypeEnum a -> TypeDict

ordering :: TypeEnum a -> Int
ordering Integer  = 0 -- lowest
ordering Rational = 1
ordering Real     = 2
ordering Complex  = 3 -- highest

instance Eq  TypeDict where TypeDict l == TypeDict r = ordering l == ordering r
instance Ord TypeDict where compare (TypeDict l) (TypeDict r) = compare (ordering l) (ordering r)

The ordering function reflects (my guess at) the direction that casts can go. If you try to implement Eq and Ord yourself for this type, without peeking at my solution, I suspect you will discover why GHC balks at deriving these classes for GADTs. (At the very least, it took me a few tries! The obvious definitions don't type-check, and the slightly less obvious definitions had the wrong behavior.)

Now we are ready to write a function that produces a dictionary for a number.

typeEnum :: Number -> TypeDict
typeEnum (Number Integer  _) = TypeDict Integer
typeEnum (Number Rational _) = TypeDict Rational
typeEnum (Number Real     _) = TypeDict Real
typeEnum (Number Complex  _) = TypeDict Complex

We will also need the casting function; you can essentially just concatenate your definitions of toComplex and friends here:

-- combines toComplex, toFrac, toReal, toInt
to :: TypeEnum a -> Number -> Maybe a
to Rational (Number Integer  n) = Just (fromInteger n)
to Rational (Number Rational n) = Just n
to Rational _ = Nothing
-- etc.
to _ _ = Nothing

Once we have this machinery in place, liftNum is surprisingly short. We just find the appropriate type to cast to, get a dictionary for that type, and perform the casts and the operation.

liftNum :: (forall a. Num a => a -> a -> a) -> Number -> Number -> Maybe Number
liftNum f a b = case typeEnum a `max` typeEnum b of
    TypeDict ty -> Number ty <$> liftA2 f (to ty a) (to ty b)

At this point you may be complaining: your ultimate goal was to not have one case per class instance in liftNum, and we've achieved that goal, but it looks like we just pushed it off into the definition of typeEnum, where there is one case per class instance. However, I defend myself: you have not shown us your typeEnum, which I suspect already had one case per class instance. So we have not incurred any new cost in functions other than liftNum, and have indeed significantly simplified liftNum. This also gives a smooth upgrade path for more complex Complex manipulations: extend the TypeEnum definition, the cast ordering, and the to function and you're good to go; liftNum may stay the same. (If it turns out that types are not linearly ordered but instead some kind of lattice or similar, then you can switch away from the Ord class.)