[Git][ghc/ghc][master] 2 commits: More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Oct 19 14:48:14 UTC 2022
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
488d3631 by Bodigrim at 2022-10-19T10:47:52-04:00
More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg
It's clear from asserts in `GHC.Tc.Errors` that `overlappingInstances_matches`
and `unsafeOverlapped` are supposed to be non-empty, and `unsafeOverlap_matches`
contains a single instance, but these invariants are immediately lost afterwards
and not encoded in types. This patch enforces the invariants by pattern matching
and makes types more precise, avoiding asserts and partial functions such as `head`.
- - - - -
607ce263 by sheaf at 2022-10-19T10:47:52-04:00
Rename unsafeOverlap_matches -> unsafeOverlap_match in UnsafeOverlap
- - - - -
3 changed files:
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
Changes:
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -83,6 +83,7 @@ import Data.Foldable ( toList )
import Data.Function ( on )
import Data.List ( partition, sort, sortBy )
import Data.List.NonEmpty ( NonEmpty(..) )
+import qualified Data.List.NonEmpty as NE
import Data.Ord ( comparing )
import qualified Data.Semigroup as S
@@ -2203,26 +2204,24 @@ mkDictErr ctxt orig_items
-- and the result of evaluating ...".
mk_dict_err :: HasCallStack => SolverReportErrCtxt -> (ErrorItem, ClsInstLookupResult)
-> TcM TcSolverReportMsg
--- Report an overlap error if this class constraint results
--- from an overlap (returning Left clas), otherwise return (Right pred)
-mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped))
- | null matches -- No matches but perhaps several unifiers
- = do { (_, rel_binds, item) <- relevantBindings True ctxt item
- ; candidate_insts <- get_candidate_instances
- ; (imp_errs, field_suggestions) <- record_field_suggestions
- ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) }
-
- | null unsafe_overlapped -- Some matches => overlap errors
- = return $ overlap_msg
-
- | otherwise
- = return $ safe_haskell_msg
+mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEmpty matches, NE.nonEmpty unsafe_overlapped) of
+ (Nothing, _) -> do -- No matches but perhaps several unifiers
+ { (_, rel_binds, item) <- relevantBindings True ctxt item
+ ; candidate_insts <- get_candidate_instances
+ ; (imp_errs, field_suggestions) <- record_field_suggestions
+ ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) }
+
+ -- Some matches => overlap errors
+ (Just matchesNE, Nothing) -> return $
+ OverlappingInstances item (NE.map fst matchesNE) (getPotentialUnifiers unifiers)
+
+ (Just (match :| []), Just unsafe_overlappedNE) -> return $
+ UnsafeOverlap item (fst match) (NE.map fst unsafe_overlappedNE)
+ (Just matches@(_ :| _), Just overlaps) -> pprPanic "mk_dict_err: multiple matches with overlap" $ vcat [ text "matches:" <+> ppr matches, text "overlaps:" <+> ppr overlaps ]
where
orig = errorItemOrigin item
pred = errorItemPred item
(clas, tys) = getClassPredTys pred
- ispecs = [ispec | (ispec, _) <- matches]
- unsafe_ispecs = [ispec | (ispec, _) <- unsafe_overlapped]
get_candidate_instances :: TcM [ClsInst]
-- See Note [Report candidate instances]
@@ -2271,18 +2270,6 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped))
cannot_resolve_msg item candidate_insts binds imp_errs field_suggestions
= CannotResolveInstance item (getPotentialUnifiers unifiers) candidate_insts imp_errs field_suggestions binds
- -- Overlap errors.
- overlap_msg, safe_haskell_msg :: TcSolverReportMsg
- -- Normal overlap error
- overlap_msg
- = assert (not (null matches)) $ OverlappingInstances item ispecs (getPotentialUnifiers unifiers)
-
- -- Overlap error because of Safe Haskell (first
- -- match should be the most specific match)
- safe_haskell_msg
- = assert (matches `lengthIs` 1 && not (null unsafe_ispecs)) $
- UnsafeOverlap item ispecs unsafe_ispecs
-
{- Note [Report candidate instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have an unsolved (Num Int), where `Int` is not the Prelude Int,
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -2377,8 +2377,8 @@ pprTcSolverReportMsg (CEC {cec_encl = implics}) (OverlappingInstances item match
sep [text "Matching givens (or their superclasses):"
, nest 2 (vcat matching_givens)]
, potentialInstancesErrMsg
- (PotentialInstances { matches, unifiers })
- , ppWhen (null matching_givens && isSingleton matches && null unifiers) $
+ (PotentialInstances { matches = NE.toList matches, unifiers })
+ , ppWhen (null matching_givens && null (NE.tail matches) && null unifiers) $
-- Intuitively, some given matched the wanted in their
-- flattened or rewritten (from given equalities) form
-- but the matcher can't figure that out because the
@@ -2388,7 +2388,7 @@ pprTcSolverReportMsg (CEC {cec_encl = implics}) (OverlappingInstances item match
sep [ text "There exists a (perhaps superclass) match:"
, nest 2 (vcat (pp_givens useful_givens))]
- , ppWhen (isSingleton matches) $
+ , ppWhen (null $ NE.tail matches) $
parens (vcat [ ppUnless (null tyCoVars) $
text "The choice depends on the instantiation of" <+>
quotes (pprWithCommas ppr tyCoVars)
@@ -2429,16 +2429,16 @@ pprTcSolverReportMsg (CEC {cec_encl = implics}) (OverlappingInstances item match
Just (clas', tys') -> clas' == clas
&& isJust (tcMatchTys tys tys')
Nothing -> False
-pprTcSolverReportMsg _ (UnsafeOverlap item matches unsafe_overlapped) =
+pprTcSolverReportMsg _ (UnsafeOverlap item match unsafe_overlapped) =
vcat [ addArising ct_loc (text "Unsafe overlapping instances for"
<+> pprType (mkClassPred clas tys))
, sep [text "The matching instance is:",
- nest 2 (pprInstance $ head matches)]
+ nest 2 (pprInstance match)]
, vcat [ text "It is compiled in a Safe module and as such can only"
, text "overlap instances from the same module, however it"
, text "overlaps the following instances from different" <+>
text "modules:"
- , nest 2 (vcat [pprInstances $ unsafe_overlapped])
+ , nest 2 (vcat [pprInstances $ NE.toList unsafe_overlapped])
]
]
where
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -3028,7 +3028,7 @@ data TcSolverReportMsg
-- Test cases: tcfail118, tcfail121, tcfail218.
| OverlappingInstances
{ overlappingInstances_item :: ErrorItem
- , overlappingInstances_matches :: [ClsInst]
+ , overlappingInstances_matches :: NE.NonEmpty ClsInst
, overlappingInstances_unifiers :: [ClsInst] }
-- | Could not solve a constraint from instances because
@@ -3038,8 +3038,8 @@ data TcSolverReportMsg
-- Test cases: SH_Overlap{1,2,5,6,7,11}.
| UnsafeOverlap
{ unsafeOverlap_item :: ErrorItem
- , unsafeOverlap_matches :: [ClsInst]
- , unsafeOverlapped :: [ClsInst] }
+ , unsafeOverlap_match :: ClsInst
+ , unsafeOverlapped :: NE.NonEmpty ClsInst }
deriving Generic
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3732c6210972a992e1153b0667cf8abf0351acd...607ce263fd8304d02c24e997abc0d17ead1cb19b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3732c6210972a992e1153b0667cf8abf0351acd...607ce263fd8304d02c24e997abc0d17ead1cb19b
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221019/1a644b16/attachment-0001.html>
More information about the ghc-commits
mailing list