Remove code that generates FunDep error message context

as it seems that this code is now dead (due to
[Dropping derived constraints]) (See #8592)

2 files changed, 17 insertions, 45 deletions

diff --git a/compiler/typecheck/FunDeps.lhs b/compiler/typecheck/FunDeps.lhs
index 202ef1a12c..1dc96aa037 100644
--- a/compiler/typecheck/FunDeps.lhs
+++ b/compiler/typecheck/FunDeps.lhs
@@ -133,12 +133,10 @@ unification variables when producing the FD constraints.
 Finally, the position parameters will help us rewrite the wanted constraint ``on the spot''
 
 \begin{code}
-type Pred_Loc = (PredType, SDoc)        -- SDoc says where the Pred comes from
-
 data Equation
    = FDEqn { fd_qtvs :: [TyVar]                 -- Instantiate these type and kind vars to fresh unification vars
            , fd_eqs  :: [FDEq]                  --   and then make these equal
-           , fd_pred1, fd_pred2 :: Pred_Loc }   -- The Equation arose from
+           , fd_pred1, fd_pred2 :: PredType }   -- The Equation arose from
                                                 -- combining these two constraints
 
 data FDEq = FDEq { fd_pos      :: Int -- We use '0' for the first position
@@ -213,14 +211,14 @@ zipAndComputeFDEqs _ _ _ = []
 
 -- Improve a class constraint from another class constraint
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-improveFromAnother :: Pred_Loc -- Template item (usually given, or inert)
-                   -> Pred_Loc -- Workitem [that can be improved]
+improveFromAnother :: PredType -- Template item (usually given, or inert)
+                   -> PredType -- Workitem [that can be improved]
                    -> [Equation]
 -- Post: FDEqs always oriented from the other to the workitem
 --       Equations have empty quantified variables
-improveFromAnother pred1@(ty1, _) pred2@(ty2, _)
-  | Just (cls1, tys1) <- getClassPredTys_maybe ty1
-  , Just (cls2, tys2) <- getClassPredTys_maybe ty2
+improveFromAnother pred1 pred2
+  | Just (cls1, tys1) <- getClassPredTys_maybe pred1
+  , Just (cls2, tys2) <- getClassPredTys_maybe pred2
   , tys1 `lengthAtLeast` 2 && cls1 == cls2
   = [ FDEqn { fd_qtvs = [], fd_eqs = eqs, fd_pred1 = pred1, fd_pred2 = pred2 }
     | let (cls_tvs, cls_fds) = classTvsFds cls1
@@ -243,15 +241,15 @@ pprEquation (FDEqn { fd_qtvs = qtvs, fd_eqs = pairs })
           nest 2 (vcat [ ppr t1 <+> ptext (sLit "~") <+> ppr t2 | (FDEq _ t1 t2) <- pairs])]
 
 improveFromInstEnv :: (InstEnv,InstEnv)
-                   -> Pred_Loc
+                   -> PredType
                    -> [Equation] -- Needs to be an Equation because
                                  -- of quantified variables
 -- Post: Equations oriented from the template (matching instance) to the workitem!
-improveFromInstEnv _inst_env (pred,_loc)
+improveFromInstEnv _inst_env pred
   | not (isClassPred pred)
   = panic "improveFromInstEnv: not a class predicate"
-improveFromInstEnv inst_env pred@(ty, _)
-  | Just (cls, tys) <- getClassPredTys_maybe ty
+improveFromInstEnv inst_env pred
+  | Just (cls, tys) <- getClassPredTys_maybe pred
   , tys `lengthAtLeast` 2
   , let (cls_tvs, cls_fds) = classTvsFds cls
         instances          = classInstances inst_env cls
@@ -267,10 +265,7 @@ improveFromInstEnv inst_env pred@(ty, _)
     , ispec <- instances
     , (meta_tvs, eqs) <- checkClsFD fd cls_tvs ispec
                                     emptyVarSet tys trimmed_tcs -- NB: orientation
-    , let p_inst = (mkClassPred cls (is_tys ispec),
-                    sep [ ptext (sLit "arising from the dependency") <+> quotes (pprFunDep fd)
-                        , ptext (sLit "in the instance declaration")
-                          <+> pprNameDefnLoc (getName ispec)])
+    , let p_inst = mkClassPred cls (is_tys ispec)
     ]
 improveFromInstEnv _ _ = []
 
diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index b6a62af25c..432388822e 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -31,8 +31,6 @@ import FamInstEnv ( FamInstEnvs, instNewTyConTF_maybe )
 import TcEvidence
 import Outputable
 
-import TcMType ( zonkTcPredType )
-
 import TcRnTypes
 import TcErrors
 import TcSMonad
