refineFromInScope panic with TH/FFI
Steps to reproduce
{-# LANGUAGE TemplateHaskell #-}
module Test where
import Language.Haskell.TH
foreign import ccall foo :: IO ()
$(runIO foo >> pure [])
~/projects/ghc/master/_build/stage1/bin/ghc Test.hs -fforce-recomp -v3
Glasgow Haskell Compiler, Version 9.11.20240807, stage 2 booted by GHC version 9.6.6
package flags []
loading package database /home/hsyl20/projects/ghc/master/_build/stage1/lib/package.conf.d
wired-in package ghc-prim mapped to ghc-prim-0.11.0-inplace
wired-in package ghc-bignum mapped to ghc-bignum-1.3-inplace
wired-in package ghc-internal mapped to ghc-internal-9.1001.0-inplace
wired-in package base mapped to base-4.20.0.0-inplace
wired-in package rts mapped to rts-1.0.2
Chasing modules from: main:Test.hs
Ready for upsweep [SingleModule(main:Test [])]
compile: input file Test.hs
*** Checking old interface for Test (use -ddump-hi-diffs for more details):
[1 of 1] Compiling Test ( Test.hs, Test.o )
<no location info>: error:
panic! (the 'impossible' happened)
GHC version 9.11.20240807:
refineFromInScope
InScope {wild_00}
foo
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/Core/Opt/Simplify/Env.hs:960:30 in ghc-9.11-inplace:GHC.Core.Opt.Simplify.Env
CallStack (from HasCallStack):
panic, called at compiler/GHC/Utils/Error.hs:507:29 in ghc-9.11-inplace:GHC.Utils.Error
Expected behavior
Don't panic.
Might be related to #21321