HEAD regression: Compiling futhark panics on internal error

Summary

Initial discussion was here: head.hackage!360 (merged)

head.hackage cannot compile futhark with core lint error:

    Bad join point binding: getResults_sYiOj
    Join points can be bound only by a non-top-level let

Generated core looks like this:

poly_$w$j_slXk [InlPrag=[2]]
  :: (TestStatus -> State# RealWorld -> (# State# RealWorld, () #))
     -> State# RealWorld -> (# State# RealWorld, () #)
[LclId, Arity=2, Str=<L><L>b, Cpr=b]
poly_$w$j_slXk
  = \ (getResults_sky0
         :: TestStatus -> State# RealWorld -> (# State# RealWorld, () #))
      (ipv_slCH [Dmd=S, OS=OneShot] :: State# RealWorld) ->
      jump getResults_sky0 lvl_slXi ipv_slCH

Getting join point as an argument is obviously illegal.

Steps to reproduce

Currently, the only way to get the error is to compile futhark using head.hackage with GHC from master.

I had an attempt to minimize problematic file iteratively and came with this code:

{-# LANGUAGE LambdaCase #-}
{-# OPTIONS -dcore-lint -O0 #-}
{-# OPTIONS -fcall-arity #-}
{-# OPTIONS -ffloat-in #-}
{-# OPTIONS -ffull-laziness #-}
{-# OPTIONS -fenable-rewrite-rules #-}
{-# OPTIONS -fstrictness #-}

module Futhark.CLI.Test (main) where

import Control.Monad (when)
import System.Exit
import Language.Futhark.Tuple () 

data TestStatus = TestStatus
  { testStatusRemain :: [()],
    testStatusFail :: Int
  }

runTests :: TestConfig -> IO ()
runTests config = do

  let fancy = not (configLineOutput config) && fancyTerminal

      getResults ts
        | null (testStatusRemain ts) = pure ts
        | otherwise = do
            msg <- ioAction undef
            case msg of
              (test, res) -> do
                let ts' =
                      ts
                        { testStatusRemain = test `undef` testStatusRemain ts
                        }
                case res of
                  True -> do
                    getResults ts'
                  False -> do
                    when fancy (ioAction ())
                    getResults $
                      ts'
                        { testStatusFail = 1
                        }

  ts <-
    getResults
      undef

  if fancy
    then pure ()
    else ioAction ()

  exitWith $ case testStatusFail ts of
    0 -> ExitSuccess
    _ -> ExitFailure 1

data TestConfig = TestConfig
  { configLineOutput :: Bool
  }

fancyTerminal :: Bool
fancyTerminal = True
{-# NOINLINE fancyTerminal #-}

mainWithOpts :: (t1 -> t2) -> t2
mainWithOpts f = f undefined
{-# NOINLINE mainWithOpts #-}

ioAction :: a -> IO a
ioAction = pure
{-# NOINLINE ioAction #-}

undef :: a
undef = undef
{-# NOINLINE undef #-}

main :: IO ()
main = mainWithOpts runTests

But it turns out that my reproducer doesn't work well with others (head.hackage!360 (comment 556553)).