[Haskell-cafe] Should there be a haskell template for inclusion polymorphism in Haskell?
Miao ZhiCheng
miao at decentral.ee
Tue May 31 23:54:34 UTC 2022
Hi Olaf!
Sorry for a bit of delay, I finally managed to digest your inputs.
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
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20220601/bb126827/attachment.html>
More information about the Haskell-Cafe
mailing list