Commit f352e5cd authored by Simon Peyton Jones's avatar Simon Peyton Jones

Keep the bindings local during defaultCallStacks

defaultCallStacks generates evidence bindings for call stacks,
but wasn't setting the binding site correctly.  As a result
they were simply discarded in the case of pattern synonyms,
giving rise to Trac #12489.

The fix is easy; and I added an ASSERT to catch the error earlier.
parent efc0372a
......@@ -176,8 +176,10 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
-- Solve the constraints now, because we are about to make a PatSyn,
-- which should not contain unification variables and the like (Trac #10997)
; empty_binds <- simplifyTop (mkImplicWC implics)
-- Since all the inputs are implications the returned bindings will be empty
; _ <- simplifyTop (mkImplicWC implics)
; MASSERT2( isEmptyBag empty_binds, ppr empty_binds )
-- ToDo: in the bidirectional case, check that the ex_tvs' are all distinct
-- Otherwise we may get a type error when typechecking the builder,
......
......@@ -16,7 +16,7 @@ module TcSMonad (
TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds,
failTcS, warnTcS, addErrTcS,
runTcSEqualities,
nestTcS, nestImplicTcS,
nestTcS, nestImplicTcS, setEvBindsTcS,
runTcPluginTcS, addUsedGREs, deferTcSForAllEq,
......@@ -2487,6 +2487,10 @@ checkForCyclicBinds ev_binds
-- Note [Deterministic SCC] in Digraph.
#endif
setEvBindsTcS :: Maybe EvBindsVar -> TcS a -> TcS a
setEvBindsTcS m_ref (TcS thing_inside)
= TcS $ \ env -> thing_inside (env { tcs_ev_binds = m_ref })
nestImplicTcS :: Maybe EvBindsVar -> TyCoVarSet -- bound in this implication
-> TcLevel -> TcS a
-> TcS (a, TyCoVarSet) -- also returns any vars used when filling
......
......@@ -170,9 +170,12 @@ defaultCallStacks wanteds
handle_simples simples
= catBagMaybes <$> mapBagM defaultCallStack simples
handle_implic implic = do
wanteds <- defaultCallStacks (ic_wanted implic)
return (implic { ic_wanted = wanteds })
handle_implic implic
= do { wanteds <- setEvBindsTcS (ic_binds implic) $
-- defaultCallStack sets a binding, so
-- we must set the correct binding group
defaultCallStacks (ic_wanted implic)
; return (implic { ic_wanted = wanteds }) }
defaultCallStack ct
| Just _ <- isCallStackPred (ctPred ct)
......
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
module T12489 where
pattern P :: a -> b
pattern P a <- (undefined -> a)
......@@ -58,3 +58,4 @@ test('T12094', normal, compile, [''])
test('T11977', normal, compile, [''])
test('T12108', normal, compile, [''])
test('T12484', normal, compile, [''])
test('T12489', 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