GHC HEAD panics on out-of-scope record pattern synonym (but not 9.10)
When attempting to make GHC HEAD build with ghcide-2.9.0.0
(see head.hackage!375 (merged)), it was discovered that GHC HEAD panics on invalid code that GHC 9.10 will reject with a proper error message. Here is a minimized version of the code that it panics on:
-- A.hs
{-# LANGUAGE PatternSynonyms #-}
module A
( T
, T_(unT)
, pattern T
) where
type T = T_ ()
data T_ a = PrivateT { unT_ :: a }
pattern T :: a -> T_ a
pattern T { unT } <- PrivateT { unT_ = unT }
-- B.hs
module B (T, T_(..)) where
import A (T, T_(..))
-- C.hs
{-# LANGUAGE RecordWildCards #-}
module C where
import B
foo :: T -> ()
foo (T { unT = x }) = x
Note that the T
pattern synonym is not in scope in C
, and GHC 9.10.1 correctly reports this:
$ ghc-9.10.1 C.hs
[1 of 3] Compiling A ( A.hs, A.o )
[2 of 3] Compiling B ( B.hs, B.o )
[3 of 3] Compiling C ( C.hs, C.o )
C.hs:8:6: error: [GHC-76037]
Not in scope: data constructor ‘T’
|
8 | foo (T { unT = x }) = x
| ^
GHC HEAD (as of commit bc1d435e), on the other hand, will panic:
$ ~/Software/ghc-9.11.20240630/bin/ghc C.hs
[1 of 3] Compiling A ( A.hs, A.o )
[2 of 3] Compiling B ( B.hs, B.o )
[3 of 3] Compiling C ( C.hs, C.o )
<no location info>: error:
panic! (the 'impossible' happened)
GHC version 9.11.20240630:
lookupConstructorInfo: not a ConLike
name: T
Call stack:
CallStack (from HasCallStack):
callStackDoc, called at compiler/GHC/Utils/Panic.hs:190:37 in ghc-9.11-inplace:GHC.Utils.Panic
pprPanic, called at compiler/GHC/Rename/Env.hs:439:18 in ghc-9.11-inplace:GHC.Rename.Env
CallStack (from HasCallStack):
panic, called at compiler/GHC/Utils/Error.hs:507:29 in ghc-9.11-inplace:GHC.Utils.Error
Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug
Note that:
-
Re-exporting
pattern T
fromB
will cause GHC to accept the program (as expected) on both GHC 9.10.1 and HEAD. -
For some reason, enabling the
RecordWildCards
extension is essential to triggering the panic. If you remove this extension, then GHC HEAD will give a proper error message:$ ~/Software/ghc-9.11.20240630/bin/ghc C.hs [1 of 3] Compiling A ( A.hs, A.o ) [2 of 3] Compiling B ( B.hs, B.o ) [3 of 3] Compiling C ( C.hs, C.o ) C.hs:8:6: error: [GHC-01928] • Illegal term-level use of the type constructor ‘T’ • imported from ‘B’ at C.hs:5:1-8 (and originally defined in ‘A’ at A.hs:9:1-14) • In the pattern: T {unT = x} In an equation for ‘foo’: foo (T {unT = x}) = x | 8 | foo (T { unT = x }) = x | ^^^^^^^^^^^^^