GitLab

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)