Commit 9308c736 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix a number of subtle solver bugs

As a result of some other unrelated changes I found that
IndTypesPerf was failing, and opened Trac #11408.  There's
a test in indexed-types/should-compile/T11408.

The bug was that a type like
 forall t. (MT (UL t) (UR t) ~ t) => UL t -> UR t -> Int
is in fact unambiguous, but it's a bit subtle to prove
that it is unambiguous.

In investigating, Dimitrios and I found several subtle
bugs in the constraint solver, fixed by this patch

* canRewrite was missing a Derived/Derived case.  This was
  lost by accident in Richard's big kind-equality patch.

* Interact.interactTyVarEq would discard [D] a ~ ty if there
  was a [W] a ~ ty in the inert set.  But that is wrong because
  the former can rewrite things that the latter cannot.
  Fix: a new function eqCanDischarge

* In TcSMonad.addInertEq, the process was outright wrong for
  a Given/Wanted in the (GWModel) case.  We were adding a new
  Derived without kicking out things that it could rewrite.
  Now the code is simpler (no special GWModel case), and works
  correctly.

* The special case in kickOutRewritable for [W] fsk ~ ty,
  turns out not to be needed.  (We emit a [D] fsk ~ ty which
  will do the job.

I improved comments and documentation, esp in TcSMonad.
parent 3a1babd6
...@@ -1453,9 +1453,9 @@ canEqTyVarTyVar ev eq_rel swapped tv1 tv2 kco2 ...@@ -1453,9 +1453,9 @@ canEqTyVarTyVar ev eq_rel swapped tv1 tv2 kco2
-- the floating step looks for meta tyvars on the left -- the floating step looks for meta tyvars on the left
| isMetaTyVar tv2 = True | isMetaTyVar tv2 = True
-- So neither is a meta tyvar -- So neither is a meta tyvar (including FlatMetaTv)
-- If only one is a flatten tyvar, put it on the left -- If only one is a flatten skolem, put it on the left
-- See Note [Eliminate flat-skols] -- See Note [Eliminate flat-skols]
| not (isFlattenTyVar tv1), isFlattenTyVar tv2 = True | not (isFlattenTyVar tv1), isFlattenTyVar tv2 = True
......
...@@ -242,7 +242,7 @@ BUT this works badly for Trac #10340: ...@@ -242,7 +242,7 @@ BUT this works badly for Trac #10340:
For 'foo' we instantiate 'get' at types mm ss For 'foo' we instantiate 'get' at types mm ss
[W] MonadState ss mm, [W] mm ss ~ State Any Any [W] MonadState ss mm, [W] mm ss ~ State Any Any
Flatten, and decompose Flatten, and decompose
[W] MnadState ss mm, [W] Any ~ fmv, [W] mm ~ State fmv, [W] fmv ~ ss [W] MonadState ss mm, [W] Any ~ fmv, [W] mm ~ State fmv, [W] fmv ~ ss
Unify mm := State fmv: Unify mm := State fmv:
[W] MonadState ss (State fmv), [W] Any ~ fmv, [W] fmv ~ ss [W] MonadState ss (State fmv), [W] Any ~ fmv, [W] fmv ~ ss
If we orient with (untouchable) fmv on the left we are now stuck: If we orient with (untouchable) fmv on the left we are now stuck:
...@@ -1147,7 +1147,7 @@ flatten_exact_fam_app_fully tc tys ...@@ -1147,7 +1147,7 @@ flatten_exact_fam_app_fully tc tys
; fr <- getFlavourRole ; fr <- getFlavourRole
; case mb_ct of ; case mb_ct of
Just (co, rhs_ty, flav) -- co :: F xis ~ fsk Just (co, rhs_ty, flav) -- co :: F xis ~ fsk
| (flav, NomEq) `canDischargeFR` fr | (flav, NomEq) `funEqCanDischargeFR` fr
-> -- Usable hit in the flat-cache -> -- Usable hit in the flat-cache
-- We certainly *can* use a Wanted for a Wanted -- We certainly *can* use a Wanted for a Wanted
do { traceFlat "flatten/flat-cache hit" $ (ppr tc <+> ppr xis $$ ppr rhs_ty) do { traceFlat "flatten/flat-cache hit" $ (ppr tc <+> ppr xis $$ ppr rhs_ty)
......
...@@ -506,7 +506,7 @@ solveOneFromTheOther :: CtEvidence -- Inert ...@@ -506,7 +506,7 @@ solveOneFromTheOther :: CtEvidence -- Inert
-> TcS (InteractResult, StopNowFlag) -> TcS (InteractResult, StopNowFlag)
-- Preconditions: -- Preconditions:
-- 1) inert and work item represent evidence for the /same/ predicate -- 1) inert and work item represent evidence for the /same/ predicate
-- 2) ip/class/irred evidence (no coercions) only -- 2) ip/class/irred constraints only; not used for equalities
solveOneFromTheOther ev_i ev_w solveOneFromTheOther ev_i ev_w
| isDerived ev_w -- Work item is Derived; just discard it | isDerived ev_w -- Work item is Derived; just discard it
= return (IRKeep, True) = return (IRKeep, True)
...@@ -843,7 +843,7 @@ interactFunEq inerts workItem@(CFunEqCan { cc_ev = ev, cc_fun = tc ...@@ -843,7 +843,7 @@ interactFunEq inerts workItem@(CFunEqCan { cc_ev = ev, cc_fun = tc
, cc_tyargs = args, cc_fsk = fsk }) , cc_tyargs = args, cc_fsk = fsk })
| Just (CFunEqCan { cc_ev = ev_i | Just (CFunEqCan { cc_ev = ev_i
, cc_fsk = fsk_i }) <- matching_inerts , cc_fsk = fsk_i }) <- matching_inerts
= if ev_i `canDischarge` ev = if ev_i `funEqCanDischarge` ev
then -- Rewrite work-item using inert then -- Rewrite work-item using inert
do { traceTcS "reactFunEq (discharge work item):" $ do { traceTcS "reactFunEq (discharge work item):" $
vcat [ text "workItem =" <+> ppr workItem vcat [ text "workItem =" <+> ppr workItem
...@@ -851,7 +851,7 @@ interactFunEq inerts workItem@(CFunEqCan { cc_ev = ev, cc_fun = tc ...@@ -851,7 +851,7 @@ interactFunEq inerts workItem@(CFunEqCan { cc_ev = ev, cc_fun = tc
; reactFunEq ev_i fsk_i ev fsk ; reactFunEq ev_i fsk_i ev fsk
; stopWith ev "Inert rewrites work item" } ; stopWith ev "Inert rewrites work item" }
else -- Rewrite inert using work-item else -- Rewrite inert using work-item
ASSERT2( ev `canDischarge` ev_i, ppr ev $$ ppr ev_i ) ASSERT2( ev `funEqCanDischarge` ev_i, ppr ev $$ ppr ev_i )
do { traceTcS "reactFunEq (rewrite inert item):" $ do { traceTcS "reactFunEq (rewrite inert item):" $
vcat [ text "workItem =" <+> ppr workItem vcat [ text "workItem =" <+> ppr workItem
, text "inertItem=" <+> ppr ev_i ] , text "inertItem=" <+> ppr ev_i ]
...@@ -881,15 +881,15 @@ improveLocalFunEqs loc inerts fam_tc args fsk ...@@ -881,15 +881,15 @@ improveLocalFunEqs loc inerts fam_tc args fsk
= do { traceTcS "interactFunEq improvements: " $ = do { traceTcS "interactFunEq improvements: " $
vcat [ ptext (sLit "Eqns:") <+> ppr improvement_eqns vcat [ ptext (sLit "Eqns:") <+> ppr improvement_eqns
, ptext (sLit "Candidates:") <+> ppr funeqs_for_tc , ptext (sLit "Candidates:") <+> ppr funeqs_for_tc
, ptext (sLit "TvEqs:") <+> ppr tv_eqs ] , ptext (sLit "Model:") <+> ppr model ]
; mapM_ (unifyDerived loc Nominal) improvement_eqns } ; mapM_ (unifyDerived loc Nominal) improvement_eqns }
| otherwise | otherwise
= return () = return ()
where where
tv_eqs = inert_model inerts model = inert_model inerts
funeqs = inert_funeqs inerts funeqs = inert_funeqs inerts
funeqs_for_tc = findFunEqsByTyCon funeqs fam_tc funeqs_for_tc = findFunEqsByTyCon funeqs fam_tc
rhs = lookupFlattenTyVar tv_eqs fsk rhs = lookupFlattenTyVar model fsk
-------------------- --------------------
improvement_eqns improvement_eqns
...@@ -906,14 +906,14 @@ improveLocalFunEqs loc inerts fam_tc args fsk ...@@ -906,14 +906,14 @@ improveLocalFunEqs loc inerts fam_tc args fsk
-------------------- --------------------
do_one_built_in ops (CFunEqCan { cc_tyargs = iargs, cc_fsk = ifsk }) do_one_built_in ops (CFunEqCan { cc_tyargs = iargs, cc_fsk = ifsk })
= sfInteractInert ops args rhs iargs (lookupFlattenTyVar tv_eqs ifsk) = sfInteractInert ops args rhs iargs (lookupFlattenTyVar model ifsk)
do_one_built_in _ _ = pprPanic "interactFunEq 1" (ppr fam_tc) do_one_built_in _ _ = pprPanic "interactFunEq 1" (ppr fam_tc)
-------------------- --------------------
-- See Note [Type inference for type families with injectivity] -- See Note [Type inference for type families with injectivity]
do_one_injective injective_args do_one_injective injective_args
(CFunEqCan { cc_tyargs = iargs, cc_fsk = ifsk }) (CFunEqCan { cc_tyargs = iargs, cc_fsk = ifsk })
| rhs `tcEqType` lookupFlattenTyVar tv_eqs ifsk | rhs `tcEqType` lookupFlattenTyVar model ifsk
= [Pair arg iarg | (arg, iarg, True) = [Pair arg iarg | (arg, iarg, True)
<- zip3 args iargs injective_args ] <- zip3 args iargs injective_args ]
| otherwise | otherwise
...@@ -922,8 +922,7 @@ improveLocalFunEqs loc inerts fam_tc args fsk ...@@ -922,8 +922,7 @@ improveLocalFunEqs loc inerts fam_tc args fsk
------------- -------------
lookupFlattenTyVar :: InertModel -> TcTyVar -> TcType lookupFlattenTyVar :: InertModel -> TcTyVar -> TcType
-- ^ Look up a flatten-tyvar in the inert nominal TyVarEqs; -- See Note [lookupFlattenTyVar]
-- this is used only when dealing with a CFunEqCan
lookupFlattenTyVar model ftv lookupFlattenTyVar model ftv
= case lookupVarEnv model ftv of = case lookupVarEnv model ftv of
Just (CTyEqCan { cc_rhs = rhs, cc_eq_rel = NomEq }) -> rhs Just (CTyEqCan { cc_rhs = rhs, cc_eq_rel = NomEq }) -> rhs
...@@ -950,7 +949,18 @@ reactFunEq from_this fsk1 solve_this fsk2 ...@@ -950,7 +949,18 @@ reactFunEq from_this fsk1 solve_this fsk2
; traceTcS "reactFunEq done" (ppr from_this $$ ppr fsk1 $$ ; traceTcS "reactFunEq done" (ppr from_this $$ ppr fsk1 $$
ppr solve_this $$ ppr fsk2) } ppr solve_this $$ ppr fsk2) }
{- {- Note [lookupFlattenTyVar]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Supppose we have an injective function F and
inert_funeqs: F t1 ~ fsk1
F t2 ~ fsk2
model fsk1 ~ fsk2
We never rewrite the RHS (cc_fsk) of a CFunEqCan. But we /do/ want to
get the [D] t1 ~ t2 from the injectiveness of F. So we look up the
cc_fsk of CFunEqCans in the model when trying to find derived
equalities arising from injectivity.
Note [Type inference for type families with injectivity] Note [Type inference for type families with injectivity]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have a type family with an injectivity annotation: Suppose we have a type family with an injectivity annotation:
...@@ -1086,10 +1096,10 @@ interactTyVarEq inerts workItem@(CTyEqCan { cc_tyvar = tv ...@@ -1086,10 +1096,10 @@ interactTyVarEq inerts workItem@(CTyEqCan { cc_tyvar = tv
, cc_eq_rel = eq_rel }) , cc_eq_rel = eq_rel })
| (ev_i : _) <- [ ev_i | CTyEqCan { cc_ev = ev_i, cc_rhs = rhs_i } | (ev_i : _) <- [ ev_i | CTyEqCan { cc_ev = ev_i, cc_rhs = rhs_i }
<- findTyEqs inerts tv <- findTyEqs inerts tv
, ev_i `canDischarge` ev , ev_i `eqCanDischarge` ev
, rhs_i `tcEqType` rhs ] , rhs_i `tcEqType` rhs ]
= -- Inert: a ~ b = -- Inert: a ~ ty
-- Work item: a ~ b -- Work item: a ~ ty
do { setEvBindIfWanted ev $ do { setEvBindIfWanted ev $
EvCoercion (tcDowngradeRole (eqRelRole eq_rel) EvCoercion (tcDowngradeRole (eqRelRole eq_rel)
(ctEvRole ev_i) (ctEvRole ev_i)
...@@ -1100,7 +1110,7 @@ interactTyVarEq inerts workItem@(CTyEqCan { cc_tyvar = tv ...@@ -1100,7 +1110,7 @@ interactTyVarEq inerts workItem@(CTyEqCan { cc_tyvar = tv
| Just tv_rhs <- getTyVar_maybe rhs | Just tv_rhs <- getTyVar_maybe rhs
, (ev_i : _) <- [ ev_i | CTyEqCan { cc_ev = ev_i, cc_rhs = rhs_i } , (ev_i : _) <- [ ev_i | CTyEqCan { cc_ev = ev_i, cc_rhs = rhs_i }
<- findTyEqs inerts tv_rhs <- findTyEqs inerts tv_rhs
, ev_i `canDischarge` ev , ev_i `eqCanDischarge` ev
, rhs_i `tcEqType` mkTyVarTy tv ] , rhs_i `tcEqType` mkTyVarTy tv ]
= -- Inert: a ~ b = -- Inert: a ~ b
-- Work item: b ~ a -- Work item: b ~ a
...@@ -1530,7 +1540,7 @@ shortCutReduction old_ev fsk ax_co fam_tc tc_args ...@@ -1530,7 +1540,7 @@ shortCutReduction old_ev fsk ax_co fam_tc tc_args
`mkTcTransCo` ctEvCoercion old_ev) ) `mkTcTransCo` ctEvCoercion old_ev) )
; let new_ct = CFunEqCan { cc_ev = new_ev, cc_fun = fam_tc, cc_tyargs = xis, cc_fsk = fsk } ; let new_ct = CFunEqCan { cc_ev = new_ev, cc_fun = fam_tc, cc_tyargs = xis, cc_fsk = fsk }
; emitWorkCt new_ct ; updWorkListTcS (extendWorkListFunEq new_ct)
; stopWith old_ev "Fun/Top (given, shortcut)" } ; stopWith old_ev "Fun/Top (given, shortcut)" }
| otherwise | otherwise
...@@ -1549,8 +1559,9 @@ shortCutReduction old_ev fsk ax_co fam_tc tc_args ...@@ -1549,8 +1559,9 @@ shortCutReduction old_ev fsk ax_co fam_tc tc_args
(ax_co `mkTcTransCo` mkTcSymCo (mkTcTyConAppCo Nominal fam_tc cos) (ax_co `mkTcTransCo` mkTcSymCo (mkTcTyConAppCo Nominal fam_tc cos)
`mkTcTransCo` new_co) `mkTcTransCo` new_co)
; let new_ct = CFunEqCan { cc_ev = new_ev, cc_fun = fam_tc, cc_tyargs = xis, cc_fsk = fsk } ; let new_ct = CFunEqCan { cc_ev = new_ev, cc_fun = fam_tc
; emitWorkCt new_ct , cc_tyargs = xis, cc_fsk = fsk }
; updWorkListTcS (extendWorkListFunEq new_ct)
; stopWith old_ev "Fun/Top (wanted, shortcut)" } ; stopWith old_ev "Fun/Top (wanted, shortcut)" }
where where
loc = ctEvLoc old_ev loc = ctEvLoc old_ev
...@@ -1631,7 +1642,7 @@ Note [Cached solved FunEqs] ...@@ -1631,7 +1642,7 @@ Note [Cached solved FunEqs]
When trying to solve, say (FunExpensive big-type ~ ty), it's important When trying to solve, say (FunExpensive big-type ~ ty), it's important
to see if we have reduced (FunExpensive big-type) before, lest we to see if we have reduced (FunExpensive big-type) before, lest we
simply repeat it. Hence the lookup in inert_solved_funeqs. Moreover simply repeat it. Hence the lookup in inert_solved_funeqs. Moreover
we must use `canDischarge` because both uses might (say) be Wanteds, we must use `funEqCanDischarge` because both uses might (say) be Wanteds,
and we *still* want to save the re-computation. and we *still* want to save the re-computation.
Note [MATCHING-SYNONYMS] Note [MATCHING-SYNONYMS]
......
...@@ -112,7 +112,8 @@ module TcRnTypes( ...@@ -112,7 +112,8 @@ module TcRnTypes(
CtFlavour(..), ctEvFlavour, CtFlavour(..), ctEvFlavour,
CtFlavourRole, ctEvFlavourRole, ctFlavourRole, CtFlavourRole, ctEvFlavourRole, ctFlavourRole,
eqCanRewrite, eqCanRewriteFR, canDischarge, canDischargeFR, eqCanRewrite, eqCanRewriteFR, eqCanDischarge,
funEqCanDischarge, funEqCanDischargeFR,
-- Pretty printing -- Pretty printing
pprEvVarTheta, pprEvVarTheta,
...@@ -2273,54 +2274,74 @@ we can; straight from the Wanteds during improvment. And from a Derived ...@@ -2273,54 +2274,74 @@ we can; straight from the Wanteds during improvment. And from a Derived
ReprEq we could conceivably get a Derived NomEq improvment (by decomposing ReprEq we could conceivably get a Derived NomEq improvment (by decomposing
a type constructor with Nomninal role), and hence unify. a type constructor with Nomninal role), and hence unify.
Note [canDischarge] Note [funEqCanDischarge]
~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~
(x1:c1 `canDischarge` x2:c2) returns True if we can use c1 to Suppose we have two CFunEqCans with the same LHS:
/discharge/ c2; that is, if we can simply drop (x2:c2) altogether, (x1:F ts ~ f1) `funEqCanDischarge` (x2:F ts ~ f2)
perhaps adding a binding for x2 in terms of x1. We only ask this Can we drop x2 in favour of x1, either unifying
question in two cases: f2 (if it's a flatten meta-var) or adding a new Given
(f1 ~ f2), if x2 is a Given?
* Identical equality constraints:
(x1:s~t) `canDischarge` (xs:s~t) Answer: yes if funEqCanDischarge is true.
In this case we can just drop x2 in favour of x1.
Note [eqCanDischarge]
* Function calls with the same LHS: ~~~~~~~~~~~~~~~~~~~~~
(x1:F ts ~ f1) `canDischarge` (x2:F ts ~ f2) Suppose we have two identicla equality constraints
Here we can drop x2 in favour of x1, either unifying (i.e. both LHS and RHS are the same)
f2 (if it's a flatten meta-var) or adding a new Given (x1:s~t) `eqCanDischarge` (xs:s~t)
(f1 ~ f2), if x2 is a Given. Can we just drop x2 in favour of x1?
This is different from eqCanRewrite; for exammple, a Wanted Answer: yes if eqCanDischarge is true.
can certainly discharge an identical Wanted. So canDicharge
does /not/ define a can-rewrite relation in the sense of Note that we do /not/ allow Wanted to discharge Derived.
Definition [Can-rewrite relation] in TcSMonad. We must keep both. Why? Because the Derived may rewrite
other Deriveds in the model whereas the Wanted cannot.
However a Wanted can certainly discharge an identical Wanted. So
eqCanDischarge does /not/ define a can-rewrite relation in the
sense of Definition [Can-rewrite relation] in TcSMonad.
-} -}
-----------------
eqCanRewrite :: CtEvidence -> CtEvidence -> Bool eqCanRewrite :: CtEvidence -> CtEvidence -> Bool
eqCanRewrite ev1 ev2 = eqCanRewriteFR (ctEvFlavourRole ev1)
(ctEvFlavourRole ev2)
eqCanRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool
-- Very important function! -- Very important function!
-- See Note [eqCanRewrite] -- See Note [eqCanRewrite]
-- See Note [Wanteds do not rewrite Wanteds] -- See Note [Wanteds do not rewrite Wanteds]
-- See Note [Deriveds do rewrite Deriveds] -- See Note [Deriveds do rewrite Deriveds]
eqCanRewriteFR (Given, NomEq) (_, _) = True eqCanRewrite ev1 ev2 = eqCanRewriteFR (ctEvFlavourRole ev1)
eqCanRewriteFR (Given, ReprEq) (_, ReprEq) = True (ctEvFlavourRole ev2)
eqCanRewriteFR _ _ = False
canDischarge :: CtEvidence -> CtEvidence -> Bool eqCanRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool
-- See Note [canDischarge] eqCanRewriteFR (Given, NomEq) (_, _) = True
canDischarge ev1 ev2 = canDischargeFR (ctEvFlavourRole ev1) eqCanRewriteFR (Given, ReprEq) (_, ReprEq) = True
eqCanRewriteFR (Derived, NomEq) (Derived, NomEq) = True
eqCanRewriteFR _ _ = False
-----------------
funEqCanDischarge :: CtEvidence -> CtEvidence -> Bool
-- See Note [funEqCanDischarge]
funEqCanDischarge ev1 ev2 = funEqCanDischargeFR (ctEvFlavourRole ev1)
(ctEvFlavourRole ev2) (ctEvFlavourRole ev2)
canDischargeFR :: CtFlavourRole -> CtFlavourRole -> Bool funEqCanDischargeFR :: CtFlavourRole -> CtFlavourRole -> Bool
canDischargeFR (_, ReprEq) (_, NomEq) = False funEqCanDischargeFR (_, ReprEq) (_, NomEq) = False
canDischargeFR (Given, _) _ = True funEqCanDischargeFR (Given, _) _ = True
canDischargeFR (Wanted, _) (Wanted, _) = True funEqCanDischargeFR (Wanted, _) (Wanted, _) = True
canDischargeFR (Wanted, _) (Derived, _) = True funEqCanDischargeFR (Wanted, _) (Derived, _) = True
canDischargeFR (Derived, _) (Derived, _) = True funEqCanDischargeFR (Derived, _) (Derived, _) = True
canDischargeFR _ _ = False funEqCanDischargeFR _ _ = False
-----------------
eqCanDischarge :: CtEvidence -> CtEvidence -> Bool
-- See Note [eqCanDischarge]
eqCanDischarge ev1 ev2 = eqCanDischargeFR (ctEvFlavourRole ev1)
(ctEvFlavourRole ev2)
eqCanDischargeFR :: CtFlavourRole -> CtFlavourRole -> Bool
eqCanDischargeFR (_, ReprEq) (_, NomEq) = False
eqCanDischargeFR (Given, _) (Given,_) = True
eqCanDischargeFR (Wanted, _) (Wanted, _) = True
eqCanDischargeFR (Derived, _) (Derived, _) = True
eqCanDischargeFR _ _ = False
{- {-
************************************************************************ ************************************************************************
......
This diff is collapsed.
...@@ -51,6 +51,50 @@ merge :: ...@@ -51,6 +51,50 @@ merge ::
-} -}
merge x y = mkMerge (merger x y) x y merge x y = mkMerge (merger x y) x y
{- ------------- NASTY TYPE FOR merge -----------------
-- See Trac #11408
x:tx, y:ty
mkMerge @ gamma
merger @ alpha beta
merge :: tx -> ty -> tr
Constraints generated:
gamma ~ MergerType alpha beta
UnmergedLeft gamma ~ tx
UnmergedRight gamma ~ ty
alpha ~ tx
beta ~ ty
tr ~ Merged gamma
Mergeable tx ty
Merger gamma
One solve path:
gamma := t
tx := alpha := UnmergedLeft t
ty := beta := UnmergedRight t
Mergeable (UnmergedLeft t) (UnmergedRight t)
Merger t
t ~ MergerType (UnmergedLeft t) (UnmergedRight t)
LEADS TO AMBIGUOUS TYPE
Another solve path:
tx := alpha
ty := beta
gamma := MergerType alpha beta
UnmergedLeft (MergerType alpah beta) ~ alpha
UnmergedRight (MergerType alpah beta) ~ beta
Merger (MergerType alpha beta)
Mergeable alpha beta
LEADS TO NON-AMBIGUOUS TYPE
--------------- -}
data TakeRight a data TakeRight a
data TakeLeft a data TakeLeft a
data DiscardRightHead a b c d data DiscardRightHead a b c d
......
...@@ -270,3 +270,4 @@ test('T11067', normal, compile, ['']) ...@@ -270,3 +270,4 @@ test('T11067', normal, compile, [''])
test('T10318', normal, compile, ['']) test('T10318', normal, compile, [''])
test('UnusedTyVarWarnings', normal, compile, ['-W']) test('UnusedTyVarWarnings', normal, compile, ['-W'])
test('UnusedTyVarWarningsNamedWCs', normal, compile, ['-W']) test('UnusedTyVarWarningsNamedWCs', normal, compile, ['-W'])
test('T11408', normal, compile, [''])
tcfail201.hs:17:56: error: tcfail201.hs:17:56: error:
• Couldn't match type ‘a’ with ‘HsDoc id0’ • Couldn't match type ‘a’ with ‘HsDoc t0’
‘a’ is a rigid type variable bound by ‘a’ is a rigid type variable bound by
the type signature for: the type signature for:
gfoldl' :: forall (c :: * -> *) a. gfoldl' :: forall (c :: * -> *) a.
...@@ -8,7 +8,7 @@ tcfail201.hs:17:56: error: ...@@ -8,7 +8,7 @@ tcfail201.hs:17:56: error:
-> (forall g. g -> c g) -> a -> c a -> (forall g. g -> c g) -> a -> c a
at tcfail201.hs:15:12 at tcfail201.hs:15:12
Expected type: c a Expected type: c a
Actual type: c (HsDoc id0) Actual type: c (HsDoc t0)
• In the expression: z DocEmpty • In the expression: z DocEmpty
In a case alternative: DocEmpty -> z DocEmpty In a case alternative: DocEmpty -> z DocEmpty
In the expression: case hsDoc of { DocEmpty -> z DocEmpty } In the expression: case hsDoc of { DocEmpty -> z DocEmpty }
......
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