Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 234bab08 by Vladislav Zavialov at 2026-09-29T17:22:54-04:00 Add regression test for #7803 Commit 2effe18ab5, first shipped with GHC 8.2.1, fixed #7803 "Superclass methods are left unspecialized". This change turns the example from the ticket description into a regression test, checking that foo1 is fully specialised at Double, with no calls to the overloaded exp5Tail. Closes #7803 Assisted-by: Claude Opus 5 - - - - - 4 changed files: - + testsuite/tests/simplCore/should_compile/T7803.hs - + testsuite/tests/simplCore/should_compile/T7803.stderr - + testsuite/tests/simplCore/should_compile/T7803a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== testsuite/tests/simplCore/should_compile/T7803.hs ===================================== @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -ddump-simpl #-} + +-- #7803: foo1 should be fully specialised at Double. In the bug report +-- it ended up calling the overloaded exp5Tail (with a dictionary argument), +-- because the specialiser ran before the overloaded call was floated to +-- the top level. So the dumped Core for this module must mention no +-- exp5Tail at all. +module T7803 (foo1) where + +import T7803a + +bar :: Floating a => a -> a -> a +bar z = subtract (evaluate integ z) . evaluate integ + where + integ = indefinite (Piecewise [Poly4 1]) +{-# SPECIALIZE bar :: Double -> Double -> Double #-} + +foo :: Floating a => a -> a -> a +foo x = bar x +{-# SPECIALIZE foo :: Double -> Double -> Double #-} + +foo1 :: Double -> Double -> Double +foo1 x = foo x ===================================== testsuite/tests/simplCore/should_compile/T7803.stderr ===================================== @@ -0,0 +1 @@ +foo1 ===================================== testsuite/tests/simplCore/should_compile/T7803a.hs ===================================== @@ -0,0 +1,73 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T7803a + ( Evaluate (..) + , HasIntegral (..) + , Poly4 (..) + , Domain + , IntOfLogPoly4 (..) + , Piecewise (..) + ) where + +import Data.Kind (Constraint, Type) + +class Evaluate poly where + evaluate :: (Domain' poly a) => poly a -> a -> a + +class Evaluate (IntegralOf poly) => HasIntegral poly where + type IntegralOf poly :: Type -> Type + indefinite :: (Domain' poly a, Domain' (IntegralOf poly) a) + => poly a -> IntegralOf poly a + +type family Domain (f :: Type -> Type) a :: Constraint + +class Domain f a => Domain' f a +instance Domain f a => Domain' f a + +newtype Poly4 a = Poly4 { poly4_a :: a } + +type instance Domain Poly4 a = Fractional a + +data IntOfLogPoly4 a = IntOfLogPoly4 { ilp4_k :: !a, ilp4_u :: !a } + +type instance Domain IntOfLogPoly4 a = Floating a + +instance Evaluate IntOfLogPoly4 where + evaluate (IntOfLogPoly4 k _) x = k + x * exp5Tail (- log x) + {-# INLINE evaluate #-} + +{-# RULES "exp5Tail/Double" exp5Tail = exp5TailDouble #-} +{-# NOINLINE exp5Tail #-} + +exp5Tail :: (Floating a) => a -> a +exp5Tail x = x / 120 + +exp5TailDouble :: Double -> Double +exp5TailDouble x = x / 120 + +instance HasIntegral Poly4 where + type IntegralOf Poly4 = IntOfLogPoly4 + indefinite = \ (Poly4 a) -> IntOfLogPoly4 0 a + {-# INLINE indefinite #-} + +newtype Piecewise poly a = Piecewise { unPiecewise :: [poly a] } + +type instance Domain (Piecewise poly) a = (Domain poly a, Num a) + +instance (Evaluate poly) => Evaluate (Piecewise poly) where + evaluate = \ (Piecewise pp) x -> + case pp of + p : _ -> evaluate p x + [] -> error "evaluate: empty Piecewise" + {-# INLINE evaluate #-} + +instance (HasIntegral poly) => HasIntegral (Piecewise poly) where + type IntegralOf (Piecewise poly) = Piecewise (IntegralOf poly) + indefinite (Piecewise m) = Piecewise $ map indefinite m + {-# INLINE indefinite #-} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -148,6 +148,13 @@ test('T7785', [ only_ways(['optasm']), grep_errmsg(r'SPEC') ], compile, ['-ddump-cse']) +# T7803: we expect NO calls to the overloaded 'exp5Tail' in T7803.hs +# In the bug report #7803, the unspecialised call was signalled by 'exp5Tail' +# in foo1's Core, so we grep for that; also for 'foo1', lest we dump nothing +# One module, T7803.hs, has OPTIONS_GHC -ddump-simpl +test('T7803', [ grep_errmsg(r'exp5Tail|foo1') ], + multimod_compile, ['T7803', '-O2 -v0 -dsuppress-all -dsuppress-uniques -dno-typeable-binds']) + test('T7702', [extra_files(['T7702plugin']), pre_cmd('$MAKE -s --no-print-directory -C T7702plugin package.T7702 TOP={top}'), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/234bab081682018da7d04b22eee4b80f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/234bab081682018da7d04b22eee4b80f... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help