GHC issueshttps://gitlab.haskell.org/ghc/ghc/-/issues2023-02-01T13:31:39Zhttps://gitlab.haskell.org/ghc/ghc/-/issues/22819Template Haskell incorrectly reifies `type data` declaration as DataD rather ...2023-02-01T13:31:39ZRyan ScottTemplate Haskell incorrectly reifies `type data` declaration as DataD rather than TypeDataDCompiling this file with GHC 9.6.1-alpha1:
```
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeData #-}
module Main (main) where
import Language.Haskell.TH
type data T
$(pure [])
main :: IO ()
main = putStrLn $(reify ''T >>= strin...Compiling this file with GHC 9.6.1-alpha1:
```
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeData #-}
module Main (main) where
import Language.Haskell.TH
type data T
$(pure [])
main :: IO ()
main = putStrLn $(reify ''T >>= stringE . show)
```
Will print the following output:
```
$ runghc-9.6.0.20230111 Foo.hs
TyConI (DataD [] Main.T [] Nothing [] [])
```
I believe that should display [`TypeDataD`](https://gitlab.haskell.org/ghc/ghc/-/blob/82884ce063180a39afed163590738f7095394583/libraries/template-haskell/Language/Haskell/TH/Syntax.hs#L2406-2408), not `DataD`.
This might be related to #22818, although I believe they are separate bugs.9.6.1Ryan ScottRyan Scotthttps://gitlab.haskell.org/ghc/ghc/-/issues/22816Compose's Show/Show1 and Read/Read1 instances no longer agree in GHC 9.6.1-al...2023-01-26T23:12:05ZRyan ScottCompose's Show/Show1 and Read/Read1 instances no longer agree in GHC 9.6.1-alpha1As of `base-4.18.0.0` (as bundled with GHC 9.6.1-alpha1), the behavior of `Compose`'s `Show` instance no longer agrees with its `Show1` instance. By that, I mean that if you run the following program:
```hs
module Main where
import Dat...As of `base-4.18.0.0` (as bundled with GHC 9.6.1-alpha1), the behavior of `Compose`'s `Show` instance no longer agrees with its `Show1` instance. By that, I mean that if you run the following program:
```hs
module Main where
import Data.Functor.Classes
import Data.Functor.Compose
ex :: Compose Maybe Maybe Int
ex = Compose Nothing
main :: IO ()
main = do
putStrLn $ showsPrec 0 ex ""
putStrLn $ showsPrec1 0 ex ""
```
You would expect `Compose Nothing` to be printed twice. Indeed, this happens with GHC 9.4.4 and earlier:
```
$ runghc-9.4.4 Bug.hs
Compose Nothing
Compose Nothing
```
But not with GHC 9.6.1-alpha1:
```
$ runghc-9.6.0.20230111 Bug.hs
Compose {getCompose = Nothing}
Compose Nothing
```
The `Show` instance now prints out the `getCompose` record selector, which it did not do in previous releases.
My guess is that this is an oversight that was accidentally introduced in commit 7beb356e944bf3415394fd6aeb7841aca5759020. The previous `Show` instance for `Compose` was defined as:
```hs
instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where
showsPrec = showsPrec1
instance (Show1 f, Show1 g) => Show1 (Compose f g) where
liftShowsPrec sp sl d (Compose x) =
showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x
where
sp' = liftShowsPrec sp sl
sl' = liftShowList sp sl
```
Note that this uses `showsUnaryWith`, which does _not_ print the record selector. After commit 7beb356e944bf3415394fd6aeb7841aca5759020, however, the `Show` instance for `Compose` is now derived:
```hs
deriving instance Show (f (g a)) => Show (Compose f g a)
```
Derived `Show` instances always show record selectors if they are defined, which would explain the difference. One possible to fix the issue would be to change the `Show` instance to:
```hs
instance Show (f (g a)) => Show (Compose f g a) where
showsPrec d (Compose x) =
showsUnaryWith showsPrec "Compose" d x
```
-----
A similar bug exists for `Compose`'s now-derived `Read` instance, which also disagrees with its `Read1` instance. This can be seen by running this program:
```hs
module Main where
import Data.Functor.Compose
main :: IO ()
main = print (read "Compose Nothing" :: Compose Maybe Maybe Int)
```
This succeeds on GHC 9.4.4 and earlier:
```
$ runghc-9.4.4 Bug.hs
Compose Nothing
```
But fails with GHC 9.6.1-alpha1:
```
$ runghc-9.6.0.20230111 Bug.hs
Compose {getCompose = Bug.hs: Prelude.read: no parse
```
cc @Ericson23149.6.1https://gitlab.haskell.org/ghc/ghc/-/issues/22813Runtime behavior of `structs` library changes with GHC 9.6.1-alpha12023-02-17T01:31:59ZRyan ScottRuntime behavior of `structs` library changes with GHC 9.6.1-alpha1Running the test suite of the `structs` library on Hackage fails with GHC 9.6.1-alpha1, which does not happen with earlier versions of GHC. I've minimized the phenomenon to this standalone reproducer:
<details>
```hs
{-# LANGUAGE GHC20...Running the test suite of the `structs` library on Hackage fails with GHC 9.6.1-alpha1, which does not happen with earlier versions of GHC. I've minimized the phenomenon to this standalone reproducer:
<details>
```hs
{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ViewPatterns #-}
module Main (main) where
import Control.Monad.ST
import Data.Coerce
import GHC.Exts
import GHC.ST
newtype LinkedList a s = LinkedList (Object s)
instance Struct (LinkedList a) where
struct = Dict
instance Eq (LinkedList a s) where
(==) = eqStruct
val :: forall a. Field (LinkedList a) a
val = field 0
{-# INLINE val #-}
next :: forall a. Slot (LinkedList a) (LinkedList a)
next = slot 1
{-# INLINE next #-}
newLinkedList ::
forall a. forall m.
PrimMonad m =>
a -> LinkedList a (PrimState m) -> m (LinkedList a (PrimState m))
newLinkedList val' next'
= st
(do this <- allocLinkedList
((setField val) this) val'
((set next) this) next'
return this)
allocLinkedList ::
forall a. forall m. PrimMonad m => m (LinkedList a (PrimState m))
allocLinkedList = alloc 2
{-# INLINE allocLinkedList #-}
-- Make an empty linked list
mkEmptyLinkedList :: LinkedList a s
mkEmptyLinkedList = Nil
-- Make a linked list node with a value
mkLinkedListNode :: PrimMonad m => a -> m (LinkedList a (PrimState m))
mkLinkedListNode a = newLinkedList a Nil
-- Convert a haskell list to a linked list
listToLinkedList :: PrimMonad m => [a] -> m (LinkedList a (PrimState m))
listToLinkedList [] = return mkEmptyLinkedList
listToLinkedList (x:xs) = do
head' <- mkLinkedListNode x
rest <- listToLinkedList xs
set next head' rest
return head'
main :: IO ()
main = print $ runST $ do
let xs :: [Int]
xs = []
lxs <- listToLinkedList xs
listEqLinkedList xs lxs
-- Return if a list equal to some linked list representation.
listEqLinkedList :: PrimMonad m => Eq a => [a] -> LinkedList a (PrimState m) -> m Bool
listEqLinkedList [] l = return $ isNil l
listEqLinkedList (x:xs) l = do
xval <- getField val l
if xval == x
then do
l' <- get next l
listEqLinkedList xs l'
else return False
-----
-- Control.Monad.Primitive
-----
class Monad m => PrimMonad m where
type PrimState m
primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
class PrimMonad m => PrimBase m where
internal :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #)
instance PrimMonad (ST s) where
type PrimState (ST s) = s
primitive = ST
{-# INLINE primitive #-}
instance PrimBase (ST s) where
internal (ST p) = p
{-# INLINE internal #-}
primitive_ :: PrimMonad m
=> (State# (PrimState m) -> State# (PrimState m)) -> m ()
{-# INLINE primitive_ #-}
primitive_ f = primitive (\s# ->
case f s# of
s'# -> (# s'#, () #))
primToPrim :: (PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2)
=> m1 a -> m2 a
{-# INLINE primToPrim #-}
primToPrim m = primitive (internal m)
-----
-- Data.Struct.Internal
-----
data Dict p where
Dict :: p => Dict p
st :: PrimMonad m => ST (PrimState m) a -> m a
st = primToPrim
{-# INLINE[0] st #-}
class Struct t where
struct :: Dict (Coercible (t s) (Object s))
data Object s = Object { runObject :: SmallMutableArray# s Any }
coerceF :: Dict (Coercible a b) -> a -> b
coerceF Dict = coerce
{-# INLINE coerceF #-}
coerceB :: Dict (Coercible a b) -> b -> a
coerceB Dict = coerce
{-# INLINE coerceB #-}
destruct :: Struct t => t s -> SmallMutableArray# s Any
destruct = \x -> runObject (coerceF struct x)
{-# INLINE destruct #-}
construct :: Struct t => SmallMutableArray# s Any -> t s
construct = \x -> coerceB struct (Object x)
{-# INLINE construct #-}
eqStruct :: Struct t => t s -> t s -> Bool
eqStruct = \x y -> isTrue# (destruct x `sameSmallMutableArray#` destruct y)
{-# INLINE eqStruct #-}
alloc :: (PrimMonad m, Struct t) => Int -> m (t (PrimState m))
alloc (I# n#) = primitive $ \s -> case newSmallArray# n# undefined s of (# s', b #) -> (# s', construct b #)
writeSmallMutableArraySmallArray# :: SmallMutableArray# s Any -> Int# -> SmallMutableArray# s Any -> State# s -> State# s
writeSmallMutableArraySmallArray# m i a s = unsafeCoerce# writeSmallArray# m i a s
{-# INLINE writeSmallMutableArraySmallArray# #-}
readSmallMutableArraySmallArray# :: SmallMutableArray# s Any -> Int# -> State# s -> (# State# s, SmallMutableArray# s Any #)
readSmallMutableArraySmallArray# m i s = unsafeCoerce# readSmallArray# m i s
{-# INLINE readSmallMutableArraySmallArray# #-}
casSmallMutableArraySmallArray# :: SmallMutableArray# s Any -> Int# -> SmallMutableArray# s Any -> SmallMutableArray# s Any -> State# s -> (# State# s, Int#, SmallMutableArray# s Any #)
casSmallMutableArraySmallArray# m i o n s = unsafeCoerce# casSmallArray# m i o n s
{-# INLINE casSmallMutableArraySmallArray# #-}
data Slot x y = Slot
(forall s. SmallMutableArray# s Any -> State# s -> (# State# s, SmallMutableArray# s Any #))
(forall s. SmallMutableArray# s Any -> SmallMutableArray# s Any -> State# s -> State# s)
(forall s. SmallMutableArray# s Any -> SmallMutableArray# s Any -> SmallMutableArray# s Any -> State# s -> (# State# s, Int#, SmallMutableArray# s Any #))
slot :: Int {- ^ slot -} -> Slot s t
slot (I# i) = Slot
(\m s -> readSmallMutableArraySmallArray# m i s)
(\m a s -> writeSmallMutableArraySmallArray# m i a s)
(\m o n s -> casSmallMutableArraySmallArray# m i o n s)
get :: (PrimMonad m, Struct x, Struct y) => Slot x y -> x (PrimState m) -> m (y (PrimState m))
get (Slot go _ _) = \x -> primitive $ \s -> case go (destruct x) s of
(# s', y #) -> (# s', construct y #)
{-# INLINE get #-}
set :: (PrimMonad m, Struct x, Struct y) => Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set (Slot _ go _) = \x y -> primitive_ (go (destruct x) (destruct y))
{-# INLINE set #-}
data Field x a = Field
(forall s. SmallMutableArray# s Any -> State# s -> (# State# s, a #)) -- get
(forall s. SmallMutableArray# s Any -> a -> State# s -> State# s) -- set
field :: Int {- ^ slot -} -> Field s a
field (I# i) = Field
(\m s -> unsafeCoerce# readSmallArray# m i s)
(\m a s -> unsafeCoerce# writeSmallArray# m i a s)
{-# INLINE field #-}
getField :: (PrimMonad m, Struct x) => Field x a -> x (PrimState m) -> m a
getField (Field go _) = \x -> primitive (go (destruct x))
{-# INLINE getField #-}
setField :: (PrimMonad m, Struct x) => Field x a -> x (PrimState m) -> a -> m ()
setField (Field _ go) = \x y -> primitive_ (go (destruct x) y)
{-# INLINE setField #-}
data Box = Box Null
data Null = Null
isNil :: Struct t => t s -> Bool
isNil t = isTrue# (unsafeCoerce# reallyUnsafePtrEquality# (destruct t) Null)
{-# INLINE isNil #-}
pattern Nil :: Struct t => () => t s
pattern Nil <- (isNil -> True) where
Nil = unsafeCoerce# Box Null
```
</details>
The intended behavior is that this program should print `True`. GHC 9.4.4 does this:
```
$ ghc-9.4.4 Bug.hs -O -fforce-recomp
[1 of 2] Compiling Main ( Bug.hs, Bug.o )
[2 of 2] Linking Bug [Objects changed]
$ ./Bug
True
```
But GHC 9.6.1-alpha1 prints `False` instead:
```
$ ghc-9.6.0.20230111 Bug.hs -O -fforce-recomp
[1 of 2] Compiling Main ( Bug.hs, Bug.o )
[2 of 2] Linking Bug [Objects changed]
$ ./Bug
False
```
A couple of observations:
* Is this code's behavior well defined? Admittedly, it is a rather advanced Edward Kmett library that makes heavy use of `unsafeCoerce#` and `reallyUnsafePointerEquality#`. (See also #12669.) Still, the behavior of this library has remained remarkably stable for several GHC releases, so I figured that a change in behavior is probably worth looking into.
* Speaking of `reallyUnsafePointerEquality#`, there have been some changes surrounding this function in #17126 and #20863. I'm unclear if these changes are responsible for the change in behavior seen above.9.6.1https://gitlab.haskell.org/ghc/ghc/-/issues/22666containers intset-benchmark takes a long time to run on HEAD.2023-03-31T09:33:30ZAndreas Klebingercontainers intset-benchmark takes a long time to run on HEAD.Works with 9.4.2:
```
Pandi@Ryzen MINGW64 ~/repos/containers
$ cabal run -w ghc-9.4.2 --allow-newer=* intset-benchmarks -- -p All.member
Up to date
All
member: OK (2.44s)
37.2 μs ± 2.6 μs
All 1 tests passed (2.44s)
```
But with ...Works with 9.4.2:
```
Pandi@Ryzen MINGW64 ~/repos/containers
$ cabal run -w ghc-9.4.2 --allow-newer=* intset-benchmarks -- -p All.member
Up to date
All
member: OK (2.44s)
37.2 μs ± 2.6 μs
All 1 tests passed (2.44s)
```
But with HEAD this takes forever. I eventually killed the process as I got bored of waiting
```
$ time cabal --store-dir store-head run --builddir=dist-head -w /home/andi/ghc_head/_build/stage1/bin/ghc --allow-newer=* intset-benchmarks -- -p All.member
Up to date
All
member: This benchmark takes more than 100 seconds. Consider setting --timeout, if this is unexpected (or to silence this warning).
real 3m23.322s
user 0m0.000s
sys 0m0.015s
```
Seems pretty bad.9.6.1https://gitlab.haskell.org/ghc/ghc/-/issues/22492Program produces <<loop>> with GHC 9.0/9.2, but not with GHC 8.102022-12-09T20:15:38ZRyan ScottProgram produces <<loop>> with GHC 9.0/9.2, but not with GHC 8.10While attempting to upgrade the [`saw-script`]() project, I have noticed that it will produce a runtime `<<loop>>` on GHC 9.0 and 9.2 on a program that did not used to `<<loop>>` with GHC 8.10. I believe this to be a regression, so I am ...While attempting to upgrade the [`saw-script`]() project, I have noticed that it will produce a runtime `<<loop>>` on GHC 9.0 and 9.2 on a program that did not used to `<<loop>>` with GHC 8.10. I believe this to be a regression, so I am reporting it here. Unfortunately, I have not been able to minimize the issue, but you can perform the following steps:
1. Ensure you have Clang installed. In case it is important, I am using Clang 10.0.0 on 64-bit Ubuntu 20.04:
```
$ clang --version
clang version 10.0.0-4ubuntu1
Target: x86_64-pc-linux-gnu
Thread model: posix
InstalledDir: /usr/bin
```
2. Clone https://github.com/GaloisInc/saw-script, enter the `saw-script` directory, and check out the `ghc-9.0-9.2-bug` branch:
```
$ git clone https://github.com/GaloisInc/saw-script
$ cd saw-script
$ git checkout ghc-9.0-9.2-bug
```
3. Put the following files in the `saw-script` directory:
```c
// column.c
typedef enum {
ColumnA = 0,
ColumnB,
} Column;
int is_column_a(Column c) {
return c == ColumnA;
}
```
```
// column.saw
```
```
// bug.saw
enable_experimental;
env <- heapster_init_env "column" "column.bc";
heapster_define_perm env "int32" " " "llvmptr 32" "exists x:bv 32.eq(llvmword(x))";
heapster_define_perm env "Column" ""
"llvmptr 32"
"eq(llvmword(0)) or eq(llvmword(1))";
heapster_typecheck_fun env "is_column_a"
"().arg0:Column<> -o ret:int32<>";
```
4. Compile `column.c` with Clang like so:
```
$ clang-10 -emit-llvm -c column.c -o column.bc
```
5. Run the following command to run `saw` using GHC 8.10.7, which should succeed:
```
$ cabal run exe:saw -w ghc-8.10.7 -- bug.saw
Resolving dependencies...
Up to date
[00:19:37.163] Loading file "/home/ryanglscott/Documents/Hacking/Haskell/saw-script/bug.saw"
```
6. Now run the same command with GHC 9.0.2 or 9.2.4. These will loop:
```
$ cabal run exe:saw -w ghc-9.0.2 -- bug.saw
Resolving dependencies...
Up to date
[00:21:46.189] Loading file "/home/ryanglscott/Documents/Hacking/Haskell/saw-script/bug.saw"
[00:21:46.531] <<loop>>
```
```
$ cabal run exe:saw -w ghc-9.2.4 -- bug.saw
Resolving dependencies...
Up to date
[00:22:49.344] Loading file "/home/ryanglscott/Documents/Hacking/Haskell/saw-script/bug.saw"
[00:22:49.682] <<loop>>
```
Note that you should only use GHC 9.2.4 or earlier, not 9.2.5, as GHC 9.2.5 will trigger #22491.Ryan ScottRyan Scotthttps://gitlab.haskell.org/ghc/ghc/-/issues/22421Data race in `readTVarIO#`?2023-08-22T17:49:54ZBen GamariData race in `readTVarIO#`?Currently `readTVarIO#` is defined thusly (annotations are my own):
```c
stg_readTVarIOzh ( P_ tvar /* :: TVar a */ )
{
W_ result, resultinfo;
again:
result = StgTVar_current_value(tvar);
...Currently `readTVarIO#` is defined thusly (annotations are my own):
```c
stg_readTVarIOzh ( P_ tvar /* :: TVar a */ )
{
W_ result, resultinfo;
again:
result = StgTVar_current_value(tvar);
// (1)
resultinfo = %INFO_PTR(result);
prim_read_barrier; // (2)
if (resultinfo == stg_TREC_HEADER_info) {
goto again;
}
return (result);
}
```
I'm skeptical that the barriers here are correct. In particular, it seems to me that there should be a read barrier between the load from `tvar->current_value` and the `%INFO_PTR` load (point (1)). Secondly, I don't believe that the barrier at (2) is necessary.
IMHO, this is all much easier to reason about with C11-style release acquire semantics. Under this worldview, the load from `current_value` should be an acquire-load, which will synchronize with the release-store in `unlock_tvar`. This will guarantee a happens-before relationship, which then allows us to conclude that the barrier at (2) is redundant since the construction of the closure necessarily happens-before the store in `unlock_tvar`.Ben GamariBen Gamarihttps://gitlab.haskell.org/ghc/ghc/-/issues/22042ghc-9.4.1 runghc illegal hardware instruction2022-10-18T08:41:53ZShayne Fletchershayne@shaynefletcher.orgghc-9.4.1 runghc illegal hardware instruction## Summary
a program calling `setSGR` from the `System.Console.ANSI` package executed via `runghc` exhibits an illegal hardware instruction error.
see this [commercial-stack issue](https://github.com/commercialhaskell/stack/issues/5823...## Summary
a program calling `setSGR` from the `System.Console.ANSI` package executed via `runghc` exhibits an illegal hardware instruction error.
see this [commercial-stack issue](https://github.com/commercialhaskell/stack/issues/5823) for further insights.
## Steps to reproduce
execute
```bash
cat > Main.hs <<EOF
import System.Console.ANSI
main = do
setSGR [SetColor Foreground Dull Red]
EOF
~/ghc-9.4.1/bin/runghc -hide-all-packages -package --ghc-arg="base-4.17.0.0" -package --ghc-arg="colour-2.3.6" -package --ghc-arg="ansi-terminal-0.11.3" --ghc-arg=-package-db --ghc-arg=$HOME/.cabal/store/ghc-9.4.1/package.db Main.hs
```
and observe abnormal termination and the bash exit code `132`. (the equivalent 9.2.4 command
```
~/ghc-9.2.4/bin/runghc -hide-all-packages -package --ghc-arg="base-4.16.3.0" -package --ghc-arg="colour-2.3.6" -package --ghc-arg="ansi-terminal-0.11.3" --ghc-arg=-package-db --ghc-arg=$HOME/.cabal/store/ghc-9.2.4/package.db Main.hs
```
terminates normally. also, a "raw" ghc command
```
~/ghc-9.4.1/bin/ghc -o test -hide-all-packages -package "base-4.17.0.0" -package "colour-2.3.6" -package "ansi-terminal-0.11.3" -package-db $HOME/.cabal/store/ghc-9.4.1/package.db Main.hs&&./test
```
terminates normally too.)
## Expected behavior
terminate normally with no output and bash exit code `0`
## Environment
* GHC version used: ghc-9.4.1
Optional:
* Operating System: macOS monterey
* System Architecture: x86_649.4.2Andreas KlebingerAndreas Klebingerhttps://gitlab.haskell.org/ghc/ghc/-/issues/22019LLVM backend turns LLVM builtin variables into aliases2022-10-14T21:10:30ZBen GamariLLVM backend turns LLVM builtin variables into aliasesThe LLVM's aliasification logic (see `Note [Llvm Forward References]`) currently turns all top-level LLVM variables, including builtins (e.g. `$llvm.global_ctors`) into aliases. This confuses LLVM, subtly breaking a number of things (e....The LLVM's aliasification logic (see `Note [Llvm Forward References]`) currently turns all top-level LLVM variables, including builtins (e.g. `$llvm.global_ctors`) into aliases. This confuses LLVM, subtly breaking a number of things (e.g. initializers). This causes quite a few testsuite failures in LLVM-only platforms (e.g. ARMv7).https://gitlab.haskell.org/ghc/ghc/-/issues/21973GHC produces Core with an infinite <<loop>> v32024-01-14T22:00:06ZAlexey KuleshevichGHC produces Core with an infinite <<loop>> v3## Summary
This feels like deja vu. :smile: Every two years I report a very similar bug. Last one was fixed in ghc-8.10.2 while this one is reproducible with: ghc-8.10.7, ghc-9.0. and ghc-9.2.4 (haven't tried the HEAD). Maybe third time...## Summary
This feels like deja vu. :smile: Every two years I report a very similar bug. Last one was fixed in ghc-8.10.2 while this one is reproducible with: ghc-8.10.7, ghc-9.0. and ghc-9.2.4 (haven't tried the HEAD). Maybe third time is the charm. Considering that all of them where discovered on totally different projects, I am feeling pretty lucky.
Here are the prior bugs, in case that they are in fact related:
* #17151
* #13429
A specific relation of type families and type classes causes GHC to generate code that will either:
* crash with `<<loop>>` or actually never terminate when compiled with optimizations
* die with OOM (Out Of Memory) when compiled with `-O0`
## Steps to reproduce
Compile this snippet and run it:
```haskell
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Main (main) where
import Data.Kind
newtype Decoder a = Decoder (String -> a)
class Monoid (Share a) => From a where
type Share a :: Type
decoderWithShare :: Share a -> Decoder a
decode :: From a => String -> a
decode str =
case decoderWithShare mempty of
Decoder f -> f str
class (Ord (Currency e), From (Tx e)) => Ledger e where
--class Ord (Currency e) => Ledger e where
type Currency e :: Type
type Tx e :: Type
data MyLedger c
newtype MyTx c = MyTx
{ currency :: c
} deriving (Show, Read)
instance (Read c, Ord c) => Ledger (MyLedger c) where
type Currency (MyLedger c) = c
type Tx (MyLedger c) = MyTx c
instance (Read c, Ledger (MyLedger c)) => From (MyTx c) where
type Share (MyTx c) = [c]
decoderWithShare s =
Decoder $ \str ->
let c = read str
in MyTx $ if elem c s then c else c
main :: IO ()
main = print (decode (show (currency (MyTx "USD"))) :: MyTx String)
```
When compiled with optimizations it results in `<<loop>>`
```
$ ghc loop.hs -fforce-recomp -O && ./loop
[1 of 1] Compiling Main ( loop.hs, loop.o )
Linking loop ...
loop: <<loop>>
```
while without optimizations will not terminate and crash the process with OOM:
```
$ ghc loop.hs -fforce-recomp && ./loop
[1 of 1] Compiling Main ( loop.hs, loop.o )
Linking loop ...
^C
```
I'd also like to note a few points:
* This is the minimal example I could come up with, the original is way too complex to be included
* Type families do not have to be associated
* In the codebase where the bug was discovered:
* It actually goes into infinite loop, i.e. no `<<loop>>` detection.
* It was necessary for the constraint to be present as well for the bug to trigger: `Share (Tx e) ~ [Currency e]`:
```
class (Ord (Currency e), From (Tx e), Share (Tx e) ~ [Currency e]) => Ledger e where
```
## Expected behavior
Regardless of ghc flags the expected output should be:
```
$ ghc loop.hs -fforce-recomp -O && ./loop
[1 of 1] Compiling Main ( loop.hs, loop.o )
Linking loop ...
MyTx {currency = "USD"}
```
Which can be observed when commented out line is used instead of the one that triggers the bug:
```
-class (Ord (Currency e), From (Tx e)) => Ledger e where
+class Ord (Currency e) => Ledger e where
```
Above adjustment will cause the bug to disappear. Other minor changes can have the same affect, so this bug is a bit sensitive.
At a quick glance this seems to be the part of Core that is the offender here: https://github.com/lehins/bugs/blob/master/haskell/ghc-infinite-loop/minimal/loop-O1.dump-simpl#L100-L132 Although I am pretty far from being a Core expert, so I might be totally wrong.
## Environment
* GHC version used: 8.10.7, 9.0.2 and 9.2.4
Optional:
* Operating System: NixOS and OpenSUSE
* System Architecture: x86_649.4.3Andreas KlebingerAndreas Klebingerhttps://gitlab.haskell.org/ghc/ghc/-/issues/21968Regression of T124332022-08-09T19:21:42ZBenjamin MaurerRegression of T12433While trying to find a bug in my branch, I found that there seems to be a regression of test case T12433 (#12433):
Expected output of T12433: `8`
Compiling with GHC 9.2.2, using _no optimizations_ or _any opt. level_ works:
e.g.: `ghc -...While trying to find a bug in my branch, I found that there seems to be a regression of test case T12433 (#12433):
Expected output of T12433: `8`
Compiling with GHC 9.2.2, using _no optimizations_ or _any opt. level_ works:
e.g.: `ghc -O1 testsuite/tests/codeGen/should_run/T12433.hs && ./T12433` prints 8
Using GHC main HEAD (eb425eef418), flavour devel2:
`/path/ghcmain/ghc/_build/stage1/bin/ghc T12433.hs && ./T12433` -- prints 8 **works**
Using **any optimization level** fails:
`/path/ghcmain/ghc/_build/stage1/bin/ghc -O1 T12433.hs && ./T12433` -- prints 4229782
* Operating System: Ubuntu 20.04
* System Architecture: x86_64
#### Compiled with GHC 9.2.2:
[T12433.ghc922-noopt.cmm](/uploads/b275f417c01c26bdf8f4c9ab24294fca/T12433.ghc922-noopt.cmm)
[T12433.ghc922-opt.cmm](/uploads/c8c79dc6ddf798ae084e9629fbf68f3a/T12433.ghc922-opt.cmm)
#### Compiled with HEAD:
[T12433.noopt.cmm](/uploads/8038be665d896ccde009612c261ae02c/T12433.noopt.cmm)
[T12433.opt.cmm](/uploads/54b3d1678e2d407e64a3b99f76b9f640/T12433.opt.cmm)9.4.1Ben GamariBen Gamarihttps://gitlab.haskell.org/ghc/ghc/-/issues/21773LLVM backend should sign extend foreign function arguments and results as nec...2022-07-28T10:07:47ZBen GamariLLVM backend should sign extend foreign function arguments and results as necessaryIn https://gitlab.haskell.org/ghc/ghc/-/issues/20735#note_393658 we noticed that when asked to compile:
```c
short int func(short int targetType);
int main() {
func(-2);
return 0;
}
```
`clang` will emit the following IR:
```
define...In https://gitlab.haskell.org/ghc/ghc/-/issues/20735#note_393658 we noticed that when asked to compile:
```c
short int func(short int targetType);
int main() {
func(-2);
return 0;
}
```
`clang` will emit the following IR:
```
define i32 @main() #0 {
%1 = alloca i32, align 4
store i32 0, i32* %1, align 4
%2 = call signext i16 @func(i16 signext -2)
ret i32 0
}
```
Specifically, note the use of the `signext` [parameter attribute](https://llvm.org/docs/LangRef.html#parameter-attributes), which is necessary on platforms like AArch64/Darwin where the caller is responsible for sign extending (see Apple's [ABI documentation](https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms) for details).
We should be emulating this.
This caused #20735 with the LLVM backend.9.2.4Ben GamariBen Gamarihttps://gitlab.haskell.org/ghc/ghc/-/issues/21708Compiled program with GHC9.2.2 often causes "internal error: evacuate: strang...2022-11-07T15:55:40ZJH LeCompiled program with GHC9.2.2 often causes "internal error: evacuate: strange closure type xxx"## Summary
I cannot come up with a good title, so please bear with me with the title.
I've been using XMonad with GHC 9.0.2 fine,
but when I updated it to GHC9.2.2, it often crashes.
It sometimes leave the following message, while somet...## Summary
I cannot come up with a good title, so please bear with me with the title.
I've been using XMonad with GHC 9.0.2 fine,
but when I updated it to GHC9.2.2, it often crashes.
It sometimes leave the following message, while sometimes silently crashes.
```
xmonad-x86_64-linux: internal error: evacuate: strange closure type 0
(GHC version 9.2.2 for x86_64_unknown_linux)
Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug
Aborted (core dumped)
```
(The closure type depends time to time)
Happens with the most bare-bone XMonad instance. I am lost on how to skin it down further.
Reporting this to GHC, since this specifically happens with GHC9.2.2. All previous versions work fine.
Any directions to diagnose which part is causing the issue?
## Steps to reproduce
1. Install XMonad as dynamically linked
2. Run with the default configuration
3. (At least on my end) performing some action leads to a crash from time to time
## Expected behavior
`internal error: evacuate: strange closure type 0` should not happen.
## Environment
* GHC version used: 9.2.2
Optional:
* Operating System: Ubuntu 20.04.4 LTS, 64-bit, Linux
* System Architecture: x86-649.2.4Ben GamariBen Gamarihttps://gitlab.haskell.org/ghc/ghc/-/issues/21624"IntMulMayOfloOp" primop compiles to wrong Aarch64 assembly2022-08-05T14:46:34ZNatsu Kagami"IntMulMayOfloOp" primop compiles to wrong Aarch64 assembly## Summary
The primop `IntMulMayOfloOp` is being translated to a `MUL` instruction followed by a `CSET` (conditional set, with overflow flag) instruction on Aarch64 (see https://gitlab.haskell.org/ghc/ghc/-/blob/master/compiler/GHC/CmmT...## Summary
The primop `IntMulMayOfloOp` is being translated to a `MUL` instruction followed by a `CSET` (conditional set, with overflow flag) instruction on Aarch64 (see https://gitlab.haskell.org/ghc/ghc/-/blob/master/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs#L894).
However, this is not correct: the overflow flag is never set on a `MUL` instruction. According to [A64 documentation](https://developer.arm.com/documentation/100076/0100/A64-Instruction-Set-Reference/Condition-Codes/Condition-flags?lang=en),
> Overflow occurs if the result of a signed add, subtract, or compare is greater than or equal to 2^31, or less than -2^31.
This means that the current primop will most likely return 0 all the time, which is wrong and potentially dangerous.
## Steps to reproduce
The following code always prints 0 in ghc 9.2.2 on Apple M1, but not in ghc 8.10.7 (which uses LLVM backend):
```hs
{-# LANGUAGE MagicHash #-}
module Main where
import GHC.Exts
import Data.Bits
unpack (I# a#) = a#
k :: Int
k = 134534534134534000 -- obviously does not fit in an int32, and so will overflow when squared.
bakaVariable = I# (mulIntMayOflo# (unpack k) (unpack k))
main = do
print bakaVariable
```
## Expected behavior
Should not print 0 at all.
## Environment
* GHC version used: 9.2.2
Optional:
* Operating System: Mac OS Monterey 12.3.1
* System Architecture: Aarch64 (Apple M1 Macbook Air)9.2.4Ben GamariBen Gamarihttps://gitlab.haskell.org/ghc/ghc/-/issues/21465128-bit Callee-saved registers (Windows x64) are not saved and restored corre...2022-05-30T17:12:27ZThomas Dinsdale-Young128-bit Callee-saved registers (Windows x64) are not saved and restored correctly## Summary
The Windows x64 calling convention requires that the 128-bit registers XMM6-XMM15 be [saved (and restored) by the callee](https://docs.microsoft.com/en-us/cpp/build/x64-calling-convention?view=msvc-170#callercallee-saved-regi...## Summary
The Windows x64 calling convention requires that the 128-bit registers XMM6-XMM15 be [saved (and restored) by the callee](https://docs.microsoft.com/en-us/cpp/build/x64-calling-convention?view=msvc-170#callercallee-saved-registers).
`StgRunIsImplementedInAssembler`, which handles this in the runtime, does not correctly save and restore these registers, as it uses `movq` to do so, treating them as 64-bits only.
Consequently, when the registers are restored, the high-order 64-bits are zeroed.
Instead, `movaps` should probably be used, and 16 bytes reserved for each XMM register.
The consequence of this is that FFI calls to Haskell code on Windows may violate the calling convention and lead to undefined behaviour.
## Steps to reproduce
The attached files can be compiled on Windows with `ghc Main.hs reg.c`.
[Main.hs](/uploads/625555a8de865f7114397d3d81823ef6/Main.hs)
[reg.c](/uploads/1646814458605a7f87cde873b7dbd13a/reg.c)
The Haskell main function invokes a C function `test_c`, which uses inline assembly to set a value to the XMM6 register, invoke a Haskell function `helper`, and then read out the resulting value of the XMM6 register, comparing each byte to the expected (original) value.
The output of executing `Main.exe` is:
```
This is the helper function
0: 01 01
1: 02 02
2: 03 03
3: 04 04
4: 05 05
5: 06 06
6: 07 07
7: 08 08
8: 09 00
9: 0a 00
10: 0b 00
11: 0c 00
12: 0d 00
13: 0e 00
14: 0f 00
15: 10 00
Done.
```
This indicates that the lower-order 8 bytes of the register are correctly restored after the call to `helper`, but the high-order 8 bytes are not.
This is consistent with the use of `movq` instead of `movaps` (or `movups`).
## Expected behavior
The expected output is:
```
This is the helper function
0: 01 01
1: 02 02
2: 03 03
3: 04 04
4: 05 05
5: 06 06
6: 07 07
7: 08 08
8: 09 09
9: 0a 0a
10: 0b 0b
11: 0c 0c
12: 0d 0d
13: 0e 0e
14: 0f 0f
15: 10 10
Done.
```
## Environment
* GHC version used: 9.0.2, 8.10.2
Optional:
* Operating System: Windows 8.1
* System Architecture: x86-64Ben GamariBen Gamarihttps://gitlab.haskell.org/ghc/ghc/-/issues/21429Cost centres seem to cause invalid demand analysis results.2022-05-03T09:29:28ZAndreas KlebingerCost centres seem to cause invalid demand analysis results.With the lateCC pass we now add cost centres in some places where we didn't before and this seems to cause issues with demand analysis/core lint.
We simplify this function (taken from after float out)
```
-- RHS size: {terms: 5, types:...With the lateCC pass we now add cost centres in some places where we didn't before and this seems to cause issues with demand analysis/core lint.
We simplify this function (taken from after float out)
```
-- RHS size: {terms: 5, types: 4, coercions: 8, joins: 0/0}
fail_s9my :: (# #) -> IO ExitCode
[LclId, Arity=2, Str=<L><L>b, Cpr=b]
fail_s9my
= (\ _ [Occ=Dead, OS=OneShot]
(eta_B0 :: ghc-prim:GHC.Prim.State# ghc-prim:GHC.Prim.RealWorld) ->
((GHC.Base.failIO @ExitCode lvl_s9mw)
`cast` (ghc-prim:GHC.Types.N:IO[0] <ExitCode>_R
:: IO ExitCode
~R# (ghc-prim:GHC.Prim.State# ghc-prim:GHC.Prim.RealWorld
-> (# ghc-prim:GHC.Prim.State# ghc-prim:GHC.Prim.RealWorld,
ExitCode #))))
eta_B0)
`cast` (Sym (<(# #)>_R
%<'Many>_N ->_R ghc-prim:GHC.Types.N:IO[0] <ExitCode>_R)
:: ((# #)
-> ghc-prim:GHC.Prim.State# ghc-prim:GHC.Prim.RealWorld
-> (# ghc-prim:GHC.Prim.State# ghc-prim:GHC.Prim.RealWorld,
ExitCode #))
~R# ((# #) -> IO ExitCode))
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl_s9mz :: IO ExitCode
[LclId, Str=b, Cpr=b]
lvl_s9mz = scc<bindIO> scc<bindIO> fail_s9my ghc-prim:GHC.Prim.(##)
```
into this one (after one iteration of the simplifier)
```
lvl_s9Jy :: State# RealWorld -> (# State# RealWorld, ExitCode #)
[LclId,
Arity=1,
Str=b,
Cpr=b,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
lvl_s9Jy
= \ (eta_B0 :: State# RealWorld) ->
scc<bindIO>
scc<bindIO>
((failIO @ExitCode (scc<bindIO> scc<bindIO> build @Char lvl_s9mv))
`cast` (N:IO[0] <ExitCode>_R
:: IO ExitCode
~R# (State# RealWorld -> (# State# RealWorld, ExitCode #))))
eta_B0
```
But the later one results in this core lint error:
```
*** Core Linted result of Simplifier:
*** Core Lint errors : in result of Simplifier ***
<no location info>: warning:
idArity 1 exceeds arity imposed by the strictness signature b: lvl_s9Jw
In the RHS of lvl_s9Jw :: State# RealWorld
-> (# State# RealWorld, ExitCode #)
Substitution: [TCvSubst
In scope: InScope {}
Type env: []
Co env: []]
*** Offending Program ***
```
The core issue seems to be that we infer `Str=b` for
```
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl_s9mz :: IO ExitCode
[LclId, Str=b, Cpr=b]
lvl_s9mz = scc<bindIO> scc<bindIO> fail_s9my ghc-prim:GHC.Prim.(##)
```
If we expand IO/unwrap the IO newtype this function is of type:
`State# RealWorld -> (# State# RealWorld, ExitCode #)` so I don't think this should get a Str of `b` as we have to provide the RealWorld argument for it to bottom out.
I assume the cost centre annotations on the RHS somehow interfere with demand analysis in this case.
@sgraf812 Maybe you have an idea?Andreas KlebingerAndreas Klebingerhttps://gitlab.haskell.org/ghc/ghc/-/issues/21415`mkTick` can cause core lint errors by separating functions from type arguments.2022-12-05T11:53:06ZAndreas Klebinger`mkTick` can cause core lint errors by separating functions from type arguments.We start with
```
reallyUnsafePtrEquality
= \ (@a_akM) ->
(reallyUnsafePtrEquality#) @'Lifted @'Lifted @a_akM @a_akM
```
We call `mkTick scc e` on the expression `(reallyUnsafePtrEquality#) @'Lifted @'Lifted @a_akM @a_akM`
...We start with
```
reallyUnsafePtrEquality
= \ (@a_akM) ->
(reallyUnsafePtrEquality#) @'Lifted @'Lifted @a_akM @a_akM
```
We call `mkTick scc e` on the expression `(reallyUnsafePtrEquality#) @'Lifted @'Lifted @a_akM @a_akM`
This floats the scc tick in between the type applications giving us this lint error/result:
```
*** Core Lint errors : in result of Add late core cost-centres ***
libraries/ghc-prim/GHC/Prim/PtrEq.hs:71:1: warning:
Cannot eta expand ‘reallyUnsafePtrEquality#’
The following types do not have a fixed runtime representation:
• a_11 :: TYPE ('BoxedRep l_1c)
• b_12 :: TYPE ('BoxedRep k_1b)
In the RHS of reallyUnsafePtrEquality :: forall a. a -> a -> Int#
In the body of lambda with binder a_akM :: *
Substitution: [TCvSubst
In scope: InScope {a_akM}
Type env: [akM :-> a_akM]
Co env: []]
*** Offending Program ***
reallyUnsafePtrEquality :: forall a. a -> a -> Int#
[LclIdX,
Arity=2,
Str=<L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
reallyUnsafePtrEquality
= \ (@a_akM) ->
(src<libraries/ghc-prim/GHC/Prim/PtrEq.hs:72:1-50>
tick<reallyUnsafePtrEquality> reallyUnsafePtrEquality#)
@'Lifted @'Lifted @a_akM @a_akM
```
I think the program *might* be fine in the end. So it's not clear to me if mkTick should be changed or how we lint such expressions.Andreas KlebingerAndreas Klebingerhttps://gitlab.haskell.org/ghc/ghc/-/issues/21336File flush failures during program deinitialization aren't indicated2024-03-21T17:37:33ZBrandon S. Allberyallbery.b@gmail.comFile flush failures during program deinitialization aren't indicated## Summary
If a flush/close of a `Handle` fails during RTS deinitialization, there is no indication of a failure. Even if `stderr` has already been closed, at minimum the exit status can be set to indicate a failure.
## Steps to reprod...## Summary
If a flush/close of a `Handle` fails during RTS deinitialization, there is no indication of a failure. Even if `stderr` has already been closed, at minimum the exit status can be set to indicate a failure.
## Steps to reproduce
The program
```
main = putStrLn "Hello, world!"
```
invoked as
```
./hello >/dev/full
```
will correctly report
```
<stdout>: commitBuffer: resource exhausted (No space left on device)
```
if run from `ghci` or `runghc`, which default `stdout` to `LineBuffering`. In a compiled program, `stdout` is set to `BlockBuffering Nothing` and the final `hFlush` is done by the RTS at a time when no exceptions can be thrown and `stderr` may already be closed, so nothing is reported and the program exits with status 0 (no error).
I suspect the same thing may happen with a `Handle` that is garbage collected, since it may be unsafe to throw an exception at that point.
## Expected behavior
Preferably report the same exception as with `ghci` or `runghc`, but at minimum report a non-zero exit status.
## Environment
* GHC version used: 8.10.7 and 9.2.1
Optional:
* Operating System: Linux (Ubuntu 20.04)
* System Architecture: x86_64https://gitlab.haskell.org/ghc/ghc/-/issues/21279Plugin installed hooks are largely ignored2023-05-05T23:14:27ZAaron AllenPlugin installed hooks are largely ignored## Summary
If a compiler plugin installs hooks, for example on compiler phases or the logger action, they do not get called as expected. This bug was introduced in GHC v9.2 in interactive mode but also occurs for make mode in other vers...## Summary
If a compiler plugin installs hooks, for example on compiler phases or the logger action, they do not get called as expected. This bug was introduced in GHC v9.2 in interactive mode but also occurs for make mode in other versions (not sure when the bug was introduced in make mode but it is present as early as 8.10.7).
## Steps to reproduce
Write a plugin that modifies the Logger:
```haskell
plugin :: Plugin
plugin = defaultPlugin
{ driverPlugin = \_ hscEnv -> do
pure hscEnv
{ hsc_logger =
pushLogHook logHook $ hsc_logger hscEnv
}
}
logHook :: LogAction -> LogAction
logHook action dynFlags warnReason sev srcSpan msgDoc =
trace "Log hook called" $! action dynFlags warnReason sev srcSpan msgDoc
```
When compiling with this plugin, the log hook is invoked for warning messages but not error messages.
For the interactive mode case, I have determined that this occurs because when the plugins are first initialized (in `setInteractiveDynFlags`), the loaded plugins are placed in the interactive context but do not end up in the `HscEnv`. This results in the plugins not being present at key points surrounding the loading of modules. The fix for this seems simple enough:
`setInteractiveDynFlags` in `compiler/GHC.hs`:
```haskell
-- Update both plugins cache and DynFlags in the interactive context.
return $ plugin_env -- use plugin_env here instead of hsc_env0
{ hsc_IC = ic0
{ ic_plugins = hsc_plugins plugin_env
, ic_dflags = hsc_dflags plugin_env
}
}
```
GHC 9.0.x does not discard the loaded plugins in this way and the bug seems to have been a side effect of moving the loaded plugins from `DynFlags` to `HscEnv`.
Similarly for phase hooks, the hook is not called at all in GHCi (and only for certain phases in make mode). I suspect the cause is the same as in the logger hook example.
I have not yet investigated why this happens for compilation in make mode (my current focus is plugins intended to be used with GHCi) but I suspect it's because plugins are simply not being initialized early enough.
## Expected behavior
The log hook should be invoked for all messages. Phase hooks should be called for all phases.
## Environment
* GHC version used: 9.2.x, head9.6.1Matthew PickeringMatthew Pickeringhttps://gitlab.haskell.org/ghc/ghc/-/issues/21251Compact regions with sharing can lose pointer tags.2022-03-20T03:26:06ZAndreas KlebingerCompact regions with sharing can lose pointer tags.This caused https://gitlab.haskell.org/ghc/ghc/-/issues/21189
This issue is as follows. We create a compact region with some values.
We add a constructor with strict fields, where the fields reference values *already* in the compact re...This caused https://gitlab.haskell.org/ghc/ghc/-/issues/21189
This issue is as follows. We create a compact region with some values.
We add a constructor with strict fields, where the fields reference values *already* in the compact region.
This (eventually) results in a call to `stg_compactAddWorkerzh` in order to compact the closures the constructor fields point to, with this particular snippet being executed.
```
// Everything else we should copy and evaluate the components:
case
CONSTR,
CONSTR_1_0,
CONSTR_2_0,
CONSTR_1_1: {
(should) = ccall shouldCompact(compact "ptr", p "ptr");
if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = p; return(); }
```
pp is the address to store the result in. `p` is the *untagged* pointer. The fix is simple. Use `tag | p` instead of `p` (as this code already does in other places!).
I will put up a patch shortly.
This caused https://gitlab.haskell.org/ghc/ghc/-/issues/211899.4.1https://gitlab.haskell.org/ghc/ghc/-/issues/21229Inlining DFuns leads to an unsound interaction with Specialise2023-09-13T12:07:03ZSebastian GrafInlining DFuns leads to an unsound interaction with Specialise!7599 unveiled a bug in the Specialiser.
* See also #21328
* Test is in `simplCore/should_run/T21229`
Back to the Specialiser. Consider
```hs
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowA...!7599 unveiled a bug in the Specialiser.
* See also #21328
* Test is in `simplCore/should_run/T21229`
Back to the Specialiser. Consider
```hs
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
data B = T | F deriving Show
class Sing (b :: B) where sing :: B
instance Sing 'T where sing = T
instance Sing 'F where sing = F
f :: forall a. Sing a => Int -> (Int -> B -> B) -> B
f 0 g = g 0 (sing @a)
f n g = f @a (n-1) g
h :: forall a. Sing a => Int -> (Int -> B -> B) -> B
h = case sing @a of
T -> f @'T
F -> f @a
{-# NOINLINE h #-}
main = print $ h @'T 0 (\ _ a -> a)
```
With -O0, this prints `T`, as expected, because `h` will ultimately call its supplied argument once with `T`.
But with -O, I get `F`. Why is that? The reason is we ultimately get the following specialisation for the second call to `f`:
```
RULES: "SPEC f @a"
forall (@(a_aXu :: B)) ($dSing_s1OW :: Sing a_aXu).
f @a_aXu $dSing_s1OW
= $sf_s1OX @a_aXu]
```
and this specialisation (for when `$dSing_s1OW` is `F`) somehow also applies at `f @'T`.
FTR, here is the output of the `pprTrace "spec_call"` in Specialise:
```
spec_call
call info: CI{SpecType a_aXu
SpecDict F `cast` (Sym (N:Sing[0] <a_aXu>_N) :: B ~R# Sing a_aXu)}
useful: True
rule_bndrs: [a_aXu, $dSing_s1OW]
lhs_args: [TYPE: a_aXu, $dSing_s1OW]
spec_bndrs: [a_aXu]
spec_args: [TYPE: a_aXu,
F `cast` (Sym (N:Sing[0] <a_aXu>_N) :: B ~R# Sing a_aXu)]
dx_binds: []
rhs_env2: <InScope = {main g_aC8 a_aXu $cshowsPrec_aY5 $cshow_aYd
$cshowList_aYl $krep_aZ1 $krep_aZ2 $krep_aZ3 $krep_aZ4 $krep_aZ5
$krep_aZ6 ds_dZX main $fShowB $fSingF F $fSingT $tc'C:Sing
$trModule $tc'F $tc'T $tcB $tcSing f h main_s19F main_s19G
main_s1OF $trModule_s1OG $trModule_s1OH $trModule_s1OI
$trModule_s1OJ $krep_s1OK $tcB_s1OL $tcB_s1OM $tc'T_s1ON $tc'T_s1OO
$tc'F_s1OP $tc'F_s1OQ $tcSing_s1OR $tcSing_s1OS $krep_s1OT
$tc'C:Sing_s1OU $tc'C:Sing_s1OV}
IdSubst = [aKV :-> F
`cast` (Sym (N:Sing[0] <a_aXu>_N) :: B ~R# Sing a_aXu)]
TvSubst = [aKU :-> a_aXu]
CvSubst = []>
[]
```
How did it come to this?! For that we have to look at the Core of `h` that Specialise sees:
```
h = \ (@(a_aWY :: B))
($dSing_aWZ :: Sing a_aWY)
(eta_B0 :: Int)
(eta_B1 :: Int -> B -> B) ->
case $dSing_aWZ
`cast` (Main.N:Sing[0] <a_aWY>_N :: Sing a_aWY ~R# B)
of {
T ->
f @'T
(Main.T `cast` (Sym (Main.N:Sing[0] <'T>_N) :: B ~R# Sing 'T))
eta_B0
eta_B1;
F ->
f @a_aWY
(Main.F
`cast` (Sym (Main.N:Sing[0] <a_aWY>_N) :: B ~R# Sing a_aWY))
eta_B0
eta_B1
}
```
Note the second call to `f`. The type argument `a_aWY` is passed, as well as `Main.F` as the dictionary. That's strange! We should know *statically* that `a_aWY` must be `F`. (In fact, ``Main.F `cast` (Sym (Main.N:Sing[0] <a_aWY>_N) :: B ~R# Sing a_aWY)`` is unsound if `a_aWY` is instantiated to `T`, which would perhaps happen if we floated that expression out of the `F` case. I guess it doesn't matter much, at least not to this ticket.)
How did we get this code? After desugaring, we still have
```
h = \ (@(a_aXu :: B)) ($dSing_aXv :: Sing a_aXu) ->
case sing @a_aXu $dSing_aXv of {
T -> f @'T Main.$fSingT;
F -> f @a_aXu $dSing_aXv
}
```
But then gentle simplification inlines `sing` and sees that `$dSing_aXv` is `F` in the `F` case, performs a binder swap and successively inlines `F` (at least that's what I believe the Simplifier does).
Then the Specialiser can't connect `F` to the arguments `$dSing_aXv` or the type arg `a` and somehow bogs up. I suspect this happens in `specHeader`, but actually I'm not completely sure.
I couldn't reproduce with GHC 9.2 and any prior release. I see that we get the same Core pre-Specialise, but it is handled soundly there and we only get a specialisation for `T`. So perhaps we want to fix this before 9.4.9.4.1