[commit: ghc] wip/14691: s,ctEvTerm,ctEvExpr,g (dc6de0a)
git at git.haskell.org
git at git.haskell.org
Fri Jan 26 02:42:08 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/14691
Link : http://ghc.haskell.org/trac/ghc/changeset/dc6de0a3d6c7acc1b4147a66de8fd6d8b9c60e54/ghc
>---------------------------------------------------------------
commit dc6de0a3d6c7acc1b4147a66de8fd6d8b9c60e54
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Thu Jan 25 21:37:40 2018 -0500
s,ctEvTerm,ctEvExpr,g
>---------------------------------------------------------------
dc6de0a3d6c7acc1b4147a66de8fd6d8b9c60e54
compiler/typecheck/TcCanonical.hs | 4 ++--
compiler/typecheck/TcInteract.hs | 12 ++++++------
compiler/typecheck/TcMType.hs | 2 +-
compiler/typecheck/TcRnTypes.hs | 8 ++++----
compiler/typecheck/TcSMonad.hs | 4 ++--
5 files changed, 15 insertions(+), 15 deletions(-)
diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index e159c3a..60f4497 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -153,7 +153,7 @@ canClassNC ev cls tys
-- Then we solve the wanted by pushing the call-site
-- onto the newly emitted CallStack
- ; let ev_cs = EvCsPushCall func (ctLocSpan loc) (ctEvTerm new_ev)
+ ; let ev_cs = EvCsPushCall func (ctLocSpan loc) (ctEvExpr new_ev)
; solveCallStack ev ev_cs
; canClass new_ev cls tys False }
@@ -1845,7 +1845,7 @@ rewriteEvidence old_ev@(CtDerived {}) new_pred _co
-- rewriteEvidence to put the isTcReflCo test first!
-- Why? Because for *Derived* constraints, c, the coercion, which
-- was produced by flattening, may contain suspended calls to
- -- (ctEvTerm c), which fails for Derived constraints.
+ -- (ctEvExpr c), which fails for Derived constraints.
-- (Getting this wrong caused Trac #7384.)
continueWith (old_ev { ctev_pred = new_pred })
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 11d9252..39424de 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -694,8 +694,8 @@ interactIrred inerts workItem@(CIrredCan { cc_ev = ev_w, cc_insol = insoluble })
swap_me :: SwapFlag -> CtEvidence -> EvExpr
swap_me swap ev
= case swap of
- NotSwapped -> ctEvTerm ev
- IsSwapped -> evCoercion (mkTcSymCo (evTermCoercion (EvExpr (ctEvTerm ev))))
+ NotSwapped -> ctEvExpr ev
+ IsSwapped -> evCoercion (mkTcSymCo (evTermCoercion (EvExpr (ctEvExpr ev))))
interactIrred _ wi = pprPanic "interactIrred" (ppr wi)
@@ -1001,9 +1001,9 @@ interactDict inerts workItem@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs
{ what_next <- solveOneFromTheOther ev_i ev_w
; traceTcS "lookupInertDict" (ppr what_next)
; case what_next of
- KeepInert -> do { setEvBindIfWanted ev_w (ctEvTerm ev_i)
+ KeepInert -> do { setEvBindIfWanted ev_w (ctEvExpr ev_i)
; return $ Stop ev_w (text "Dict equal" <+> parens (ppr what_next)) }
- KeepWork -> do { setEvBindIfWanted ev_i (ctEvTerm ev_w)
+ KeepWork -> do { setEvBindIfWanted ev_i (ctEvExpr ev_w)
; updInertDicts $ \ ds -> delDict ds cls tys
; continueWith workItem } } }
@@ -1057,7 +1057,7 @@ shortCutSolver dflags ev_w ev_i
new_wanted_cached cache pty
| ClassPred cls tys <- classifyPredType pty
= lift $ case findDict cache loc_w cls tys of
- Just ctev -> return $ Cached (ctEvTerm ctev)
+ Just ctev -> return $ Cached (ctEvExpr ctev)
Nothing -> Fresh <$> newWantedNC loc_w pty
| otherwise = mzero
@@ -2202,7 +2202,7 @@ doTopReactDict inerts work_item@(CDictCan { cc_ev = fl, cc_class = cls
; continueWith work_item }
| Just ev <- lookupSolvedDict inerts dict_loc cls xis -- Cached
- = do { setEvBindIfWanted fl (ctEvTerm ev)
+ = do { setEvBindIfWanted fl (ctEvExpr ev)
; stopWith fl "Dict/Top (cached)" }
| otherwise -- Wanted or Derived, but not cached
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 2881491..4de99b5 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -207,7 +207,7 @@ emitWanted :: CtOrigin -> TcPredType -> TcM EvExpr
emitWanted origin pty
= do { ev <- newWanted origin Nothing pty
; emitSimple $ mkNonCanonical ev
- ; return $ ctEvTerm ev }
+ ; return $ ctEvExpr ev }
-- | Emits a new equality constraint
emitWantedEq :: CtOrigin -> TypeOrKind -> Role -> TcType -> TcType -> TcM Coercion
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 2718d6b..364fd95 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -78,7 +78,7 @@ module TcRnTypes(
mkNonCanonical, mkNonCanonicalCt, mkGivens,
mkIrredCt, mkInsolubleCt,
ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel,
- ctEvTerm, ctEvCoercion, ctEvEvId,
+ ctEvExpr, ctEvCoercion, ctEvEvId,
tyCoVarsOfCt, tyCoVarsOfCts,
tyCoVarsOfCtList, tyCoVarsOfCtsList,
@@ -2674,9 +2674,9 @@ ctEvEqRel = predTypeEqRel . ctEvPred
ctEvRole :: CtEvidence -> Role
ctEvRole = eqRelRole . ctEvEqRel
-ctEvTerm :: CtEvidence -> EvExpr
-ctEvTerm ev@(CtWanted { ctev_dest = HoleDest _ }) = evCoercion $ ctEvCoercion ev
-ctEvTerm ev = evId (ctEvEvId ev)
+ctEvExpr :: CtEvidence -> EvExpr
+ctEvExpr ev@(CtWanted { ctev_dest = HoleDest _ }) = evCoercion $ ctEvCoercion ev
+ctEvExpr ev = evId (ctEvEvId ev)
-- Always returns a coercion whose type is precisely ctev_pred of the CtEvidence.
-- See also Note [Given in ctEvCoercion]
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index cd8eea1..af77a2c 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -2998,7 +2998,7 @@ freshGoals :: [MaybeNew] -> [CtEvidence]
freshGoals mns = [ ctev | Fresh ctev <- mns ]
getEvExpr :: MaybeNew -> EvExpr
-getEvExpr (Fresh ctev) = ctEvTerm ctev
+getEvExpr (Fresh ctev) = ctEvExpr ctev
getEvExpr (Cached evt) = evt
setEvBind :: EvBind -> TcS ()
@@ -3111,7 +3111,7 @@ newWantedEvVar loc pty
Just ctev
| not (isDerived ctev)
-> do { traceTcS "newWantedEvVar/cache hit" $ ppr ctev
- ; return $ Cached (ctEvTerm ctev) }
+ ; return $ Cached (ctEvExpr ctev) }
_ -> do { ctev <- newWantedEvVarNC loc pty
; return (Fresh ctev) } }
More information about the ghc-commits
mailing list