Abstract over the right free varswip/T22459

Fix #22459, in two ways:

(1) Make the Specialiser not create a bogus specialisation if
    it is presented by strangely polymorphic dictionary.
    See Note [Weird special case in SpecDict] in
    GHC.Core.Opt.Specialise

(2) Be more careful in abstractFloats
    See Note [Which type variables to abstract over]
    in GHC.Core.Opt.Simplify.Utils.

So (2) stops creating the excessively polymorphic dictionary in
abstractFloats, while (1) stops crashing if some other pass should
nevertheless create a weirdly polymorphic dictionary.

2 files changed, 24 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T22459.hs b/testsuite/tests/simplCore/should_compile/T22459.hs
new file mode 100644
index 0000000000..be28c5e2c0
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22459.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+{-# OPTIONS_GHC -O #-}
+
+module Lib (foo) where
+
+import qualified Data.Map as M
+
+newtype Fix f = Fix (f (Fix f))
+
+instance Eq (f (Fix f)) => Eq (Fix f) where
+  Fix a == Fix b = a == b
+
+instance Ord (f (Fix f)) => Ord (Fix f) where
+  Fix a `compare` Fix b = a `compare` b
+
+data Foo i r = Foo i r
+  deriving (Eq, Ord)
+
+newtype Bar a = Bar (M.Map Char (M.Map (Fix (Foo ())) Word))
+
+foo :: Bar a -> Bar a -> Bar a
+foo (Bar a) (Bar b) = Bar (M.unionWith M.union a b)
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 5209c0c7cb..df60aa1c4f 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -458,3 +458,4 @@ test('T22494', [grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-un
 test('T22491', normal, compile, ['-O2'])
 test('T21476', normal, compile, [''])
 test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings -fno-omit-interface-pragmas -fno-ignore-interface-pragmas'])
+test('T22459', normal, compile, [''])