From be3c0d62c73361b8805a51a88770991c3b6f9331 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Mon, 8 Feb 2021 22:46:32 +0000 Subject: Fix a serious bug in roughMatchTcs The roughMatchTcs function enables a quick definitely-no-match test in lookupInstEnv. Unfortunately, it didn't account for type families. This didn't matter when type families were flattened away, but now they aren't flattened it matters a lot. The fix is very easy. See INVARIANT in GHC.Core.InstEnv Note [ClsInst laziness and the rough-match fields] Fixes #19336 The change makes compiler perf worse on two very-type-family-heavy benchmarks, T9872{a,d}: T9872a(normal) ghc/alloc 2172536442.7 2216337648.0 +2.0% T9872d(normal) ghc/alloc 614584024.0 621081384.0 +1.1% (Everything else is 0.0% or at most 0.1%.) I think we just have to put up with this. Some cases were being wrongly filtered out by roughMatchTcs that might actually match, which could lead to false apartness checks. And it only affects these very type-family-heavy cases. Metric Increase: T9872a T9872d --- .../tests/indexed-types/should_compile/T19336.hs | 43 ++++++++++++++++++++++ .../indexed-types/should_compile/T19336.stderr | 4 ++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 48 insertions(+) create mode 100644 testsuite/tests/indexed-types/should_compile/T19336.hs create mode 100644 testsuite/tests/indexed-types/should_compile/T19336.stderr (limited to 'testsuite/tests/indexed-types') diff --git a/testsuite/tests/indexed-types/should_compile/T19336.hs b/testsuite/tests/indexed-types/should_compile/T19336.hs new file mode 100644 index 0000000000..dfc7409fa3 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T19336.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances + , DataKinds, NoMonomorphismRestriction, UndecidableInstances + , TypeFamilies #-} + +{-# OPTIONS_GHC -Wall #-} + +module T19336 where + +import GHC.TypeLits + +class X a b where + convert :: a -> b + +instance X Int String where + convert = show + +instance X String String where + convert = id + +instance {-# OVERLAPPABLE #-} TypeError ('Text "Oops") => X a b where + convert = error "unreachable" + +type family F a where + F String = String + F Int = String + +convert_f :: X a (F a) => a -> a -> F a +convert_f _ = convert + +---------- + +class Poly a where + poly :: a + +instance Poly String where + poly = "hi" + +instance Poly Int where + poly = 2 + +---------- + +oops = convert_f poly diff --git a/testsuite/tests/indexed-types/should_compile/T19336.stderr b/testsuite/tests/indexed-types/should_compile/T19336.stderr new file mode 100644 index 0000000000..f841f79628 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T19336.stderr @@ -0,0 +1,4 @@ + +T19336.hs:43:1: warning: [-Wmissing-signatures (in -Wall)] + Top-level binding with no type signature: + oops :: (X a (F a), Poly a) => a -> F a diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 469dd915df..7d8aa9f3ae 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -302,3 +302,4 @@ test('GivenLoop', normal, compile, ['']) test('T18875', normal, compile, ['']) test('T8707', normal, compile, ['-O']) test('T14111', normal, compile, ['-O']) +test('T19336', normal, compile, ['-O']) -- cgit v1.2.1