GHC panic! when unpacking a GADT in GHC >=9.6
Summary
GHC version >=9.6 incorrectly unpack GADTs, leading to some variant of the following GHC panic!
<no location info>: error:
panic! (the 'impossible' happened)
GHC version 9.12.1:
refineFromInScope
InScope {wild_00 $krep_ayi $krep_ayj $krep_ayk $krep_ayl $krep_aym
$krep_ayn $krep_ayo $krep_ayp $krep_ayq $krep_ayr $krep_ays
$krep_ayt $krep_ayu $krep_ayv boom $tc'Int $tc'Word $tcIntOrWord
$tc'WrapIntOrWord $tcWrapIntOrWord $trModule boom_syA boom_syB
$trModule_syC $trModule_syD $trModule_syE $trModule_syF $krep_syG
$tcIntOrWord_syH $tcIntOrWord_syI $krep_syJ $krep_syK $tc'Int_syL
$tc'Int_syM $krep_syN $tc'Word_syO $tc'Word_syP
$tcWrapIntOrWord_syQ $tcWrapIntOrWord_syR $krep_syS
$tc'WrapIntOrWord_syT $tc'WrapIntOrWord_syU}
unbx_axs
Call stack:
CallStack (from HasCallStack):
callStackDoc, called at compiler/GHC/Utils/Panic.hs:190:37 in ghc-9.12.1-623c:GHC.Utils.Panic
pprPanic, called at compiler/GHC/Core/Opt/Simplify/Env.hs:960:30 in ghc-9.12.1-623c:GHC.Core.Opt.Simplify.Env
Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug
Steps to reproduce
Create MyLib.hs
with the following contents and compile it with optimisations, i.e., with ghc -O MyLib.hs
.
-- file: MyLib.hs
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module MyLib where
data IntOrWord (isInt :: Bool) where
Int :: !Int -> IntOrWord True
Word :: !Word -> IntOrWord False
data WrapIntOrWord (isInt :: Bool)
= WrapIntOrWord {-# UNPACK #-} !(IntOrWord isInt)
boom :: WrapIntOrWord True
boom = WrapIntOrWord (Int 1)
Expected behavior
I expect GHC to ignore the unusable UNPACK pragma and emit a warning, as GHC 9.4.8 did.
src/MyLib.hs:12:7: warning:
• Ignoring unusable UNPACK pragma
on the first argument of ‘WrapIntOrWord’
• In the definition of data constructor ‘WrapIntOrWord’
In the data type declaration for ‘WrapIntOrWord’
|
12 | = WrapIntOrWord {-# UNPACK #-} !(IntOrWord isInt)
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Environment
GHC 9.4.8 has the correct behaviour (ignore the UNPACK pragma, emit a warning).
GHC versions 9.6.6, 9.8.4, 9.10.1, and 9.12.1 panic.
Optional:
- Operating System: macOS 10.15
- System Architecture: aarch64
Edited by Wen Kokke