@@ -411,13 +409,8 @@ interactGivenIP _ wi = pprPanic "interactGivenIP" (ppr wi)
 
 addFunDepWork :: Ct -> Ct -> TcS ()
 addFunDepWork work_ct inert_ct
-  = do { let work_loc           = ctLoc work_ct
-             inert_loc          = ctLoc inert_ct
-             inert_pred_loc     = (ctPred inert_ct, pprArisingAt inert_loc)
-             work_item_pred_loc = (ctPred work_ct,  pprArisingAt work_loc)
-
-       ; let fd_eqns = improveFromAnother inert_pred_loc work_item_pred_loc
-       ; fd_work <- rewriteWithFunDeps fd_eqns work_loc
+  = do {  let fd_eqns = improveFromAnother (ctPred inert_ct) (ctPred work_ct)
+       ; fd_work <- rewriteWithFunDeps fd_eqns (ctLoc work_ct)
                 -- We don't really rewrite tys2, see below _rewritten_tys2, so that's ok
                 -- NB: We do create FDs for given to report insoluble equations that arise
                 -- from pairs of Givens, and also because of floating when we approximate
@@ -1355,20 +1348,17 @@ rewriteWithFunDeps eqn_pred_locs loc
 
 instFunDepEqn :: CtLoc -> Equation -> TcS [Ct]
 -- Post: Returns the position index as well as the corresponding FunDep equality
-instFunDepEqn loc (FDEqn { fd_qtvs = tvs, fd_eqs = eqs
-                         , fd_pred1 = d1, fd_pred2 = d2 })
+instFunDepEqn loc (FDEqn { fd_qtvs = tvs, fd_eqs = eqs })
   = do { (subst, _) <- instFlexiTcS tvs  -- Takes account of kind substitution
        ; foldM (do_one subst) [] eqs }
   where
-    der_loc = pushErrCtxt FunDepOrigin (False, mkEqnMsg d1 d2) loc
-
     do_one subst ievs (FDEq { fd_ty_left = ty1, fd_ty_right = ty2 })
        | tcEqType sty1 sty2
        = return ievs -- Return no trivial equalities
        | otherwise
-       = do { mb_eqv <- newDerived der_loc (mkTcEqPred sty1 sty2)
+       = do { mb_eqv <- newDerived loc (mkTcEqPred sty1 sty2)
             ; case mb_eqv of
-                 Just ev -> return (mkNonCanonical (ev {ctev_loc = der_loc}) : ievs)
+                 Just ev -> return (mkNonCanonical (ev {ctev_loc = loc}) : ievs)
                  Nothing -> return ievs }
                    -- We are eventually going to emit FD work back in the work list so
                    -- it is important that we only return the /freshly created/ and not
@@ -1376,18 +1366,6 @@ instFunDepEqn loc (FDEqn { fd_qtvs = tvs, fd_eqs = eqs
        where
          sty1 = Type.substTy subst ty1
          sty2 = Type.substTy subst ty2
-
-mkEqnMsg :: (TcPredType, SDoc)
-         -> (TcPredType, SDoc) -> TidyEnv -> TcM (TidyEnv, SDoc)
-mkEqnMsg (pred1,from1) (pred2,from2) tidy_env
-  = do  { zpred1 <- zonkTcPredType pred1
-        ; zpred2 <- zonkTcPredType pred2
-        ; let { tpred1 = tidyType tidy_env zpred1
-              ; tpred2 = tidyType tidy_env zpred2 }
-        ; let msg = vcat [ptext (sLit "When using functional dependencies to combine"),
-                          nest 2 (sep [ppr tpred1 <> comma, nest 2 from1]),
-                          nest 2 (sep [ppr tpred2 <> comma, nest 2 from2])]
-        ; return (tidy_env, msg) }
 \end{code}
 
 
@@ -1459,7 +1437,6 @@ doTopReactDict inerts fl cls xis
                                           ; solve_from_instance wtvs ev_term }
                NoInstance -> try_fundeps_and_return }
    where
-     arising_sdoc = pprArisingAt loc
      dict_id = ctEvId fl
      pred = mkClassPred cls xis
      loc = ctev_loc fl
@@ -1492,7 +1469,7 @@ doTopReactDict inerts fl cls xis
      -- so we make sure we get on and solve it first. See Note [Weird fundeps]
      try_fundeps_and_return
        = do { instEnvs <- getInstEnvs
-            ; let fd_eqns = improveFromInstEnv instEnvs (pred, arising_sdoc)
+            ; let fd_eqns = improveFromInstEnv instEnvs pred
             ; fd_work <- rewriteWithFunDeps fd_eqns loc
             ; unless (null fd_work) (updWorkListTcS (extendWorkListEqs fd_work))
             ; return NoTopInt }