[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