[GHC] #15767: "StgCmmEnv: variable not found" with FunctionalDependencies and FlexibleContexts

#15767: "StgCmmEnv: variable not found" with FunctionalDependencies and FlexibleContexts -------------------------------------+------------------------------------- Reporter: roland | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{ {-# LANGUAGE FunctionalDependencies, FlexibleContexts #-} module Bug where class C a b | b -> a where f :: a -> b y = x where x :: (C () b, C Bool b) => b x = f () }}} {{{ $ ghc -c Bug.hs ghc: panic! (the 'impossible' happened) (GHC version 8.6.1 for x86_64-unknown-openbsd): StgCmmEnv: variable not found $dC_a1lC local binds for: f $tc'C:C $tcC $trModule $tc'C:C1_r1mz $tc'C:C2_r1n0 $krep_r1n1 $krep1_r1n2 $krep2_r1n3 $krep3_r1n4 $krep4_r1n5 $tcC1_r1n6 $tcC2_r1n7 $krep5_r1n8 $krep6_r1n9 $krep7_r1na $trModule1_r1nb $trModule2_r1nc $trModule3_r1nd $trModule4_r1ne $krep8_r1nf $krep9_r1ng Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/codeGen/StgCmmEnv.hs:149:9 in ghc:StgCmmEnv Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15767 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15767: "StgCmmEnv: variable not found" with FunctionalDependencies and FlexibleContexts -------------------------------------+------------------------------------- Reporter: roland | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): This is quite an interesting program you have here. When this is compiled with GHC 8.2 or earlier, you get a proper type error: {{{ $ /opt/ghc/8.2.2/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:7:5: error: • Couldn't match type ‘()’ with ‘Bool’ arising from a functional dependency between constraints: ‘C Bool b’ arising from a use of ‘x’ at Bug.hs:7:5 ‘C () b’ arising from a use of ‘x’ at Bug.hs:7:5 • In the expression: x In an equation for ‘y’: y = x where x :: (C () b, C Bool b) => b x = f () | 7 | y = x where | ^ }}} It appears to compile successfully with GHC 8.4. But that is a charade, since if you try to evaluate `y` in GHCi, you get... well, this: {{{ $ /opt/ghc/8.4.4/bin/ghci Bug.hs GHCi, version 8.4.4: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Ok, one module loaded. λ> y *** Exception: Bug.hs:7:5: error: • No instance for (C () b) arising from a use of ‘x’ • In the expression: x In an equation for ‘y’: y = x where x :: (C () b, C Bool b) => b x = f () (deferred type error) }}} Interestingly, despite the fact that compiling this directly with GHC 8.6.1 panics, it //does// load successfully into GHCi with GHC 8.6.1. However, if you evaluate `y` in GHCi 8.6.1, you get a //different// panic: {{{ $ /opt/ghc/8.6.1/bin/ghci Bug.hs GHCi, version 8.6.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Ok, one module loaded. λ> y ghc: panic! (the 'impossible' happened) (GHC version 8.6.1 for x86_64-unknown-linux): nameModule system $dC_a1PK Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/basicTypes/Name.hs:240:3 in ghc:Name }}} Weird behavior all around. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15767#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15767: "StgCmmEnv: variable not found" with FunctionalDependencies and FlexibleContexts -------------------------------------+------------------------------------- Reporter: roland | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I'm on this. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15767#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15767: "StgCmmEnv: variable not found" with FunctionalDependencies and
FlexibleContexts
-------------------------------------+-------------------------------------
Reporter: roland | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 8.6.1
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: Compile-time | Unknown/Multiple
crash or panic | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Simon Peyton Jones

#15767: "StgCmmEnv: variable not found" with FunctionalDependencies and FlexibleContexts -------------------------------------+------------------------------------- Reporter: roland | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: Component: Compiler | Version: 8.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | typecheck/should_fail/T15767 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => merge * testcase: => typecheck/should_fail/T15767 Comment: Thanks -- fixed! -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15767#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15767: "StgCmmEnv: variable not found" with FunctionalDependencies and FlexibleContexts -------------------------------------+------------------------------------- Reporter: roland | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: Component: Compiler | Version: 8.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | typecheck/should_fail/T15767 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I'm afraid I'm seeing some spurious test output changes when cherry- picking this to `ghc-8.6`. For instance, {{{#!patch diff -uw "./rename/should_fail/mc13.run/mc13.stderr.normalised" "./rename/should_fail/mc13.run/mc13.comp.stderr.normalised" --- ./rename/should_fail/mc13.run/mc13.stderr.normalised 2018-10-30 14:54:22.690690790 -0400 +++ ./rename/should_fail/mc13.run/mc13.comp.stderr.normalised 2018-10-30 14:54:22.690690790 -0400 @@ -1,2 +1,18 @@ -mc13.hs:12:37: Variable not in scope: f :: [a] -> m a +mc13.hs:12:16: + Ambiguous type variable ‘m0’ arising from a statement in a monad comprehension + prevents the constraint ‘(Monad m0)’ from being solved. + Relevant bindings include output :: m0 () (bound at mc13.hs:12:1) + Probable fix: use a type annotation to specify what ‘m0’ should be. + These potential instances exist: + instance Monad IO -- Defined in ‘GHC.Base’ + instance Monad Maybe -- Defined in ‘GHC.Base’ + instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’ + ...plus one other + ...plus two instances involving out-of-scope types + (use -fprint-potential-instances to see them all) + In a stmt of a monad comprehension: then f + In the expression: [() | f <- functions, then f] + In an equation for ‘output’: output = [() | f <- functions, then f] + +mc13.hs:12:37: Variable not in scope: f :: [a] -> m0 a }}} and similar new errors in `TEST="T12529 T12921 mc13 mc14"`. Given that these are just error message regressions I'm going to go ahead and accept them (and perhaps we can fix them later if anyone knows the cause off- hand). -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15767#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15767: "StgCmmEnv: variable not found" with FunctionalDependencies and FlexibleContexts -------------------------------------+------------------------------------- Reporter: roland | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.2 Component: Compiler | Version: 8.6.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | typecheck/should_fail/T15767 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed * milestone: => 8.6.2 Comment: Merged with a49f95c29b3a5f665b3ec0f1f05d78b73244b1f1. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15767#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC