[GHC] #10451: Constraint tuple regression in HEAD

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Keywords: | Operating System: Unknown/Multiple ConstraintKinds | Type of failure: GHC rejects Architecture: | valid program Unknown/Multiple | Blocked By: Test Case: | Related Tickets: Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- The following file works in GHC 7.10.1, but fails in HEAD: {{{ {-# LANGUAGE ConstraintKinds #-} module ConstraintKinds where type ManyEq a = (Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a -- Comment this line to make compilation succeed in HEAD ) }}} This is most likely due to ffc21506894c7887d3620423aaf86bc6113a1071, which has set a limit on constraint tuples to size `8`. I think we should either: - increase the size limit on constraint tuples to be the same as normal tuples (`62`), or, - automatically nest constraint kinds beyond 8-tuples, or, - carefully document this limitation for the next release. Note that I encountered this limitation in my own code that I and others actually use: http://hackage.haskell.org/package/clash- prelude-0.7.5/docs/src/CLaSH-Sized-Fixed.html#ENumSFixedC -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Description changed by darchon: Old description:
The following file works in GHC 7.10.1, but fails in HEAD:
{{{ {-# LANGUAGE ConstraintKinds #-} module ConstraintKinds where
type ManyEq a = (Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a -- Comment this line to make compilation succeed in HEAD ) }}}
This is most likely due to ffc21506894c7887d3620423aaf86bc6113a1071, which has set a limit on constraint tuples to size `8`.
I think we should either: - increase the size limit on constraint tuples to be the same as normal tuples (`62`), or, - automatically nest constraint kinds beyond 8-tuples, or, - carefully document this limitation for the next release.
Note that I encountered this limitation in my own code that I and others actually use: http://hackage.haskell.org/package/clash- prelude-0.7.5/docs/src/CLaSH-Sized-Fixed.html#ENumSFixedC
New description: The following file works in GHC 7.10.1, but fails in HEAD: {{{ {-# LANGUAGE ConstraintKinds #-} module ConstraintKinds where type ManyEq a = (Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a ,Eq a -- Comment this line to make compilation succeed in HEAD ) }}} The error that I get on HEAD is: {{{ [1 of 1] Compiling ConstraintKinds ( ConstraintKinds.hs, interpreted ) ConstraintKinds.hs:5:5: error: Can't find interface-file declaration for type constructor or class (%,,,,,,,,%) Probable cause: bug in .hi-boot file, or inconsistent .hi file Use -ddump-if-trace to get an idea of which file caused the error In the type ‘(Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a)’ In the type declaration for ‘ManyEq’ Failed, modules loaded: none. }}} This is most likely due to ffc21506894c7887d3620423aaf86bc6113a1071, which has set a limit on constraint tuples to size `8`. I think we should either: - increase the size limit on constraint tuples to be the same as normal tuples (`62`), or, - automatically nest constraint kinds beyond 8-tuples, or, - carefully document this limitation for the next release. Note that I encountered this limitation in my own code that I and others actually use: http://hackage.haskell.org/package/clash- prelude-0.7.5/docs/src/CLaSH-Sized-Fixed.html#ENumSFixedC -- -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by acowley): FWIW, I bump into the 62 limit a lot, so 8 would be a real nuisance. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by simonpj): Yes, you are right about the cause. * At very least there should be a civilised error message. I'll fix that. * It'd be fine to increase the limit. 62 is also a pretty strange limit, but I think that provided the error message is helpful pretty much any limit is ok, since the workaround (nesting) is very straightforward. For "deriving Eq" we go up to 16-tuples, even though tuples themselves go up to 62, so perhaps 16 would do. * Auto-nesting would be nice, but I think it's probably more pressing for ordinary tuples. I've often thought about doing so, but it's hard to do consistently. For example, suppose (extreme case) that we only supported pairs. Then if someone wrote {{{ f (x,y,z) = e }}} we'd nest the pair so that the "real" type of `f` is `(Int, (Int,Int)) -> blah`. But that would be a confusing type to display. And it would be hard to stop you applying `f` to a nested tuple, e.g. `f (1, (2,3))`. GHC doesn't have a notion of a "user type" and an "implementation type". It's never been pressing enough to jump into this particular swamp. Concretely I propose: * Increase the max arity to 16 * Give a civilised error message if you exceed it * Document the limit acowley: can you explain more about ''how'' you bump up against the 62 limit. Do you really write such large tuples by hand? Or does some program write them? In which case, is nesting difficult? Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by acowley): I ran into this with constraints. A [http://www.seas.upenn.edu/~acowley/papers/hocl.pdf paper] I submitted to Haskell Symposium describes a method of factoring an embedded language into various features. In the current state of things, a language that I use for writing GPU programs is defined like this: {{{#!hs type Hocl c repr = (Abstraction c repr, ArrayFeatures c repr, Bitwise c repr, Boolean c repr, Branch c repr, Comp c repr, Cast c repr, Gather c repr, Image c repr, ImageM c repr, Iteration c repr, IterationM c repr, Math c repr, Statements c repr, Swizzle c repr) }}} I've already done some nesting for `Math` and `ArrayFeatures`, and I can do more, so this isn't a deal breaker for me but a matter of convenience. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Changes (by adamgundry): * cc: adamgundry (added) Comment: Oops! A possible workaround is to manually define an operator that gives nested pairs of constraints, like this: {{{ type (x :: Constraint) :* (y :: Constraint) = (x, y) type ManyEq2 a = Eq a :* Eq a :* Eq a :* Eq a :* Eq a :* Eq a :* Eq a :* Eq a :* Eq a }}} Alternatively, a type family can be used to expand a list of constraints into nested pairs: {{{ type family All (xs :: [Constraint]) :: Constraint where All '[] = () All (c ': cs) = (c, All cs) type ManyEq3 a = All '[Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a] }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by acowley): The same code base I referred to earlier uses the `All` construction as well (in the initial encoding used for optimization passes). It runs into the context stack limit. Swings and roundabouts. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by thoughtpolice): For the record, I strongly prefer that _if anything_, we only bump the limit, and '''not''' decrease it. There's just no reason to. It's true that 62 is pretty arbitrary, but that's what it already was - lowering it to 8 is going to break some existing programs for presumably zero user-facing benefit, which basically amounts to breaking programs gratuitously. We should really not do this. The fact at least two people run into this seems to be enough support for me! If anything, we should just increase it. Why not just bump it up to 64, or hell, given Anthony said it's already annoying at the current limit, 128? If there's no technical reason otherwise, of course. That's at least a net benefit for one user. If this is inconsistent with other deriving mechanisms for tuples like `Eq`, we should fix that, or at least document it clearly. And if ''that'' is hard, well, we may want to fix it if possible. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD
-------------------------------------+-------------------------------------
Reporter: darchon | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.11
Resolution: | Keywords:
Operating System: Unknown/Multiple | ConstraintKinds
Type of failure: GHC rejects | Architecture:
valid program | Unknown/Multiple
Blocked By: | Test Case:
Related Tickets: | Blocking:
| Differential Revisions:
-------------------------------------+-------------------------------------
Comment (by Simon Peyton Jones

#10451: Constraint tuple regression in HEAD
-------------------------------------+-------------------------------------
Reporter: darchon | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.11
Resolution: | Keywords:
Operating System: Unknown/Multiple | ConstraintKinds
Type of failure: GHC rejects | Architecture:
valid program | Unknown/Multiple
Blocked By: | Test Case:
Related Tickets: | Blocking:
| Differential Revisions:
-------------------------------------+-------------------------------------
Comment (by Simon Peyton Jones

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by simonpj): I'm ok with increasing the limit further. If anyone wants to do that * Add extra declarations in `ghc-prim:GHC.Classes` * Increase `mAX_CTUPLE_SIZE` in `compiler/main/Constants.hs` to match Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds, newcomer Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Changes (by thomie): * keywords: ConstraintKinds => ConstraintKinds, newcomer Comment: For newcomer: see comment:10. Scroll to the bottom of the file `libraries /ghc-prim/GHC/Classes.hs`, and work your editor magic. Also update `testsuite/tests/polykinds/T10451.hs` and `testsuite/tests/polykinds/T10451.stderr`, and submit a patch to [wiki:Phabricator]. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:11 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: terrelln Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds, newcomer Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Changes (by terrelln): * owner: => terrelln Comment: I'll increase the limit to 62 to match the tuple limit. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:12 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: terrelln Type: bug | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | ConstraintKinds, newcomer Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: Phab:D986 -------------------------------------+------------------------------------- Changes (by thomie): * differential: => Phab:D986 * milestone: => 7.12.1 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:13 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10451: Constraint tuple regression in HEAD
-------------------------------------+-------------------------------------
Reporter: darchon | Owner: terrelln
Type: bug | Status: new
Priority: normal | Milestone: 7.12.1
Component: Compiler | Version: 7.11
Resolution: | Keywords:
Operating System: Unknown/Multiple | ConstraintKinds, newcomer
Type of failure: GHC rejects | Architecture:
valid program | Unknown/Multiple
Blocked By: | Test Case:
Related Tickets: | Blocking:
| Differential Revisions: Phab:D986
-------------------------------------+-------------------------------------
Comment (by Austin Seipp

#10451: Constraint tuple regression in HEAD -------------------------------------+------------------------------------- Reporter: darchon | Owner: terrelln Type: bug | Status: closed Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | ConstraintKinds, newcomer Type of failure: GHC rejects | Architecture: valid program | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | polykinds/T10451 | Blocking: | Differential Revisions: Phab:D986 -------------------------------------+------------------------------------- Changes (by thomie): * status: new => closed * testcase: => polykinds/T10451 * resolution: => fixed Comment:
increase the size limit on constraint tuples to be the same as normal tuples (62)
Done, thanks to a patch by Nick Terrell. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10451#comment:15 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC