[GHC] #13506: Spurious extra error message due to functional dependencies

#13506: Spurious extra error message due to functional dependencies -------------------------------------+------------------------------------- Reporter: gelisam | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 (Type checker) | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect Unknown/Multiple | error/warning at compile-time Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- One call site is ill-typed, but GHC reports a type error at every call site, not just the problematic one. In the original code, the problem occurred with a very common function (`Data.Lens.view`), so the avalanche of error messages made it difficult to find the problematic call site. {{{#!hs {-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses #-} module Bug where class FunDep lista a | lista -> a instance FunDep [a] a singleton :: FunDep lista a => a -> lista singleton _ = undefined -- this error is expected: -- Couldn't match type 'Char' with '()' -- arising from a functional dependency between -- constraint 'FunDep [Char] ()' arising from a use of 'singleton' -- instance 'FunDep [a] a' illTyped :: [Char] illTyped = singleton () -- but this one is not: -- Couldn't match type '()' with 'Char' -- arising from a functional dependency between constraints: -- 'FunDep [Char] Char' arising from a use of 'singleton' (in 'wellTyped') -- 'FunDep [Char] ()' arising from a use of 'singleton' (in 'illTyped') wellTyped :: [Char] wellTyped = singleton 'a' }}} The spurious error disappears if `illTyped` is commented out or moved after `wellTyped`. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13506 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13506: Spurious extra error message due to functional dependencies -------------------------------------+------------------------------------- Reporter: gelisam | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.2 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): This error message has had an interesting history. In GHC 7.4.2 and earlier, you get the error message that you desire: {{{ GHCi, version 7.4.2: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:16:12: Couldn't match type `Char' with `()' When using functional dependencies to combine FunDep [a] a, arising from the dependency `lista -> a' in the instance declaration at Bug.hs:5:10 FunDep [Char] (), arising from a use of `singleton' at Bug.hs:16:12-20 In the expression: singleton () In an equation for `illTyped': illTyped = singleton () Failed, modules loaded: none. }}} In GHC 7.6.3, it changed to the current behavior: {{{ GHCi, version 7.6.3: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:16:12: Couldn't match type `Char' with `()' When using functional dependencies to combine FunDep [a] a, arising from the dependency `lista -> a' in the instance declaration at Bug.hs:5:10 FunDep [Char] (), arising from a use of `singleton' at Bug.hs:16:12-20 In the expression: singleton () In an equation for `illTyped': illTyped = singleton () Bug.hs:24:13: Couldn't match type `()' with `Char' When using functional dependencies to combine FunDep [Char] (), arising from a use of `singleton' at Bug.hs:16:12-20 FunDep [Char] Char, arising from a use of `singleton' at Bug.hs:24:13-21 In the expression: singleton 'a' In an equation for `wellTyped': wellTyped = singleton 'a' }}} But in GHC 7.8.4, it was briefly fixed again! {{{ GHCi, version 7.8.4: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:16:12: No instance for (FunDep [Char] ()) arising from a use of ‘singleton’ In the expression: singleton () In an equation for ‘illTyped’: illTyped = singleton () }}} But in GHC 7.10.3 and later, we get the current error message again. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13506#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13506: Spurious extra error message due to functional dependencies
-------------------------------------+-------------------------------------
Reporter: gelisam | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler (Type | Version: 8.0.2
checker) |
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: Incorrect | Unknown/Multiple
error/warning at compile-time | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Simon Peyton Jones

#13506: Spurious extra error message due to functional dependencies -------------------------------------+------------------------------------- Reporter: gelisam | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.2 checker) | Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Incorrect | Test Case: error/warning at compile-time | typecheck/should_fail/T13506 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => typecheck/should_fail/T13506 * status: new => closed * resolution: => fixed Comment: Excellent test case, thank you. Fixed! Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13506#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13506: Spurious extra error message due to functional dependencies -------------------------------------+------------------------------------- Reporter: gelisam | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.2 checker) | Resolution: fixed | Keywords: FunDeps Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Incorrect | Test Case: error/warning at compile-time | typecheck/should_fail/T13506 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => FunDeps -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13506#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC