Commit 1fb4dd32 authored by Iavor S. Diatchki's avatar Iavor S. Diatchki

Add exception for `KnownNat` and `KnownSymbol` in super classes.

The situation is similar to `Typeable`---we can't set the evidence
outside the solver because we have custom solving rules.  This is safe
because the computed super-class instances can't possibly depend
on the new instance.
parent 9654a7cf
......@@ -43,7 +43,8 @@ import Class
import Var
import VarEnv
import VarSet
import PrelNames ( typeableClassName, genericClassNames )
import PrelNames ( typeableClassName, genericClassNames
, knownNatClassName, knownSymbolClassName )
import Bag
import BasicTypes
import DynFlags
......@@ -1065,9 +1066,10 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds fam_envs sc_th
| (sc_co, norm_sc_pred) <- normaliseType fam_envs Nominal sc_pred
-- sc_co :: sc_pred ~ norm_sc_pred
, ClassPred cls tys <- classifyPredType norm_sc_pred
, className cls /= typeableClassName
-- `Typeable` has custom solving rules, which is why we exclude it
-- from the short cut, and fall through to calling the solver.
, not (usesCustomSolver cls)
-- Some classes (e.g., `Typeable`, `KnownNat`) have custom solving
-- rules, which is why we exclude it from the short cut,
-- and fall through to calling the solver.
= do { sc_ev_tm <- emit_sc_cls_pred norm_sc_pred cls tys
; sc_ev_id <- newEvVar sc_pred
......@@ -1109,6 +1111,18 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds fam_envs sc_th
; traceTc "tcSuperClass 3" (ppr sc_pred $$ ppr sc_ev)
; return (ctEvTerm sc_ev) } }
-- | Do we use a custom solver, which is safe to use when solving super-class
-- constraints.
usesCustomSolver :: Class -> Bool
usesCustomSolver cls = name == typeableClassName
|| name == knownNatClassName
|| name == knownSymbolClassName
where
name = className cls
-------------------
checkInstConstraints :: (EvBindsVar -> TcM result)
-> TcM (Implication, result)
......
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
module TcCustomSolverSuper where
import GHC.TypeLits
import Data.Typeable
{-
When solving super-class instances, GHC solves the evidence without
using the solver (see `tcSuperClasses` in `TcInstDecls`).
However, some classes need to be excepted from this behavior,
as they have custom solving rules, and this test checks that
we got this right.
-}
class (Typeable x, KnownNat x) => C x
class (Typeable x, KnownSymbol x) => D x
instance C 2
instance D "2"
......@@ -449,3 +449,4 @@ test('T10177', normal, compile, [''])
test('T10185', expect_broken(10185), compile, [''])
test('T10195', normal, compile, [''])
test('T10109', normal, compile, [''])
test('TcCustomSolverSuper', normal, compile, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment