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)).