[Haskell-cafe] (Feeling that) GHCi is trying to protect me from myself with overlapping instances and existential types

leesteken at pm.me leesteken at pm.me
Sun Feb 16 09:59:44 UTC 2020


‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐
On Sunday, February 16, 2020 4:45 AM, Juan Casanova <juan.casanova at ed.ac.uk> wrote:

> Hello all,
>
> This stems from a Stack Overflow question that I posted a few days ago:
>
> https://stackoverflow.com/questions/60199424/overlapping-multi-parameter-instances-and-instance-specificity/60245126#60245126
>
> I'd like to hear either agreement or a more convincing argument as to
> why GHCi behaves the way it does in this case, since the ones at Stack
> Overflow basically told me that it does to "protect me from being too
> dumb and not understanding my own code", the way I interpret it. I
> felt that was totally against the principles of Haskell, so I thought
> there must be more.
>
> I'm going to focus on my second example (on my own answer to the
> question) for the sake of clarity here. Consider the following code:
>
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE ExistentialQuantification #-}
> module ExistentialTest where
>
> class Class1 a b where
> foo :: a -> b
>
> instance {-# INCOHERENT #-} Monoid a => Class1 a (Either b a) where
>
>      foo x = Right (x <> x)
>
>
> instance {-# INCOHERENT #-} Monoid a => Class1 a (Either a b) where
>
>      foo x = Left x
>
>
> data Bar a = Dir a | forall b. Class1 b a => FromB b
>
> getA :: Bar a -> a
>
> getA (Dir a) = a
> getA (FromB b) = foo b
>
> createBar :: Bar (Either String t)
> createBar = FromB "abc"
>

I think the type checker is worried that someone will use createBar with t==String.
Suppose I define:
  f :: Bar (Either String String)
  f = createBar
or
  g :: String -> Either String String
  g x = foo x
Should the result be a 'Right ...' or a 'Left ...'? Both incoherent instances apply when a==b (==String for example), but the results are different, which means that foo is not a (pure) function.

> createBar2 :: Bar (Either t String)
> createBar2 = FromB "def"
>
> This code compiles, but only because of the INCOHERENT annotations. If
> you remove those, it will give overlapping instances errors on both
> createBar and createBar2.
>
> I argue that those errors are senseless, because, while if t were
> instantiated to String then those instances would be valid, the
> functions createBar and createBar2 are by definition polymorphic, and
> the only way to make those functions work for every t is to use
> specifically one of the instances on each case. Therefore, the
> compiler should realize this, use that instance, and not complain
> about it. When using the INCOHERENT annotations it works, and uses the
> right instance on each case (because of course it would, the other
> instance is absolutely unusable in each of the cases).
>

Okay, you did think about the case that t==String. However, I don't see why this would not be a problem, as I explained above. The two instance types for Class1/foo completely overlap when a==b and it does matter which one the compiler chooses because they are not the same (one results in a Right and the other in a Left). Without being (possibly) incoherent, which instance should the compiler choose for the function 'g' above?

> The best argument that I was given on stack overflow is that allowing
> that would make it confusing because people might use those
> polymorphic functions with the specific t ~ String instantiation of
> the types and expect the behaviour to use the instance that is not
> usable in general. I find that a really poor argument. A user of the
> function need not know in general how a function internally works
> (that it uses the Class1 instance, which is not a constraint on the
> function signature), and it would be way too much for a user of the
> function to look at that code (that they should not need to look at),
> and then guess which instance it might be using, and guess wrong.
> Having GHCi protect me from that highly hypothetical situation while
> preventing me from compiling theoretically correct programs seems
> strange at best.
>
> I have tried to think of potential situations where a similar kind of
> ambiguity might affect the actual type checking and not just what the
> user might (wrongly) think of it, but I haven't found any.
>

I think function 'g' above is an example for such a problem. If I'm wrong, please explain how the compiler/run-time should know which to choose.

> From what I understand, though, the INCOHERENT annotation is
> dangerous in that if there were other instances which in fact did
> match in general, then GHCi would choose an arbitrary one. Therefore,
> I'd like them out of my code.
>
> Are there any comments on this that give me a more theoretical reason
> as to why Haskell disallows this without the INCOHERENT annotations?
> Is it worth proposing a change to the compiler to allow this? It
> basically seems that the compiler is checking the overlapping
> instances "too soon" before realizing that t cannot be unified with
> String within createBar, because it is a forall quantified polymorphic
> function.

Maybe the compiler could realize that t cannot be unified with String in this case. I'm not sure whether the forall in that type means universal of existential quantification as Haskell uses similar notation for both.
However, the problem of someone (later, maybe in another module) defining a function like 'g' above still exists.

> A way to see this is to precisely comment one of the instances and
> realize that you still get one error on each function, and on the one
> you removed the right instance for, it will actually say that there is
> no instance at all. It feels wrong that Haskell can tell you there are
> two instances that would match, and when you remove one of them, it
> tells you that there are no instances that match. That in of itself
> screams bug to me until someone gives me a really convincing
> explanation of why that is okay.
>
> Thanks once again for any time you spent on this, haskell-cafe.
>
> Juan Casanova.

I think I agree with the compiler here and I really don't see why the overlapping instances would not be a potential problem (for a function like 'g'). Our points of view appear to be so far apart, that I'm not sure if I understood your argument correctly. Please don't take offence if I did not address your issue or made a mistake because I did not fully understand.

kind regards, Arjen


More information about the Haskell-Cafe mailing list