3

I've been trying to see how Haskell copes with subtyping so I came up with the following snippet:

{-# LANGUAGE RankNTypes #-}

f1 :: () -> Int
f1 _ = 5

f2 :: () -> (forall a. Integral a => a)
f2 = f1

The line f2 = f1 fails with an unexpected error message:

Couldn't match type ‘a’ with ‘Int’
  ‘a’ is a rigid type variable bound by
    the type signature for:
      f2 :: forall a. Integral a => () -> a

It seems that the existential has been promoted to a universal, which of course is unintended.

My guess is that in implementation terms f2 needs to return a value and a corresponding dictionary, while f1 simply returns a value of type Int. However, from a logical perspective the contract of f2 is "a function from () to some unknown instance of Integral" and f1 satisfies it perfectly.

Should GHC do some implicit magic to make it work or am I missing something?

gcnew
  • 55
  • 4
  • I'm pretty new to existentials, but the way I am reading this is `f1` does not satisfy the "unknown instance" part. It is set at `Int`, it isn't unknown. I think if you changed the signature of `f1` to `Integral a => () -> a` it would work. – qfwfq Aug 17 '17 at 19:19
  • What sort of subtyping are you looking at? Haskell doesn't really support subtyping (in the usual sense, at the very least). – David Young Aug 17 '17 at 19:31
  • Looking at the answer, I think I may have initially misunderstood the question. – qfwfq Aug 17 '17 at 19:38
  • 2
    There are no existentials in the code you posted, only universals. – chi Aug 17 '17 at 19:40
  • @chi If Haskell supported it, I believe a `forall` in that position would be equivalent to an existential. – David Young Aug 17 '17 at 19:50
  • 1
    @DavidYoung Why? Agda, Coq, etc. support "exists" and "forall" in all positions, but "forall" is always a universal. And so is in Haskell, except in type declarations like `data T = forall a. K ...` (which IMO are a very bad choice of syntax). – chi Aug 17 '17 at 21:20
  • @chi My terminology might be wrong. My intended behaviour is "some type t that cannot be specified by the user". As far as I know it's an "existential". I.e. I'm trying to write a function that returns an unboxed value, for which the only thing we know is that it's an instance of some type class. Based on other explicit `forall` usages I've seen, I was expecting the above snippet to work, but for some reason the compiler floats the `forall` out. I guess this syntax does not have the meaning I've thought it to have. – gcnew Aug 17 '17 at 21:38
  • 2
    @gcnew If "user" is the caller the the function, then yes, that would be an existential. Haskell does not support them, unless under some data or newtype wrapper (as in David Young's answer). `forall a.`, in the position shown in the question, is chosen by the user, and indicates a universal. – chi Aug 17 '17 at 21:54
  • @chi I think that's the real answer to the question, do you mind posting it as such? – gcnew Aug 17 '17 at 21:56
  • 1
    Another way of having existentials (without defining a data type) is via CPS ala `(forall a. Integral a => a -> c) -> c` instead of `data ExistsIntegral = forall a. Integral a => ExistsIntegral a`. – Alec Aug 17 '17 at 21:58
  • @Alec Indeed, albeit I fear that might be confusing for a beginner. The main difference is that, in the CPS variant the `forall` appears in _contravariant_ (argument) position, since it is at the left of `->`. – chi Aug 17 '17 at 22:01
  • @Alec, Yes, indeed. Unfortunately it fails when I try to use it for to infer the result of `f1 :: Int`; `f2 :: (forall a. Integral a => a -> r) -> r`; `r = if True then f1 else f2 id`. Thank you! – gcnew Aug 17 '17 at 22:07
  • 1
    @gcnew True. The only subtyping you get is with foralls. Otherwise, the next closest thing you gets is wrapped existentials. I was just trying to point out that your use of `forall` does _not_ amount to an existential (and I did this by showing you how you _could_ use `forall` to simulate an existential). – Alec Aug 17 '17 at 22:11
  • 1
    @chi You're right. I was confusing this with the equivalence of existentials in a *left*-hand side of an arrow/contravariant position (the equivalence of `(exists a. a) -> r` and `forall a. (a -> r)`, given a hypothetical `exists` feature in Haskell). – David Young Aug 18 '17 at 07:25
  • Re. the co/contravariance relationship, `() -> (forall a. Integral a => a)` is the same as `forall a. Integral a => () -> a`, which might make it clearer why that doesn’t do what you want. People don’t usually do this, but you can actually write type signatures like `traverse :: forall a b f. Applicative f => (a -> f b) -> forall t. Traversable t => t a -> f (t b)`—which I guess could be useful for readability sometimes. – Jon Purdy Aug 18 '17 at 10:51

2 Answers2

6

The a type you have in your f2 is universally quantified, not existentially quantified. GHC doesn't directly support kind of existential types that you're looking for.

You can, however, get something like this by wrapping it up in a new data type:

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ConstraintKinds           #-}

data Constrained c = forall a. c a => Constrained a

f1 :: () -> Int
f1 _ = 5

f2 :: () -> Constrained Integral
f2 unit = Constrained (f1 unit)

Now, this often isn't terribly useful because all that has been accomplished is that we've thrown out all (type) information about f2 () except that its type is an instance of Integral. You no longer know it's an Int. It's possible to keep track of this information as well, but that may or may not be useful depending on what you're doing.

More context for what you're doing and what you're looking to see would make it easier what sort of information about those kinds of things I should add.

As a side note: it isn't necessary to make those into functions that take an argument. You could just have f1 :: Int and f2 :: Constrained Integral.

Also, I would feel a bit remiss if I didn't mention that, despite downplaying the utility of these sorts of types in Haskell a bit earlier in this answer, I wrote an answer that describes some potentially practical uses for constrained existential types. While we're somewhat on the subject, it's probably also worth pointing out that ConstraintKinds is a powerful extension, whose use goes beyond just constrained existentials.

David Young
  • 10,713
  • 2
  • 33
  • 47
  • Yes, I saw that the existential is floated out, but I didn't understand why. Do you have any source explaining that behaviour? I'm trying to use Haskell as a tool to verify the behaviour of other languages, that's why my example is so contrived. In this specific instance, I'm trying to see whether I can simulate something like https://github.com/Microsoft/TypeScript/issues/17863. I.e. if my above example was working, what would have the inferred type of `if True then f1 else f2` been. – gcnew Aug 17 '17 at 20:59
  • This answer uses the term "existential" in a confusing way, and it seems like it successfully confused @gcnew. The way `f2` was written in the OP is a *universal*, and the floating happens mostly as a convenience to the compiler, because the types are equivalent. Without floating, `() -> forall a. <...>` and `forall a. () -> <...>` are still essentially the same type, and there is nothing existential about either of them. I don't think quantifier floating has anything to do with this question. – luqui Aug 18 '17 at 06:34
  • @luqui You're right. I was confusing this with the equivalence between `(exists a. a) -> r` and `forall a. (a -> r)`. I have updated my answer to hopefully correct the incorrect bits and improve the unclear information. – David Young Aug 18 '17 at 07:22
  • @gcnew Also, for the purposes of examining the behavior of existential types, you might want to try a language like Coq that has better support for them. Coq is somewhat similar to Haskell, at least in how a lot of its basics work. There is [a nice free book on Coq too](https://softwarefoundations.cis.upenn.edu/current/index.html). Coq was also specifically designed for verification tasks. – David Young Aug 18 '17 at 07:43
5

You're reading the type of f2 the wrong way around.

The type of f2 says "if you give me a (), I will give you a (forall a. Integral a => a). That is, f2 promises to give you a value that can be used as if it were in any type that is a member of Integral.

However the implementation of f2 says it will achieve this by simply calling f1. But f1 only returns Int! That is indeed a member of Integral, but it's not usable as any type that is a member of Integral.

In fact, the type f1 is actually a subtype of f2's type, rather than the other way around! This actually works:

{-# LANGUAGE RankNTypes #-}

f1 :: () -> Int
f1 = f2

f2 :: () -> (forall a. Integral a => a)
f2 _ = 5

It works because numeric literals are polymorphic, so a 5 can be any Num type (and Num is a super class of Integral, so if it can be any Num it can also be any Integral). f1 then calls f2 requesting that Int be the choice for a.

You noticed that GHC seems to be converting the type you wrote to f2 :: forall a. Integral a => () -> a, and you're right; it does actually normalise what you wrote to that type. The reason is those two types actually are the same thing with the way GHC's type system works. The caller instantiates any type variables quantified over the whole type of f2, and the caller would also be the one who receives the return value and so instantiates any type variables quantified over just the return value. Introducing a type variable with forall is the same if you scope if over the whole type or just over the return type of the function; it only makes a difference if it's scoped over the left side of the arrow (which is where higher-rank types come in).

Ben
  • 68,572
  • 20
  • 126
  • 174