[GHC] #13474: GHC HEAD regression: Prelude.!!: index too large

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- `git-annex-6.20170321` from Hackage currently fails to build with GHC 8.2.1 and HEAD because it triggers this panic. Here's a simplified example that exhibits the issue: {{{#!hs {-# LANGUAGE BangPatterns #-} module Command.Vicfg where import qualified Data.Map as M class Default a where def :: a instance Default Int where def = 0 data Cfg = Cfg { cfgTrustMap :: M.Map Int Int , cfgGroupMap :: M.Map Int Int } defCfg :: Cfg -> Cfg defCfg curcfg = Cfg { cfgTrustMap = mapdef $ cfgTrustMap curcfg , cfgGroupMap = mapdef $ cfgGroupMap curcfg } where mapdef :: Default v => M.Map k v -> M.Map k v mapdef = M.map (const def) }}} {{{ $ /opt/ghc/8.2.1/bin/ghc Bug.hs -O1 [1 of 1] Compiling Command.Vicfg ( Bug.hs, Bug.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.0.20170321 for x86_64-unknown-linux): Prelude.!!: index too large }}} Note: * You need optimization (`-O1` or `-O2`) enabled. * You need to import `Map`/`map` for this panic to trigger, it seems, as redefining `Map`/`map` locally makes it work again. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by RyanGlScott: Old description:
`git-annex-6.20170321` from Hackage currently fails to build with GHC 8.2.1 and HEAD because it triggers this panic. Here's a simplified example that exhibits the issue:
{{{#!hs {-# LANGUAGE BangPatterns #-} module Command.Vicfg where
import qualified Data.Map as M
class Default a where def :: a
instance Default Int where def = 0
data Cfg = Cfg { cfgTrustMap :: M.Map Int Int , cfgGroupMap :: M.Map Int Int }
defCfg :: Cfg -> Cfg defCfg curcfg = Cfg { cfgTrustMap = mapdef $ cfgTrustMap curcfg , cfgGroupMap = mapdef $ cfgGroupMap curcfg } where mapdef :: Default v => M.Map k v -> M.Map k v mapdef = M.map (const def) }}}
{{{ $ /opt/ghc/8.2.1/bin/ghc Bug.hs -O1 [1 of 1] Compiling Command.Vicfg ( Bug.hs, Bug.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.0.20170321 for x86_64-unknown-linux): Prelude.!!: index too large }}}
Note:
* You need optimization (`-O1` or `-O2`) enabled. * You need to import `Map`/`map` for this panic to trigger, it seems, as redefining `Map`/`map` locally makes it work again.
New description: `git-annex-6.20170321` from Hackage currently fails to build with GHC 8.2.1 and HEAD because it triggers this panic. Here's a simplified example that exhibits the issue: {{{#!hs module Command.Vicfg where import qualified Data.Map as M class Default a where def :: a instance Default Int where def = 0 data Cfg = Cfg { cfgTrustMap :: M.Map Int Int , cfgGroupMap :: M.Map Int Int } defCfg :: Cfg -> Cfg defCfg curcfg = Cfg { cfgTrustMap = mapdef $ cfgTrustMap curcfg , cfgGroupMap = mapdef $ cfgGroupMap curcfg } where mapdef :: Default v => M.Map k v -> M.Map k v mapdef = M.map (const def) }}} {{{ $ /opt/ghc/8.2.1/bin/ghc Bug.hs -O1 [1 of 1] Compiling Command.Vicfg ( Bug.hs, Bug.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.0.20170321 for x86_64-unknown-linux): Prelude.!!: index too large }}} Note: * You need optimization (`-O1` or `-O2`) enabled. * You need to import `Map`/`map` for this panic to trigger, it seems, as redefining `Map`/`map` locally makes it work again. -- -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13474: GHC HEAD regression: Prelude.!!: index too large
-------------------------------------+-------------------------------------
Reporter: RyanGlScott | Owner: (none)
Type: bug | Status: new
Priority: highest | Milestone: 8.2.1
Component: Compiler | Version: 8.1
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: GHC rejects | Unknown/Multiple
valid program | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by simonpj):
Stunning. Here's an even small test case
{{{
module T13474 where
import qualified Data.Map as M
class Default a where
def :: a
foo :: Default a => b -> a
foo x = def
mapdef :: Default v => M.Map k v -> M.Map k v
mapdef = M.map foo
}}}
With a debug compiler I get
{{{
matchN
map/coerce
[TYPE: a_a1eq, TYPE: b_a1er, TYPE: k_a1ep,
(\ (v_a1et :: a_a1eq) -> v_a1et)
`cast` (

#13474: GHC HEAD regression: Prelude.!!: index too large
-------------------------------------+-------------------------------------
Reporter: RyanGlScott | Owner: (none)
Type: bug | Status: new
Priority: highest | Milestone: 8.2.1
Component: Compiler | Version: 8.1
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: GHC rejects | Unknown/Multiple
valid program | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Changes (by RyanGlScott):
* cc: bgamari (added)
Comment:
The commit that caused this regression is somewhat surprising. It's
d2f48495ebe79b5ef5808a4891b3d03dfd297d35:
{{{
From d2f48495ebe79b5ef5808a4891b3d03dfd297d35 Mon Sep 17 00:00:00 2001
From: Ben Gamari

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Just took a look. The problem is that we're trying to make a `NthCo 0 g` where one of `g`'s types is `Constraint`. Of course, `Constraint` is identical to `TYPE LiftedRep`, so using `NthCo` is sensible, but GHC gets confused. I haven't tested it, but I'm nearly positive that merging Phab:D3316 would fix this. That patch is held up on discussions in #11715. It all boils down to a design question, and I don't feel like the discussion there has settled toward any consensus. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Ahh yes. I **knew** there was a reason why we needed that logic. I'm about to merge Phab:d3316 and after I do so I'll add a test and confirm that this is fixed. If not I'll likely just revert the commit mentioned in comment:3 on `ghc-8.2`. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I'm pretty sure Phab:D3316 will fix. I thought it was merged already. As a side comment, Richard, we were discussing yesterday why we meed `match_co` in rule matching. Here we do! See #13476! Also: '''Ben''', once you have merged Phab:D3316, and checked that it works, can you also swap the order of these two equations in `Rules.match_co`? {{{ match_co renv subst co1 co2 | Just (tc1, cos1) <- splitTyConAppCo_maybe co1 = case splitTyConAppCo_maybe co2 of Just (tc2, cos2) | tc1 == tc2 -> match_cos renv subst cos1 cos2 _ -> Nothing match_co renv subst co1 co2 | Just (arg1, res1) <- splitFunCo_maybe co1 = case splitFunCo_maybe co2 of Just (arg2, res2) -> match_cos renv subst [arg1, res1] [arg2, res2] _ -> Nothing }}} Currently the second will never match because `splitTyConAppCo_maybe` succeeds (inefficiently) on `FunCo`. Swapping them will make it more efficient. Swapping them will probably conceal the bug, so test the fix first! -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I would be happy to. Unfortunately there are some testsuite issues in Phab:D3316 which will need to be resolved before it can be merged. Namely, `T11480b` fails with, {{{ T11480b.hs:131:10: error: • Couldn't match kind ‘*’ with ‘Constraint’ arising from a use of ‘T11480b.$dmop’ • In the expression: T11480b.$dmop @Constraint @(:-) In an equation for ‘op’: op = T11480b.$dmop @Constraint @(:-) In the instance declaration for ‘Category (:-)’ }}} which I'm reasonably confident will break user code (namely Edward Kmetts's `constraints` library). -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Richard is on this. See #11715, comment:74 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Actually, Ben is on this. Ben and I spoke this morning, and he agreed to make this change. After he does, I'll go in and add the commentary. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474#comment:9 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): It looks like Phab:D3316 (6575f4b635a393775295798ca86c7c3ba00819be) did indeed fix this, as I can no longer reproduce the panic on GHC HEAD. Should we add a regression test for this? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13474: GHC HEAD regression: Prelude.!!: index too large
-------------------------------------+-------------------------------------
Reporter: RyanGlScott | Owner: (none)
Type: bug | Status: new
Priority: highest | Milestone: 8.2.1
Component: Compiler | Version: 8.1
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: GHC rejects | Unknown/Multiple
valid program | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Ben Gamari

#13474: GHC HEAD regression: Prelude.!!: index too large -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | typecheck/should_compile/T13474 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * testcase: => typecheck/should_compile/T13474 * resolution: => fixed -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13474#comment:12 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC