[commit: ghc] wip/rae: Revert "Finish fixing validDerivPred change" (c0b488a)

git at git.haskell.org git at git.haskell.org
Fri Dec 19 13:02:00 UTC 2014


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

On branch  : wip/rae
Link       : http://ghc.haskell.org/trac/ghc/changeset/c0b488a171a3632ab3db1bd1950212f98703a499/ghc

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

commit c0b488a171a3632ab3db1bd1950212f98703a499
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Fri Dec 19 08:02:52 2014 -0500

    Revert "Finish fixing validDerivPred change"
    
    This reverts commit 040ad38d2aeb7957cad83731bae03cdcdb5cd664.


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

c0b488a171a3632ab3db1bd1950212f98703a499
 compiler/typecheck/TcDeriv.hs                      | 12 +----------
 compiler/typecheck/TcErrors.hs                     | 24 ++++++++++------------
 .../tests/indexed-types/should_fail/T6088.stderr   | 11 ----------
 3 files changed, 12 insertions(+), 35 deletions(-)

diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 8b2e6dc..8b7af86 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -1880,17 +1880,7 @@ simplifyDeriv pred tvs theta
        -- constraints.  They'll come up again when we typecheck the
        -- generated instance declaration
        ; defer <- goptM Opt_DeferTypeErrors
-       ; unless defer $ reportAllUnsolved (residual_wanted { wc_simple = bad })
-       ; ifErrsM (do { let bad_preds = [ ctPred bad_ct
-                                       | bad_ct <- bagToList bad
-                                       , isWantedCt bad_ct ] -- omit Deriveds
-                           inf_theta = bagToList good ++ bad_preds
-                     ; setErrCtxt [] $ addErr $
-                       hang (hsep [ text "The full inferred context for"
-                                  , doc, text "is" ])
-                          2 (pprTheta inf_theta) $$
-                       text "Try using this context for standalone-deriving." })
-         (return ())   -- do nothing if there are no errors
+       ; unless defer (reportAllUnsolved (residual_wanted { wc_simple = bad }))
 
        ; let min_theta = mkMinimalBySCs (bagToList good)
        ; return (substTheta subst_skol min_theta) }
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 8fda2c8..3fdf4e9 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -676,8 +676,7 @@ mkEqErr1 ctxt ct
        ; dflags <- getDynFlags
        ; traceTc "mkEqErr1" (ppr ct $$ pprCtOrigin (ctLocOrigin loc) $$ pprCtOrigin tidy_orig)
        ; mkEqErr_help dflags (ctxt {cec_tidy = env1})
-                      (vcat [ wanted_msg, coercible_msg, binds_msg
-                            , show_fixes (drv_fixes tidy_orig) ])
+                      (wanted_msg $$ coercible_msg $$ binds_msg)
                       ct is_oriented ty1 ty2 }
   where
     ev         = ctEvidence ct
@@ -1207,7 +1206,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
              , vcat (pp_givens givens)
              , ppWhen (has_ambig_tvs && not (null unifiers && null givens))
                (vcat [ ambig_msg, binds_msg, potential_msg ])
-             , show_fixes (add_to_ctxt_fixes has_ambig_tvs ++ drv_fixes orig) ]
+             , show_fixes (add_to_ctxt_fixes has_ambig_tvs ++ drv_fixes) ]
 
     potential_msg
       = ppWhen (not (null unifiers) && want_potential orig) $
@@ -1252,6 +1251,15 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
     type_has_arrow (ForAllTy _ t)   = type_has_arrow t
     type_has_arrow (LitTy _)        = False
 
+    drv_fixes = case orig of
+                   DerivOrigin      -> [drv_fix]
+                   DerivOriginDC {} -> [drv_fix]
+                   DerivOriginCoerce {} -> [drv_fix]
+                   _                -> []
+
+    drv_fix = hang (ptext (sLit "use a standalone 'deriving instance' declaration,"))
+                 2 (ptext (sLit "so you can specify the instance context yourself"))
+
     -- Normal overlap error
     overlap_msg
       = ASSERT( not (null matches) )
@@ -1340,16 +1348,6 @@ show_fixes []     = empty
 show_fixes (f:fs) = sep [ ptext (sLit "Possible fix:")
                         , nest 2 (vcat (f : map (ptext (sLit "or") <+>) fs))]
 
-drv_fixes :: CtOrigin -> [SDoc]
-drv_fixes orig = case orig of
-  DerivOrigin          -> [drv_fix]
-  DerivOriginDC {}     -> [drv_fix]
-  DerivOriginCoerce {} -> [drv_fix]
-  _                    -> []
-  where
-    drv_fix = hang (ptext (sLit "use a standalone 'deriving instance' declaration,"))
-                 2 (ptext (sLit "so you can specify the instance context yourself"))
-
 ppr_insts :: [ClsInst] -> SDoc
 ppr_insts insts
   = pprInstances (take 3 insts) $$ dot_dot_message
diff --git a/testsuite/tests/indexed-types/should_fail/T6088.stderr b/testsuite/tests/indexed-types/should_fail/T6088.stderr
deleted file mode 100644
index d9aeee6..0000000
--- a/testsuite/tests/indexed-types/should_fail/T6088.stderr
+++ /dev/null
@@ -1,11 +0,0 @@
-
-T6088.hs:16:33:
-    Couldn't match type ‘Pos n’ with ‘True’
-    Possible fix:
-      use a standalone 'deriving instance' declaration,
-        so you can specify the instance context yourself
-    When deriving the instance for (C (B n))
-
-T6088.hs:16:33:
-    The full inferred context for deriving (C (B n)) is (Pos n ~ True)
-    Try using this context for standalone-deriving.



More information about the ghc-commits mailing list