[GHC] #8356: Strangeness with FunDeps

#8356: Strangeness with FunDeps ----------------------------+---------------------------------------------- Reporter: ksf | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: GHC rejects valid program Unknown/Multiple | Test Case: Difficulty: Unknown | Blocking: Blocked By: | Related Tickets: | ----------------------------+---------------------------------------------- {{{ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTSyntax #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FunctionalDependencies #-} import GHC.TypeLits data (:::) :: Symbol -> * -> * where Field :: sy ::: t class Replaced (sy :: Symbol) a b (xs :: [*]) (ys :: [*]) | sy a b xs -> ys, sy a b ys -> xs instance Replaced sy a b ((sy ::: a) ': xs) ((sy ::: b) ': ys) }}} results in {{{ Illegal instance declaration for [...] Multiple uses of this instance may be inconsistent with the functional dependencies of the class }}} The guess is that the FunDep Checker chokes on [*], as that error message doesn't make sense in this context. What I'm trying to do is to express "xs is ys and ys is xs with a and b interchanged at sy", all in a single predicate because my current type family implementation needs two and explodes the inferred types. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8356 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8356: Strangeness with FunDeps ----------------------------------------------+---------------------------- Reporter: ksf | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects valid program | Unknown/Multiple Test Case: | Difficulty: Unknown Blocking: | Blocked By: | Related Tickets: ----------------------------------------------+---------------------------- Comment (by rwbarton): The error makes sense to me: `sy`, `a`, `b` and `((sy ::: a) ': xs)` do not jointly determine `((sy ::: b) ': ys)`, because the whole `ys` part is free. (And the same for the other fundep.) Perhaps the error message could be more specific, saying what I said above? something like {{{ Illegal instance declaration for [...] Multiple uses of this instance may be inconsistent with the functional dependencies of the class: `sy', `a', `b' and `((sy ::: a) ': xs)' do not jointly determine `((sy ::: b) ': ys)' }}} Extra clarity would be good here since there are existing libraries that use fundeps incorrectly, that will stop compiling in 7.8, and I anticipate a slew of bug reports otherwise. See for example http://ghc.haskell.org/trac/ghc/ticket/1241#comment:22.
What I'm trying to do is to express "xs is ys and ys is xs with a and b interchanged at sy", all in a single predicate because my current type family implementation needs two and explodes the inferred types.
In that case, perhaps you intended {{{ instance Replaced sy a b ((sy ::: a) ': xs) ((sy ::: b) ': xs) -- note xs twice }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8356#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8356: Strangeness with FunDeps ----------------------------------------------+---------------------------- Reporter: ksf | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects valid program | Unknown/Multiple Test Case: | Difficulty: Unknown Blocking: | Blocked By: | Related Tickets: ----------------------------------------------+---------------------------- Comment (by ksf): Yes, the more specific error message looks very helpful.
In that case, perhaps you intended
Indeed, I did. That doesn't work for the (overlapping) recursive case up to the match, though: {{{ instance Replaced sy a b xs ys => Replaced sy a b ((sy ::: c) ': xs) ((sy ::: d) ': ys) }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8356#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8356: Strangeness with FunDeps ----------------------------------------------+---------------------------- Reporter: ksf | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects valid program | Unknown/Multiple Test Case: | Difficulty: Unknown Blocking: | Blocked By: | Related Tickets: ----------------------------------------------+---------------------------- Comment (by ksf): For reference, here's the whole code: http://lpaste.net/93383 ...trying to minimise the inferred type for {{{foo}}}, both with and without {{{li}}} fixed. With the added {{{sy ys -> b}}} constraint, the {{{ElemTy sy ys ~ b}}} constraint on {{{mapKey}}} could be elided. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8356#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8356: Strangeness with FunDeps ----------------------------------------------+---------------------------- Reporter: ksf | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects valid program | Unknown/Multiple Test Case: | Difficulty: Unknown Blocking: | Blocked By: | Related Tickets: ----------------------------------------------+---------------------------- Changes (by simonpj): * cc: diatchki (added) Comment: Thanks for the suggestion; I'll improve the error message (patch coming). I don't remember all the issues about the coverage condition, but I think there were very good reasons for enforcing it. I'm adding Iavor to the cc list; he may comment. Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8356#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8356: Strangeness with FunDeps
----------------------------------------------+----------------------------
Reporter: ksf | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.7
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: GHC rejects valid program | Unknown/Multiple
Test Case: | Difficulty: Unknown
Blocking: | Blocked By:
| Related Tickets:
----------------------------------------------+----------------------------
Comment (by unknown

#8356: Strangeness with FunDeps -------------------------------------------------+------------------------- Reporter: ksf | Owner: Type: bug | Status: Priority: normal | closed Component: Compiler | Milestone: Resolution: fixed | Version: 7.7 Operating System: Unknown/Multiple | Keywords: Type of failure: GHC rejects valid program | Architecture: Test Case: | Unknown/Multiple typecheck/should_fail/tcfail170 | Difficulty: Blocking: | Unknown | Blocked By: | Related Tickets: -------------------------------------------------+------------------------- Changes (by simonpj): * status: new => closed * testcase: => typecheck/should_fail/tcfail170 * resolution: => fixed Comment: Error message improved. Here it is for `tcfail170`: {{{ tcfail170.hs:7:10: Illegal instance declaration for ‛C [p] [q]’ The coverage condition fails in class ‛C’ for functional dependency: ‛a -> b’ Reason: lhs type ‛[p]’ does not deternine rhs type ‛[q]’ In the instance declaration for ‛C [p] [q]’ }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8356#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8356: Strangeness with FunDeps -------------------------------------------------+------------------------- Reporter: ksf | Owner: Type: bug | Status: Priority: normal | closed Component: Compiler | Milestone: Resolution: fixed | Version: 7.7 Operating System: Unknown/Multiple | Keywords: Type of failure: GHC rejects valid program | Architecture: Test Case: | Unknown/Multiple typecheck/should_fail/tcfail170 | Difficulty: Blocking: | Unknown | Blocked By: | Related Tickets: -------------------------------------------------+------------------------- Comment (by monoidal): The testcase `tcfail170` triggers a `pprTrace` in `FunDeps.lhs`. Is this intended? {{{ $ ghc-7.7.20131027 tcfail170 [1 of 1] Compiling ShouldFail ( tcfail170.hs, tcfail170.o ) cic main:ShouldFail.C{tc roB} [[p{tv aoE} [sk]], [q{tv aoF} [sk]]] ([a{tv aoC} [tv]], [b{tv aoD} [tv]]) [(aoE, p{tv aoE} [sk])] [(aoF, q{tv aoF} [sk])] [(aoE, p{tv aoE} [sk])] [] tcfail170.hs:7:10: Illegal instance declaration for ‛C [p] [q]’ The coverage condition fails in class ‛C’ for functional dependency: ‛a -> b’ Reason: lhs type ‛[p]’ does not determine rhs type ‛[q]’ In the instance declaration for ‛C [p] [q]’ }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8356#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8356: Strangeness with FunDeps -------------------------------------------------+------------------------- Reporter: ksf | Owner: Type: bug | Status: Priority: normal | closed Component: Compiler | Milestone: Resolution: fixed | Version: 7.7 Operating System: Unknown/Multiple | Keywords: Type of failure: GHC rejects valid program | Architecture: Test Case: | Unknown/Multiple typecheck/should_fail/tcfail170 | Difficulty: Blocking: | Unknown | Blocked By: | Related Tickets: -------------------------------------------------+------------------------- Comment (by simonpj): It's a trace that should have been removed, but the test suite runs (rightly or wrongly) with `-fno-debug-output` which suppresses it. I'd be happy if someone had a moment to delete that line. Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8356#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8356: Strangeness with FunDeps
-------------------------------------------------+-------------------------
Reporter: ksf | Owner:
Type: bug | Status:
Priority: normal | closed
Component: Compiler | Milestone:
Resolution: fixed | Version: 7.7
Operating System: Unknown/Multiple | Keywords:
Type of failure: GHC rejects valid program | Architecture:
Test Case: | Unknown/Multiple
typecheck/should_fail/tcfail170 | Difficulty:
Blocking: | Unknown
| Blocked By:
| Related Tickets:
-------------------------------------------------+-------------------------
Comment (by Krzysztof Gogolewski
participants (1)
-
GHC