Commit 9421b0c7 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Warn about simplifiable class constraints

Provoked by Trac #11948, this patch adds a new warning to GHC

  -Wsimplifiable-class-constraints

It warns if you write a class constraint in a type signature that
can be simplified by an existing instance declaration.  Almost always
this means you should simplify it right now; type inference is very
fragile without it, as #11948 shows.

I've put the warning as on-by-default, but I suppose that if there are
howls of protest we can move it out (as happened for -Wredundant-constraints.

It actually found an example of an over-complicated context in CmmNode.

Quite a few tests use these weird contexts to trigger something else,
so I had to suppress the warning in those.

The 'haskeline' library has a few occurrences of the warning (which
I think should be fixed), so I switched it off for that library in
warnings.mk.

The warning itself is done in TcValidity.check_class_pred.

HOWEVER, when type inference fails we get a type error; and the error
suppresses the (informative) warning.  So as things stand, the warning
only happens when it doesn't cause a problem.  Not sure what to do
about this, but this patch takes us forward, I think.
parent edf54d72
......@@ -42,7 +42,7 @@ module BasicTypes(
TopLevelFlag(..), isTopLevel, isNotTopLevel,
OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
hasOverlappingFlag, hasOverlappableFlag,
hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag,
Boxity(..), isBoxed,
......@@ -492,6 +492,12 @@ setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
setOverlapModeMaybe f Nothing = f
setOverlapModeMaybe f (Just m) = f { overlapMode = m }
hasIncoherentFlag :: OverlapMode -> Bool
hasIncoherentFlag mode =
case mode of
Incoherent _ -> True
_ -> False
hasOverlappableFlag :: OverlapMode -> Bool
hasOverlappableFlag mode =
case mode of
......
......@@ -335,7 +335,7 @@ instance UserOfRegs GlobalReg (CmmNode e x) where
(b -> GlobalReg -> b) -> b -> a -> b
fold f z n = foldRegsUsed dflags f z n
instance (Ord r, UserOfRegs r CmmExpr) => UserOfRegs r ForeignTarget where
instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where
-- The (Ord r) in the context is necessary here
-- See Note [Recursive superclasses] in TcInstDcls
foldRegsUsed _ _ z (PrimTarget _) = z
......
......@@ -607,6 +607,7 @@ data WarningFlag =
| Opt_WarnNonCanonicalMonoidInstances -- since 8.0
| Opt_WarnMissingPatternSynonymSignatures -- since 8.0
| Opt_WarnUnrecognisedWarningFlags -- since 8.0
| Opt_WarnSimplifiableClassConstraints -- Since 8.2
deriving (Eq, Show, Enum)
data Language = Haskell98 | Haskell2010
......@@ -3289,6 +3290,7 @@ wWarningFlagsDeps = [
flagSpec "wrong-do-bind" Opt_WarnWrongDoBind,
flagSpec "missing-pattern-synonym-signatures"
Opt_WarnMissingPatternSynonymSignatures,
flagSpec "simplifiable-class-constraints" Opt_WarnSimplifiableClassConstraints,
flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags ]
-- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
......@@ -3887,7 +3889,8 @@ standardWarnings -- see Note [Documenting warning flags]
Opt_WarnAlternativeLayoutRuleTransitional,
Opt_WarnUnsupportedLlvmVersion,
Opt_WarnTabs,
Opt_WarnUnrecognisedWarningFlags
Opt_WarnUnrecognisedWarningFlags,
Opt_WarnSimplifiableClassConstraints
]
-- | Things you get with -W
......
......@@ -1822,7 +1822,7 @@ if we react R beta [a] with the top-level we get (beta ~ a), which
is solvable and can help us rewrite (Q [beta]) to (Q [a]) which is
now solvable by the given Q [a].
The solution is that:
The partial solution is that:
In matchClassInst (and thus in topReact), we return a matching
instance only when there is no Given in the inerts which is
unifiable to this particular dictionary.
......@@ -1864,6 +1864,19 @@ Other notes:
But for the Given Overlap check our goal is just related to completeness of
constraint solving.
* The solution is only a partial one. Consider the above example with
g :: forall a. Q [a] => [a] -> Int
g x = let v = wob x
in v
and suppose we have -XNoMonoLocalBinds, so that we attempt to find the most
general type for 'v'. When generalising v's type we'll simplify its
Q [alpha] constraint, but we don't have Q [a] in the 'givens', so we
will use the instance declaration after all. Trac #11948 was a case in point
All of this is disgustingly delicate, so to discourage people from writing
simplifiable class givens, we warn about signatures that contain them;#
see TcValidity Note [Simplifiable given constraints].
-}
......
......@@ -527,7 +527,7 @@ data UserTypeCtxt
| ClassSCCtxt Name -- Superclasses of a class
| SigmaCtxt -- Theta part of a normal for-all type
-- f :: <S> => a -> a
| DataTyCtxt Name -- Theta part of a data decl
| DataTyCtxt Name -- The "stupid theta" part of a data decl
-- data <S> => T a = MkT a
{-
......
......@@ -40,7 +40,9 @@ import TyCon
import HsSyn -- HsType
import TcRnMonad -- TcType, amongst others
import TcHsSyn ( checkForRepresentationPolymorphism )
import TcEnv ( tcGetInstEnvs )
import FunDeps
import InstEnv ( ClsInst, lookupInstEnv, isOverlappable )
import FamInstEnv ( isDominatedBy, injectiveBranches,
InjectivityCheckResult(..) )
import FamInst ( makeInjectivityErrors )
......@@ -853,13 +855,15 @@ check_class_pred env dflags ctxt pred cls tys
| otherwise
= do { check_arity
; checkTcM arg_tys_ok (env, predTyVarErr (tidyType env pred)) }
; check_simplifiable_class_constraint
; checkTcM arg_tys_ok (predTyVarErr env pred) }
where
check_arity = checkTc (classArity cls == length tys)
(tyConArityErr (classTyCon cls) tys)
-- Check the arguments of a class constraint
flexible_contexts = xopt LangExt.FlexibleContexts dflags
undecidable_ok = xopt LangExt.UndecidableInstances dflags
arg_tys_ok = case ctxt of
SpecInstCtxt -> True -- {-# SPECIALISE instance Eq (T Int) #-} is fine
InstDeclCtxt -> checkValidClsArgs (flexible_contexts || undecidable_ok) cls tys
......@@ -867,6 +871,40 @@ check_class_pred env dflags ctxt pred cls tys
-- in checkInstTermination
_ -> checkValidClsArgs flexible_contexts cls tys
-- See Note [Simplifiable given constraints]
check_simplifiable_class_constraint
| DataTyCtxt {} <- ctxt -- Don't do this check for the "stupid theta"
= return () -- of a data type declaration
| otherwise
= do { instEnvs <- tcGetInstEnvs
; let (matches, _, _) = lookupInstEnv False instEnvs cls tys
bad_matches = [ inst | (inst,_) <- matches
, not (isOverlappable inst) ]
; warnIf (Reason Opt_WarnSimplifiableClassConstraints)
(not (null bad_matches))
(simplifiable_constraint_warn bad_matches) }
simplifiable_constraint_warn :: [ClsInst] -> SDoc
simplifiable_constraint_warn (match : _)
= vcat [ hang (text "The constraint" <+> quotes (ppr (tidyType env pred)))
2 (text "matches an instance declaration")
, ppr match
, hang (text "This makes type inference very fragile;")
2 (text "try simplifying it using the instance") ]
simplifiable_constraint_warn [] = pprPanic "check_class_pred" (ppr pred)
{- Note [Simplifiable given constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A type signature like
f :: Eq [(a,b)] => a -> b
is very fragile, for reasons described at length in TcInteract
Note [Instance and Given overlap]. So this warning discourages uses
from writing simplifiable class constraints, at least unless the
top-level instance is explicitly declared as OVERLAPPABLE.
Trac #11948 provoked me to do this.
-}
-------------------------
okIPCtxt :: UserTypeCtxt -> Bool
-- See Note [Implicit parameters in instance decls]
......@@ -893,11 +931,6 @@ okIPCtxt (SpecInstCtxt {}) = False
okIPCtxt (RuleSigCtxt {}) = False
okIPCtxt DefaultDeclCtxt = False
badIPPred :: TidyEnv -> PredType -> (TidyEnv, SDoc)
badIPPred env pred
= ( env
, text "Illegal implicit parameter" <+> quotes (ppr_tidy env pred) )
{-
Note [Kind polymorphic type classes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -944,11 +977,17 @@ predSuperClassErr env pred
<+> text "in a superclass context")
2 (parens undecidableMsg) )
predTyVarErr :: PredType -> SDoc -- type is already tidied!
predTyVarErr pred
= vcat [ hang (text "Non type-variable argument")
2 (text "in the constraint:" <+> ppr pred)
, parens (text "Use FlexibleContexts to permit this") ]
predTyVarErr :: TidyEnv -> PredType -> (TidyEnv, SDoc)
predTyVarErr env pred
= (env
, vcat [ hang (text "Non type-variable argument")
2 (text "in the constraint:" <+> ppr_tidy env pred)
, parens (text "Use FlexibleContexts to permit this") ])
badIPPred :: TidyEnv -> PredType -> (TidyEnv, SDoc)
badIPPred env pred
= ( env
, text "Illegal implicit parameter" <+> quotes (ppr_tidy env pred) )
constraintSynErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
constraintSynErr env kind
......
......@@ -22,7 +22,8 @@ module InstEnv (
extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts,
memberInstEnv, instIsVisible,
classInstances, instanceBindFun,
instanceCantMatch, roughMatchTcs
instanceCantMatch, roughMatchTcs,
isOverlappable, isOverlapping, isIncoherent
) where
#include "HsVersions.h"
......@@ -89,6 +90,11 @@ fuzzyClsInstCmp x y =
cmp (Just _, Nothing) = GT
cmp (Just x, Just y) = stableNameCmp x y
isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool
isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i))
isOverlapping i = hasOverlappingFlag (overlapMode (is_flag i))
isIncoherent i = hasIncoherentFlag (overlapMode (is_flag i))
{-
Note [Template tyvars are fresh]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -703,7 +709,7 @@ lookupInstEnv' ie vis_mods cls tys
--------------
find ms us [] = (ms, us)
find ms us (item@(ClsInst { is_tcs = mb_tcs, is_tvs = tpl_tvs
, is_tys = tpl_tys, is_flag = oflag }) : rest)
, is_tys = tpl_tys }) : rest)
| not (instIsVisible vis_mods item)
= find ms us rest -- See Note [Instance lookup and orphan instances]
......@@ -716,7 +722,7 @@ lookupInstEnv' ie vis_mods cls tys
-- Does not match, so next check whether the things unify
-- See Note [Overlapping instances] and Note [Incoherent instances]
| Incoherent _ <- overlapMode oflag
| isIncoherent item
= find ms us rest
| otherwise
......@@ -768,8 +774,8 @@ lookupInstEnv check_overlap_safe
-- If the selected match is incoherent, discard all unifiers
final_unifs = case final_matches of
(m:_) | is_incoherent m -> []
_ -> all_unifs
(m:_) | isIncoherent (fst m) -> []
_ -> all_unifs
-- NOTE [Safe Haskell isSafeOverlap]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -801,40 +807,32 @@ lookupInstEnv check_overlap_safe
lb = isInternalName nb
in (la && lb) || (nameModule na == nameModule nb)
isOverlappable i = hasOverlappableFlag $ overlapMode $ is_flag i
-- We consider the most specific instance unsafe when it both:
-- (1) Comes from a module compiled as `Safe`
-- (2) Is an orphan instance, OR, an instance for a MPTC
unsafeTopInstance inst = isSafeOverlap (is_flag inst) &&
(isOrphan (is_orphan inst) || classArity (is_cls inst) > 1)
---------------
is_incoherent :: InstMatch -> Bool
is_incoherent (inst, _) = case overlapMode (is_flag inst) of
Incoherent _ -> True
_ -> False
---------------
insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch]
-- ^ Add a new solution, knocking out strictly less specific ones
-- See Note [Rules for instance lookup]
insert_overlapping new_item [] = [new_item]
insert_overlapping new_item (old_item : old_items)
insert_overlapping new_item@(new_inst,_) (old_item@(old_inst,_) : old_items)
| new_beats_old -- New strictly overrides old
, not old_beats_new
, new_item `can_override` old_item
, new_inst `can_override` old_inst
= insert_overlapping new_item old_items
| old_beats_new -- Old strictly overrides new
, not new_beats_old
, old_item `can_override` new_item
, old_inst `can_override` new_inst
= old_item : old_items
-- Discard incoherent instances; see Note [Incoherent instances]
| is_incoherent old_item -- Old is incoherent; discard it
| isIncoherent old_inst -- Old is incoherent; discard it
= insert_overlapping new_item old_items
| is_incoherent new_item -- New is incoherent; discard it
| isIncoherent new_inst -- New is incoherent; discard it
= old_item : old_items
-- Equal or incomparable, and neither is incoherent; keep both
......@@ -842,17 +840,16 @@ insert_overlapping new_item (old_item : old_items)
= old_item : insert_overlapping new_item old_items
where
new_beats_old = new_item `more_specific_than` old_item
old_beats_new = old_item `more_specific_than` new_item
new_beats_old = new_inst `more_specific_than` old_inst
old_beats_new = old_inst `more_specific_than` new_inst
-- `instB` can be instantiated to match `instA`
-- or the two are equal
(instA,_) `more_specific_than` (instB,_)
instA `more_specific_than` instB
= isJust (tcMatchTys (is_tys instB) (is_tys instA))
(instA, _) `can_override` (instB, _)
= hasOverlappingFlag (overlapMode (is_flag instA))
|| hasOverlappableFlag (overlapMode (is_flag instB))
instA `can_override` instB
= isOverlapping instA || isOverlappable instB
-- Overlap permitted if either the more specific instance
-- is marked as overlapping, or the more general one is
-- marked as overlappable.
......
......@@ -713,6 +713,28 @@ of ``-W(no-)*``.
second pattern overlaps it. More often than not, redundant patterns
is a programmer mistake/error, so this option is enabled by default.
.. ghc-flag:: -Wsimplifiable-class-constraints
:since: 8.2
.. index::
single: simplifiable class constraints, warning
Warn about class constraints in a type signature that can be simplified
using a top-level instance declaration. For example: ::
f :: Eq [a] => a -> a
Here the ``Eq [a]`` in the signature overlaps with the top-level
instance for ``Eq [a]``. GHC goes to some efforts to use the former,
but if it should use the latter, it would then have an
insoluble ``Eq a`` constraint. Best avoided by instead writing: ::
f :: Eq a => a -> a
This option is on by default. As usual you can suppress it on a
per-module basis with :ghc-flag:`-Wno-simplifiable-class-constraints`.
.. ghc-flag:: -Wtabs
.. index::
......
......@@ -71,6 +71,7 @@ endif
libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-deprecations
libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports
libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints
libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-simplifiable-class-constraints
# temporarily turn off unused-imports warnings for pretty
......
......@@ -8,7 +8,10 @@ Stephanie Weirich, Richard Eisenberg, and Dimitrios Vytiniotis, 2016. -}
ScopedTypeVariables, GADTs, FlexibleInstances,
UndecidableInstances, RebindableSyntax,
DataKinds, MagicHash, AutoDeriveTypeable, TypeInType #-}
{-# OPTIONS_GHC -fno-warn-missing-methods -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-missing-methods -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
-- Because we define a local Typeable class and have
-- instance Data.Typeable.Typeable a => Typeable a
module Dynamic where
......
--Testing GADTs, type families as well as a ton of crazy type stuff
:set -fno-warn-redundant-constraints
:set -Wno-redundant-constraints
:set -Wno-simplifiable-class-constraints
:set -XGADTs
:set -XTypeFamilies
:set -XFunctionalDependencies
......@@ -33,6 +34,7 @@ type instance Or HFalse HTrue = HTrue
type instance Or HFalse HFalse = HFalse
let f :: (Or a c ~ HTrue, TypeEq t A a, TypeEq t C c) => ABorC t -> Int ; f x = 1
-- Weird test case: (TypeEq t C c) and (TypeEq t C c) are both simplifiable
f $ Foo 1
f $ Bar True
f $ Baz 'a'
......
<interactive>:38:1: error:
<interactive>:40:1: error:
• Couldn't match type ‘HFalse’ with ‘HTrue’
arising from a use of ‘f’
• In the expression: f $ Baz 'a'
In an equation for ‘it’: it = f $ Baz 'a'
<interactive>:39:1: error:
<interactive>:41:1: error:
• Couldn't match type ‘HFalse’ with ‘HTrue’
arising from a use of ‘f’
• In the expression: f $ Quz
......
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
FlexibleInstances,
UndecidableInstances #-}
......@@ -17,6 +17,7 @@ instance (Show a, Wuggle b) => Concrete a b where
bar = error "urk"
wib :: Concrete a b => a -> String
-- Weird test case: (Concrete a b) is simplifiable
wib x = bar x
-- Uncommenting this solves the problem:
......
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE TypeFamilies, EmptyDataDecls, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
......@@ -12,7 +12,7 @@ foo :: E [Int] (E Int Int) -> Int
foo = sum . concat
data family F a b
data instance F a a = MkF [a]
data instance F a a = MkF [a]
goo :: F Int Int -> F Bool Bool
goo (MkF xs) = MkF $ map odd xs
......@@ -33,7 +33,9 @@ instance (result ~ True) => Proxy True result
instance (result ~ False) => Proxy notTrue result
testTrue :: EqTyP Int Int r => r
-- Weird test case: (EqTyP Int Int) is simplifiable
testTrue = undefined
testFalse :: EqTyP Int Bool r => r
testFalse = undefined
\ No newline at end of file
-- Weird test case: (EqTyP Int Bool) is simplifiable
testFalse = undefined
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstraintKinds #-}
......@@ -25,6 +26,8 @@ instance ForallF Monoid t => Monoid1 t
class ForallF Monoid1 t => Monoid2 t
instance ForallF Monoid1 t => Monoid2 t
-- In both declarations (Forall Monoid1 t) expands to
-- (Monoid1 (t (SkolemF Monoid1 t))), which is simplifiable
-- Changing f a ~ g a to, (Ord (f a), Ord (g a)), say, removes the error
class (f a ~ g a) => H f g a
......@@ -33,3 +36,5 @@ instance (f a ~ g a) => H f g a
-- This one gives a superclass cycle error.
class Forall (H f g) => H1 f g
instance Forall (H f g) => H1 f g
-- In both declarations (Forall (H f g)) expands to
-- H f g (Skolem (H f g)), which is simplifiable
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE TypeFamilies, FlexibleInstances, UndecidableInstances, FlexibleContexts #-}
class A a
......@@ -8,12 +8,15 @@ instance A a => B a where b = undefined
newtype Y a = Y (a -> ())
okIn701 :: B a => Y a
-- Weird test case: (B a) is simplifiable
okIn701 = wrap $ const () . b
okIn702 :: B a => Y a
-- Weird test case: (B a) is simplifiable
okIn702 = wrap $ b
okInBoth :: B a => Y a
-- Weird test case: (B a) is simplifiable
okInBoth = Y $ const () . b
class Wrapper a where
......@@ -24,6 +27,7 @@ instance Wrapper (Y a) where
wrap = Y
fromTicket3018 :: Eq [a] => a -> ()
-- Weird test case: (Eq [a]) is simplifiable
fromTicket3018 x = let {g :: Int -> Int; g = [x]==[x] `seq` id} in ()
main = undefined
......
......@@ -4,5 +4,9 @@ TYPE CONSTRUCTORS
COERCION AXIOMS
Dependent modules: []
Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,
integer-gmp-1.0.0.0]
integer-gmp-1.0.0.1]
SomethingShowable.hs:5:1: warning: [-Wsimplifiable-class-constraints (in -Wdefault)]
The constraint ‘Show Bool’ matches an instance declaration
This makes type inference very fragile;
try simplifying it using the instance
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE DataKinds, FunctionalDependencies, FlexibleInstances,
UndecidableInstances, PolyKinds, KindSignatures,
ConstraintKinds, FlexibleContexts, GADTs #-}
......@@ -10,8 +10,10 @@ instance a ~ b => Id a b
class Test (x :: a) (y :: a)
instance (Id x y, Id y z) => Test x z
-- Weird test case: (Id x y) and (Id y z) are both simplifiable
test :: Test True True => ()
-- Weird test case: (Test True True) is simplifiable
test = ()
{-# LANGUAGE RankNTypes, GADTs, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE RankNTypes, GADTs, FlexibleContexts #-}
-- This one make SpecConstr generate bogus code (hence -O2),
-- This one make SpecConstr generate bogus code (hence -O2),
-- with a lint error, in GHC 6.4.1
-- C.f. http://ghc.haskell.org/trac/ghc/ticket/737
module ShouldCompile where
data IHandler st where
IHandler :: forall st ev res.
Serialize (TxContext ev) => String -> IO ev
IHandler :: forall st ev res.
Serialize (TxContext ev) => String -> IO ev
-> (res -> IO ()) -> Ev st ev res -> IHandler st
-- Weird test case: (Serialize (TxContext ev)) is simplifiable
data Ev st ev res = Ev
data TxContext evt = TxContext
......
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE RankNTypes, FlexibleContexts, ImplicitParams, TemplateHaskell #-}
-- This test makes sure TH understands types where
......@@ -12,6 +12,7 @@ module T3100 where
import Language.Haskell.TH
flop :: Ord Int => Int -> Int
-- Weird test case: (Ord Int) is simplifiable and redundant
flop x = x
$(do { t <- reify 'flop; return [] })
......
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE FunctionalDependencies, FlexibleContexts #-}
class C a where
class C a where
class D a where
dop :: a -> a
class D a where
dop :: a -> a
instance C a => D [a] where
instance C a => D [a] where
dop = undefined
class J a b | a -> b
where j :: a -> b -> ()
class J a b | a -> b
where j :: a -> b -> ()
instance J Bool Int where
instance J Bool Int where
j = undefined
foo :: D [Int] => ()
-- Weird test case: (D [Int]) is simplifiable
foo = j True (head (dop [undefined]))
main = return ()
......
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, GADTs,
ConstraintKinds, DataKinds, KindSignatures,
FlexibleInstances #-}
{-# OPTIONS -fno-warn-redundant-constraints #-}
module T10195 where
......@@ -16,6 +16,7 @@ class Bar m m'
instance (BarFamily m m' ~ 'True) => Bar m m'
magic :: (Bar m m') => c m zp -> Foo m zp (c m' zq)
-- Wierd test case: (Bar m m') is simplifiable
magic = undefined
getDict :: a -> Dict (Num a)
......@@ -25,6 +26,7 @@ fromScalar = undefined
foo :: (Bar m m')
=> c m zp -> Foo m zp (c m' zq) -> Foo m zp (c m' zq)
-- Wierd test case: (Bar m m') is simplifiable
foo b (Foo sc) =
let scinv = fromScalar sc
in case getDict scinv of
......
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE UndecidableInstances, MultiParamTypeClasses,
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE UndecidableInstances, MultiParamTypeClasses,
FunctionalDependencies, FlexibleInstances #-}
module T3108 where
......@@ -29,6 +29,7 @@ class C1 x
instance {-# OVERLAPPING #-} (C1 x, C1 y) => C1 (x,y)
instance {-# OVERLAPPING #-} C1 Bool
instance {-# OVERLAPPABLE #-} (C2 x y, C1 (y,Bool)) => C1 x
-- Wierd test case: (C1 (y,Bool)) is simplifiable
class C2 x y | x -> y
instance C2 Int Int
......
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE FlexibleContexts #-}