summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Core/Opt/Specialise.hs34
-rw-r--r--compiler/GHC/Types/Id.hs6
-rw-r--r--testsuite/tests/simplCore/should_compile/T19586.hs14
-rw-r--r--testsuite/tests/simplCore/should_compile/all.T3
4 files changed, 57 insertions, 0 deletions
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index fc62f5fa8a..cab95b8b67 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -809,6 +809,7 @@ canSpecImport dflags fn
tryWarnMissingSpecs :: DynFlags -> [Id] -> Id -> [CallInfo] -> CoreM ()
-- See Note [Warning about missed specialisations]
tryWarnMissingSpecs dflags callers fn calls_for_fn
+ | isClassOpId fn = return () -- See Note [Missed specialization for ClassOps]
| wopt Opt_WarnMissedSpecs dflags
&& not (null callers)
&& allCallersInlined = doWarn $ WarningWithFlag Opt_WarnMissedSpecs
@@ -824,7 +825,40 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn
, whenPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn))
, text "Probable fix: add INLINABLE pragma on" <+> quotes (ppr fn) ])
+{- Note [Missed specialisation for ClassOps]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In #19592 I saw a number of missed specialisation warnings
+which were the result of things like:
+
+ case isJumpishInstr @X86.Instr $dInstruction_s7f8 eta3_a78C of { ...
+
+where isJumpishInstr is part of the Instruction class and defined like
+this:
+
+ class Instruction instr where
+ ...
+ isJumpishInstr :: instr -> Bool
+ ...
+isJumpishInstr is a ClassOp which will select the right method
+from within the dictionary via our built in rules. See also
+Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance.
+
+We don't give these unfoldings, and as a result the specialiser
+complains. But usually this doesn't matter. The simplifier will
+apply the rule and we end up with
+
+ case isJumpishInstrImplX86 eta3_a78C of { ...
+
+Since isJumpishInstrImplX86 is defined for a concrete instance (given
+by the dictionary) it is usually already well specialised!
+Theoretically the implementation of a method could still be overloaded
+over a different type class than what it's a method of. But I wasn't able
+to make this go wrong, and SPJ thinks this should be fine as well.
+
+So I decided to remove the warnings for failed specialisations on ClassOps
+alltogether as they do more harm than good.
+-}
{- Note [Do not specialise imported DFuns]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index dbc2bed651..48ec97f6f8 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -66,6 +66,7 @@ module GHC.Types.Id (
isRecordSelector, isNaughtyRecordSelector,
isPatSynRecordSelector,
isDataConRecordSelector,
+ isClassOpId,
isClassOpId_maybe, isDFunId,
isPrimOpId, isPrimOpId_maybe,
isFCallId, isFCallId_maybe,
@@ -458,6 +459,7 @@ isFCallId :: Id -> Bool
isDataConWorkId :: Id -> Bool
isDataConWrapId :: Id -> Bool
isDFunId :: Id -> Bool
+isClassOpId :: Id -> Bool
isClassOpId_maybe :: Id -> Maybe Class
isPrimOpId_maybe :: Id -> Maybe PrimOp
@@ -481,6 +483,10 @@ isNaughtyRecordSelector id = case Var.idDetails id of
RecSelId { sel_naughty = n } -> n
_ -> False
+isClassOpId id = case Var.idDetails id of
+ ClassOpId _ -> True
+ _other -> False
+
isClassOpId_maybe id = case Var.idDetails id of
ClassOpId cls -> Just cls
_other -> Nothing
diff --git a/testsuite/tests/simplCore/should_compile/T19586.hs b/testsuite/tests/simplCore/should_compile/T19586.hs
new file mode 100644
index 0000000000..7cce9f368d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T19586.hs
@@ -0,0 +1,14 @@
+-- Don't warn about specialization failures for class ops.
+
+{-# OPTIONS_GHC -O -Wall-missed-specialisations #-}
+module T19586 where
+
+type MyConstraint a b = (Show a, Enum b, Show b)
+
+foo :: MyConstraint a b => Int -> a -> b -> (String, String)
+foo 0 x y = (show x, show . succ $ y)
+foo n x y = foo (n-1) x y
+
+
+bar :: Int -> Char -> (String, String)
+bar x y = foo x x y
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index dba67fa80b..935c10d6fc 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -352,6 +352,9 @@ test('T19360', only_ways(['optasm']), compile, [''])
# If the test goes wrong we'll get more case expressions in the output
test('T19581', [ grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
+# T19586 should not generate missed specialisation warnings
+test('T19586', normal, compile, [''])
+
test('T19599', normal, compile, ['-O -ddump-rules'])
test('T19599a', normal, compile, ['-O -ddump-rules'])
test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules'])