[GHC] #8154: Possible bug in open type familes: Conflicting (a->a) and (a->a->a) instances

#8154: Possible bug in open type familes: Conflicting (a->a) and (a->a->a) instances ----------------------------+---------------------------------------------- Reporter: nh2 | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.8.1 Component: Template | Version: 7.7 Haskell | Operating System: Unknown/Multiple Keywords: type | Type of failure: GHC rejects valid program families | Test Case: Architecture: | Blocking: Unknown/Multiple | Difficulty: Unknown | Blocked By: | Related Tickets: | ----------------------------+---------------------------------------------- {{{ {-# LANGUAGE TypeFamilies #-} module Test where type family BoundsOf x type instance BoundsOf (a->a) = Int type instance BoundsOf (a->a->a) = (Int,Int) }}} This worked with GHC 7.6, but not with 7.8 HEAD (currently at 6cc7d3f). To check: {{{ wget https://gist.github.com/nh2/6302087/raw/8167e7a1c8613aa384c2e8ca2f4ea9ade874... ghci ghc-7.7-type-a-a-a-families.hs # 7.6, all fine ghci ghc-7.7-type-a-a-a-families.hs # 7.7, breaks }}} On #ghc, we don't really understand whether this is the right thing to happen or not. {{{ <rwbarton> see http://comments.gmane.org/gmane.comp.lang.haskell.glasgow.user/23734 <carter> c_wraith: im not sure why thats NOT working for open type familes too though <carter> a->a and a->a->a don't overlap... <rwbarton> ah it's in that thread. "Open (normal, old-fashioned) type families are essentially unchanged. In particular, coincident overlap and non-linear patterns *are* allowed. The overlap check between open type family instances now does a unification without an "occurs check" to mark (x, x) and ([y], y) as overlapping, as necessary for type soundness." }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8154 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8154: Possible bug in open type familes: Conflicting (a->a) and (a->a->a) instances ----------------------------------------------+---------------------------- Reporter: nh2 | Owner: Type: bug | Status: closed Priority: normal | Milestone: 7.8.1 Component: Template Haskell | Version: 7.7 Resolution: invalid | Keywords: type Operating System: Unknown/Multiple | families Type of failure: GHC rejects valid program | Architecture: Test Case: | Unknown/Multiple Blocking: | Difficulty: Unknown | Blocked By: | Related Tickets: ----------------------------------------------+---------------------------- Changes (by goldfire): * status: new => closed * resolution: => invalid Comment: Failure in this case is the desired behavior, which is a change from GHC 7.6. Consider {{{ type family Loop a type instance Loop a = Loop a -> Loop a }}} What should `BoundsOf (Loop Bool)` be? Depending on your type family reduction strategy, you could end up choosing either instance in your example, which is very bad. If you want a lot more background, check out section 6 of [http://www.cis.upenn.edu/~eir/papers/2014/axioms/axioms- extended.pdf this draft paper]. But, it seems that implementing your desired behavior is indeed possible with a closed type family: {{{ type family BoundsOf x where BoundsOf (a->a) = Int BoundsOf (a->a->a) = (Int,Int) }}} would probably work just fine for most purposes. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8154#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8154: Possible bug in open type familes: Conflicting (a->a) and (a->a->a) instances ----------------------------------------------+---------------------------- Reporter: nh2 | Owner: Type: bug | Status: closed Priority: normal | Milestone: 7.8.1 Component: Template Haskell | Version: 7.7 Resolution: invalid | Keywords: type Operating System: Unknown/Multiple | families Type of failure: GHC rejects valid program | Architecture: Test Case: | Unknown/Multiple Blocking: | Difficulty: Unknown | Blocked By: | Related Tickets: ----------------------------------------------+---------------------------- Comment (by carter): Thanks Richard! This explanation is helpful for me too! -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8154#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC