[GHC] #10087: DefaultSignatures: error message mentions internal name

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: | Owner: andreas.abel | Status: new Type: feature | Milestone: request | Version: 7.8.4 Priority: normal | Operating System: Unknown/Multiple Component: Compiler | Type of failure: Other (Type checker) | Blocked By: Keywords: | Related Tickets: Architecture: | Unknown/Multiple | Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- {{{#!hs {-# LANGUAGE DefaultSignatures #-} class C a where reflexive :: a -> Bool default reflexive :: Eq a => a -> Bool reflexive x = x == x data D instance C D where -- /home/abel/play/haskell/bugs/DefaultSig.hs:10:10: -- No instance for (Eq D) arising from a use of ‘Main.$gdmreflexive’ -- In the expression: Main.$gdmreflexive -- In an equation for ‘reflexive’: reflexive = Main.$gdmreflexive -- In the instance declaration for ‘C D’ }}} Error looks odd: The user has not written $gdmreflexive in his code. TODO: Better error message. Maybe this should just trigger a warning that method {{{reflexive}}} is undefined for instance {{{D}}} of {{{C}}}. Like when I remove the default method. {{{ /home/abel/play/haskell/bugs/DefaultSig.hs:10:10: Warning: No explicit implementation for ‘reflexive’ In the instance declaration for ‘C D’ }}} It seems the semantics of a default signature is that each instance *must* implement this method. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Keywords: Resolution: | Architecture: Operating System: Unknown/Multiple | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by dreixel): I agree that it's not a good idea to mention `$gdmreflexive` in the error message. But I don't think the error should be replaced by a warning. If there are no default signatures we don't get any errors or warnings: {{{ class C a where reflexive :: Eq a => a -> Bool reflexive x = x == x data D instance C D }}} So perhaps that's what we should do in this case, too. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Keywords: Resolution: | Architecture: Operating System: Unknown/Multiple | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by andreas.abel): I see. You get the error when using the default implementation. {{{#!hs test :: D -> Bool test d = reflexive d }}} {{{ No instance for (Eq D) arising from a use of ‘reflexive’ In the expression: reflexive d In an equation for ‘test’: test d = reflexive d }}} I agree this would be the most consistent behavior. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Keywords: Resolution: | Architecture: Operating System: Unknown/Multiple | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by dreixel): Simon, is there a good reason for `tc_default` in `TcInstDcls` to treat `DefMeth` so differently from `GenDefMeth`? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Keywords: Resolution: | Architecture: Operating System: Unknown/Multiple | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by simonpj): Replying to [comment:3 dreixel]:
Simon, is there a good reason for `tc_default` in `TcInstDcls` to treat `DefMeth` so differently from `GenDefMeth`?
No there isn't. See `tc_default` in `tcMethods` in `TcInstDcls`. * For polymorphic default methods, `DefMeth`, we generate ''typechecked'' `HsSyn Id`; see `Note [Default methods in instances]`. * For generic default methods, `GenDefMeth`, we currently generate ''renamed'' `HsSyn Name`, and then feed it to the type checker. * For user-written methods, `NoDefMeth`, we obviously just typecheck what the user wrote. I think it'd be pretty simple to instead treat `GenDefMeth` more like `DefMeth`. It might be a bit more code, but we'd get decent error messages. Do you think you could do that? I can advise. Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Resolution: | Keywords: Generics Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => Generics -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: infoneeded Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Resolution: | Keywords: Generics Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => infoneeded Comment: I'm a bit confused about the state of affairs for this ticket. Pedro, I don't really understand what you mean when you say "So perhaps that's what we should do in this case, too." After all, this code: {{{#!hs {-# LANGUAGE DefaultSignatures #-} class C a where reflexive :: a -> Bool default reflexive :: Eq a => a -> Bool reflexive x = x == x data D instance C D where }}} and this code: {{{#!hs class C a where reflexive :: Eq a => a -> Bool reflexive x = x == x data D instance C D }}} appear to be fundamentally different. In the former, `reflexive` defines a function that //requires// an `Eq a` constraint when the user doesn't implement it. In the latter, `reflexive` defines a function that //presupposes// that `a` is an instance of `Eq`. When viewed in this light, shouldn't the former code error and the latter code be OK? Simon, what are `GenDefMeth` and `NoDefMeth`? I can't find anything in the source about them (save for one possibly outdated comment on `NoDefMeth`). Were they replaced by `DefMethSpec` (i.e, [http://git.haskell.org/ghc.git/blob/93d85af9fec968b43452891ec7b10382a4a99a38... this]) at some point? If so, are your comments about a proposed refactoring still relevant? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: infoneeded Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Resolution: | Keywords: Generics Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Clarifications. `GenDefMeth` an `NoDefMeth` are gone. Now we just have (in `Class.hs`): {{{ type DefMethInfo = Maybe (Name, DefMethSpec Type) -- Nothing No default method -- Just ($dm, VanillaDM) A polymorphic default method, name $dm -- Just ($gm, GenericDM ty) A generic default method, name $gm, type ty -- The generic dm type is *not* quantified -- over the class variables; ie has the -- class vaiables free }}} So there are still three cases, just as stated in comment:4. But the representation has changed. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: infoneeded Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Resolution: | Keywords: Generics Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): The real issue is this: what error message do we *want* from the erroneous program in the Description? There really is an error: * the generic default method is used in the `instance` because no explicit method for `reflexive` is given. * but the generic default requires `(Eq a)` and that is not available. So we need something like {{{ No instance for (Eq D) arising from the generic default method for `reflexive` In the instance declaration for ‘C D’ }}} Would that be about right? The difficulty is that for generic defaults, for the class decl we generate {{{ $gdmreflexive :: (C a, Eq a) => a -> Bool $gdmreflexive x = x==x }}} This part is fine. For the missing method binding in the `instance` we generate we generate ''source code'' looking like {{{ reflexive = $gdmreflexive }}} Now we typecheck that, which gives the error message. And you can see it might be hard to generate the "right" error message. Better perhaps to do what happens for non-generic default methods, which is to generate typechecked code directly (and emit some constraints). Compare what we do for the `Nothing` case of `DefMethInfo` in `tc_default` in `tcMethods` in `TcInstDcls`. Does that make sense? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Resolution: | Keywords: Generics Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: infoneeded => new Comment: Thanks, Simon! [https://ghc.haskell.org/trac/ghc/ticket/10087?replyto=8#comment:7 This comment] helps tremendously in figuring out how things currently work. Replying to [comment:8 simonpj]:
So we need something like {{{ No instance for (Eq D) arising from the generic default method for `reflexive` In the instance declaration for ‘C D’ }}} Would that be about right?
I agree completely! I was confused because after reading [https://ghc.haskell.org/trac/ghc/ticket/10087?replyto=8#comment:1 Pedros' comment], I was under the impression he was implying that code should be legal. I probably misinterpreted it wildly and came to a very wrong conclusion.
Better perhaps to do what happens for non-generic default methods, which is to generate typechecked code directly (and emit some constraints). Compare what we do for the `Nothing` case of `DefMethInfo` in `tc_default` in `tcMethods` in `TcInstDcls`.
Does that make sense?
That seems sensible. Clearly, the mechanism we use for `VanillaDM` works well, because I've never seen an error message mention a name that begins with `$dm` :) If we modify the code that handles `GenericDM` to use the same tricks, that would probably make the error message much more palatable. We could also insert the phrase `"the generic default method for"` to make the origin of the issue clearer. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:9 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Resolution: | Keywords: Generics Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dreixel): I'm not entirely sure I understand my own comment, to be honest. The current proposal for handling certainly seems fine to me. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Resolution: | Keywords: Generics Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK, Ryan if you are prepared to have a go at this, feel free to consult me. You will have to emit some constraints, with a suitable `CtOrigin`. Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:11 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Resolution: | Keywords: Generics Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: #13755 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #13755 Comment: See also #13755, which deals with default implementations instead of generic default implementations. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:12 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.4 checker) | Resolution: | Keywords: Generics Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: #12854, #13755 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: #13755 => #12854, #13755 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10087#comment:13 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10087: DefaultSignatures: error message mentions internal name
-------------------------------------+-------------------------------------
Reporter: andreas.abel | Owner: (none)
Type: feature request | Status: new
Priority: normal | Milestone:
Component: Compiler (Type | Version: 7.8.4
checker) |
Resolution: | Keywords: Generics
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: Other | Test Case:
Blocked By: | Blocking:
Related Tickets: #12854, #13755 | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Richard Eisenberg
participants (1)
-
GHC