Your existential type AnyNum is the union of all number types, but even
set-theoretically there is no way of extending individual operations on
many sets to a single operation on the union of all sets, even when the
operations commute with subset inclusion. That ony works if the union
is directed (see attached), that is, if for every two sets A and B
there is a third set C in the union of which both other sets are a
subset.
So in order to implement
AnyNum (5 :: Rational) + AnyNum (NaN :: Double)
you first have to find a single other Num type that Rational and Double
can be cast into, then perform the (+) there.
Thank you for the example! I managed to play around with it, and added a bit more general examples:
```
instance Castable Integer Double where
cast1 = fromInteger
instance Castable Rational Double where
cast1 = fromRational
instance Castable Double Double where
cast1 = id
instance (Castable a Double, Castable b Double) => Directed Num a b Double where
castUnion _ (a, b) = (cast1 a, cast1 b)
genericPlus ::
forall a b c.
(Num a, Num b, Num c, Directed Num a b c) =>
a -> b -> c
genericPlus = castOp (Proxy :: Proxy Num) (+)
main = do
print $ show $ genericPlus (2 :: Integer) (5 :: Integer)
print $ show $ genericPlus (1/3 :: Rational) (5 :: Integer)
print $ show $ genericPlus (1/3 :: Rational) (2/3 :: Rational)
print $ show $ genericPlus (4 :: Integer) (2/3 :: Rational)
```
That's interesting, it also makes me think how the C language style of "implicit casting" is working under the hood.
What the libraries like generics-sop, attenuation and to some extent
the Prelude do is to construct a hierarchy either via multi-parameter
type classes
A `IsSubtypeOf` B
or constrained classes like
Num a => Fractional a
That may culminate in a most inclusive type or type class, providing
all the operations of its ancestors. Notice the reversal of
inclusions:
Integer `IsSubtypeOf` Rational
fromInteger :: Integer -> Rational
instance Num Integer
instance Fractional Rational
Rational `IsSubclassOf` Num
Instead of the union of all types under consideration, maybe the
intersection is useful to you. Attached is a module that implements the
initial object of a class (which I think in the case of Num is
isomorphic to Integer), that is a type that can do everything every
other Num type can do, but nothing more. AnyNum is the terminal object
of Num.
-- The initial object in the Num class
newtype FreeNum = FreeNum {
runNum :: forall r.
(Integer -> r) -> -- fromInteger
(r -> r -> r) -> -- (+)
(r -> r -> r) -> -- (*)
(r -> r) -> -- negate
(r -> r) -> -- abs
(r -> r) -> -- signum
r
}
On this, we can implement numeric operations without casting.
That's the next level... I don't think I can manage to figure out how to define "operations in NumSig num" or even a `freeDouble` today...
Although it already deviates from my original inquiry, which was about run-time polymorhpism and have some sort of OO-style INum class in Haskell. As later I figured out, a "+=" operator would make
more sense for "objects", and type checkings could be run-time using
Typeable. But I learned something already, fun exercise so far though!
Best regards,
Miao
Olaf