[commit: ghc] master: Define ctEvLoc and ctEvCoercion, and use them (c1a85b3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c1a85b321768d3e13adbbfaa5413bcff310ffb2e/ghc

>---------------------------------------------------------------

commit c1a85b321768d3e13adbbfaa5413bcff310ffb2e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Oct 30 09:08:23 2014 +0000

    Define ctEvLoc and ctEvCoercion, and use them


>---------------------------------------------------------------

c1a85b321768d3e13adbbfaa5413bcff310ffb2e
 compiler/typecheck/TcErrors.lhs  |  4 ++--
 compiler/typecheck/TcRnTypes.lhs | 16 +++++++++++++---
 2 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 927f522..9e9e551 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -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 =
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 86475e0..7e80906 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -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