module B0 whereclass C a where c :: a -> Stringdata T = T deriving Showmodule B1 whereimport B0instance C T where c _ = "B1"b = c Tmodule B2 whereimport B0instance C T where c _ = "B2"b = c Tmodule Main whereimport B1import B2main = print (B1.b,B2.b)
this is accepted without flags or errors and prints ("B1","B2").
This really surprises me. Why doesn't think produce a link error?
Each instance declaration should give rise to a global symbol uniquely determined by the class and the type, I'd presume. And when they meet there will be a clash.
Obviously I'm wrong, as this (scary) example shows.
This really surprises me. Why doesn't think produce a link error?
Each instance declaration should give rise to a global symbol uniquely determined by the class and the type, I'd presume. And when they meet there will be a clash.
Obviously I'm wrong, as this (scary) example shows.
I believe, toplevel symbols binding dictionaries include the module (and package name) like all other toplevel symbols.
The example -although violating the current language definition- is less scary than one might think. You cannot abuse it (even if you chuck FDs into the mix) to coerce types unsafely (or circumvent strong typing in any other way).
Currently this is by design. What would the unique global symbol be for
instance C (T a) [Maybe b]
Oh, and T might be a type synonym.
We could encode the type as a string, I suppose, but the error message (from the linker) would still be execrable.
For indexed-type instances, overlap is unsound, so there's an eager check.
On reflection, if you don't use -fallow-overlapping-instances GHC should arguably do the same eager check for class instances; that would more faithfully implement the Report. Even doing that is not trivial, because GHC goes to some lengths to avoid looking at (literally) thousands of interface files on every compilation, just on the off-chance that there'll be an instance declaration lurking there.
With overlap allowed, it's clear that you can make different choices in different parts of the program.
So I'm not sure what to do; and the only thing that comes to mind isn't cheap. For now I'll put it as low-prio, unless people start yelling that it's ruining their day.
Oh, come on. It's easy to generate the unique string for the instance by flattening the type. HBC did this 15 years ago. :)
The linker error is a little obscure, but since ghc starts the linker it can filter the error messages and print a better one. (HBC didn't do that.)
I prefer having GHC work as it does now. It makes sense to me that instances only overlap when used and not just when imported. If GHC changes, I would like the option to get back to the current approach, but without requiring -fallow-overlapping-instances. Perhaps some language extension. Also, has this been mentioned in haskell-prime?
I just recently learned about this issue first-hand. See the glasgow-haskell-users thread starting here with my own simple example that highlights the usefulness of instances working the way they do now.
With overlap allowed, it's clear that you can make different choices in different parts of the program.
I don't agree. While I can see that you would want to commit to an instance
early for optimisation reasons, I think you should then fail when
linking if it turns out that you would have made a different choice had
all of the program's instances been available.
Here is an example of Data.Set going wrong due to multiple instances:
That depends on what you define as wrong, doesn't it?-)
In the Haskell'98 view, there is at most one instance for a class/type, so if you give such an instance, you may conclude that it is the only one, so the behaviour is wrong.
In the Ghc view, local instances are supported unless they actually conflict in use, so you may not conclude that the instance you see is the only one there'll ever be, so the behaviour is not wrong per se, just one of many possible behaviours.
In particular, you explicitly force Ghc to commit to the local instances leaving it no room for using other instances or reporting conflicts. If the functions where memberBy and fromListBy, with explicit comparison parameters, you're supplying the comparisons at the point of definition for f and s, instead of allowing them to be supplied at the point of use (where a conflict between differing comparisons might be noted).
If, instead you ask Ghc to leave the instances to use open, the behaviour will be closer to what you expected:
s :: Set Foo f :: Set Foo -> Bool
would become (needs {-# LANGUAGE FlexibleContexts #-})
s :: Ord Foo => Set Foo f :: Ord Foo => Set Foo -> Bool