Should InScopeSet only include variables actually in scope.
Summary
In a module with two top-level bindings:
a = let foo = ... in ...
b = ...
When simplifying a
, foo
essentially becomes another top-level binding, in the sense that it appears in the InScopeSet
when simplifying b
.
However, from PostInlineUnconditionally
's point of view, foo
is not a top-level binding, so it may be inlined, and cease to exist, before we start simplifying b
.
But when that happens, foo
remains to be in the InScopeSet
when simplifying b
. If the simplified b
refers to foo
, GHC would crash.
Steps to reproduce
It took me a while to find a small repro example. It turns out there must be at least two local bindings (foo
and bar
in the example below) for the bug to occur, which I didn't realize at first..
Anyway, here's the smallest example I found. To run: ghc -package ghc -dynamic A.hs
. Result:
panic! (the 'impossible' happened)
GHC version 9.3.20210925:
refineFromInScope
InScope {wild_00 bar_a7ae a b $trModule $trModule_s7cH
$trModule_s7cI $trModule_s7cJ $trModule_s7cK}
foo_a7ad
-- A.hs
{-# OPTIONS_GHC -fplugin Plugin #-}
module A where
import Plugin (runPlugin)
a, b :: Bool
a =
-- OccInfo foo = OneOcc { occ_n_br = 2 } (PostInlineUnconditionally)
-- OccInfo bar = ManyOccs (not inlined)
let foo = (True == True)
bar = (True == True)
in case not bar of
True -> foo
False -> foo && bar
-- `b` will be rewritten by the plugin into `not foo`.
b = runPlugin (True == True)
{-# LANGUAGE OverloadedStrings #-}
module Plugin (plugin, runPlugin) where
import Data.List (find, isPrefixOf)
import Data.Maybe (fromJust)
import GHC (RdrName (..), mkModuleName)
import qualified GHC.Plugins as P
import GHC.Runtime.Loader (lookupRdrNameInModuleForPlugins)
import GHC.Types.TyThing (lookupId)
plugin :: P.Plugin
plugin = P.defaultPlugin {P.installCoreToDos = \_opts -> pure . install}
runPlugin :: Bool -> Bool
runPlugin = undefined
{-# NOINLINE runPlugin #-}
install :: [P.CoreToDo] -> [P.CoreToDo]
install = (todo :)
where
todo :: P.CoreToDo
todo = P.CoreDoPluginPass ("my pass") $ \guts -> do
hscEnv <- P.getHscEnv
runPluginId <- findId hscEnv "Plugin" "runPlugin"
notId <- findId hscEnv "Data.Bool" "not"
let try :: P.RuleFun
try _dflags inScope ident _exprs
| ident == runPluginId =
let inScopeVars = P.nonDetEltsUniqSet . P.getInScopeVars $ fst inScope
in Just $ case find
(\v -> "foo" `isPrefixOf` P.occNameString (P.nameOccName (P.varName v)))
inScopeVars of
-- `foo` is in `inScope`. Return `not foo`.
Just x -> P.App (P.Var notId) (P.Var x)
-- `foo` is not in `inScope`.
Nothing -> undefined
| otherwise = Nothing
rule =
P.BuiltinRule
{ P.ru_name = "my rule",
P.ru_fn = P.varName runPluginId,
P.ru_nargs = 1,
P.ru_try = try
}
-- Insert a rule that rewrites `runPlugin`.
pure $ guts {P.mg_rules = rule : P.mg_rules guts}
findId :: P.HscEnv -> String -> String -> P.CoreM P.Id
findId env modu occ =
lookupId
=<< P.liftIO
( fst . fromJust
<$> lookupRdrNameInModuleForPlugins
env
(mkModuleName modu)
(Unqual (P.mkVarOcc occ))
)
Environment
- GHC version used: 9.3.20210925 (4b7ba3ae)