Commit c1a85b32 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Define ctEvLoc and ctEvCoercion, and use them

parent 84d9ef0f
......@@ -614,7 +614,7 @@ mkEqErr1 ctxt ct
ct is_oriented ty1 ty2 }
where
ev = ctEvidence ct
loc = ctev_loc ev
loc = ctEvLoc ev
(ty1, ty2) = getEqPredTys (ctEvPred ev)
mk_given :: [Implication] -> (CtLoc, SDoc)
......@@ -1480,7 +1480,7 @@ solverDepthErrorTcS cnt ev
tidy_pred = tidyType tidy_env pred
; failWithTcM (tidy_env, hang (msg cnt) 2 (ppr tidy_pred)) }
where
loc = ctev_loc ev
loc = ctEvLoc ev
depth = ctLocDepth loc
value = subGoalCounterValue cnt depth
msg CountConstraints =
......
......@@ -52,7 +52,7 @@ module TcRnTypes(
isGivenCt, isHoleCt,
ctEvidence, ctLoc, ctPred,
mkNonCanonical, mkNonCanonicalCt,
ctEvPred, ctEvTerm, ctEvId, ctEvCheckDepth,
ctEvPred, ctEvLoc, ctEvTerm, ctEvCoercion, ctEvId, ctEvCheckDepth,
WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,
andWC, unionsWC, addFlats, addImplics, mkFlatWC, addInsols,
......@@ -1114,7 +1114,7 @@ ctEvidence :: Ct -> CtEvidence
ctEvidence = cc_ev
ctLoc :: Ct -> CtLoc
ctLoc = ctev_loc . cc_ev
ctLoc = ctEvLoc . ctEvidence
ctPred :: Ct -> PredType
-- See Note [Ct/evidence invariant]
......@@ -1480,16 +1480,26 @@ ctEvPred :: CtEvidence -> TcPredType
-- The predicate of a flavor
ctEvPred = ctev_pred
ctEvLoc :: CtEvidence -> CtLoc
ctEvLoc = ctev_loc
ctEvTerm :: CtEvidence -> EvTerm
ctEvTerm (CtGiven { ctev_evtm = tm }) = tm
ctEvTerm (CtWanted { ctev_evar = ev }) = EvId ev
ctEvTerm ctev@(CtDerived {}) = pprPanic "ctEvTerm: derived constraint cannot have id"
(ppr ctev)
ctEvCoercion :: CtEvidence -> TcCoercion
-- ctEvCoercion ev = evTermCoercion (ctEvTerm ev)
ctEvCoercion (CtGiven { ctev_evtm = tm }) = evTermCoercion tm
ctEvCoercion (CtWanted { ctev_evar = v }) = mkTcCoVarCo v
ctEvCoercion ctev@(CtDerived {}) = pprPanic "ctEvCoercion: derived constraint cannot have id"
(ppr ctev)
-- | Checks whether the evidence can be used to solve a goal with the given minimum depth
ctEvCheckDepth :: SubGoalDepth -> CtEvidence -> Bool
ctEvCheckDepth _ (CtGiven {}) = True -- Given evidence has infinite depth
ctEvCheckDepth min ev@(CtWanted {}) = min <= ctLocDepth (ctev_loc ev)
ctEvCheckDepth min ev@(CtWanted {}) = min <= ctLocDepth (ctEvLoc ev)
ctEvCheckDepth _ ev@(CtDerived {}) = pprPanic "ctEvCheckDepth: cannot consider derived evidence" (ppr ev)
ctEvId :: CtEvidence -> TcId
......
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