[Git][ghc/ghc][wip/T26115] Crucial fix to short-cut solving

Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: a729a7c6 by Simon Peyton Jones at 2025-06-28T13:20:06+01:00 Crucial fix to short-cut solving noMatchableGivenDict should take account of TcSShortCut - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Dict.hs Changes: ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -807,7 +807,8 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls | otherwise -- Wanted, but not cached = do { dflags <- getDynFlags - ; lkup_res <- matchClassInst dflags inerts cls xis dict_loc + ; mode <- getTcSMode + ; lkup_res <- matchClassInst dflags mode inerts cls xis dict_loc ; case lkup_res of OneInst { cir_what = what } -> do { let is_local_given = case what of { LocalInstance -> True; _ -> False } @@ -865,10 +866,10 @@ checkInstanceOK loc what pred | otherwise = loc -matchClassInst :: DynFlags -> InertSet +matchClassInst :: DynFlags -> TcSMode -> InertSet -> Class -> [Type] -> CtLoc -> TcS ClsInstResult -matchClassInst dflags inerts clas tys loc +matchClassInst dflags mode inerts clas tys loc -- First check whether there is an in-scope Given that could -- match this constraint. In that case, do not use any instance -- whether top level, or local quantified constraints. @@ -879,7 +880,7 @@ matchClassInst dflags inerts clas tys loc -- It is always safe to unpack constraint tuples -- And if we don't do so, we may never solve it at all -- See Note [Solving tuple constraints] - , not (noMatchableGivenDicts inerts loc clas tys) + , not (noMatchableGivenDicts mode inerts loc clas tys) = do { traceTcS "Delaying instance application" $ vcat [ text "Work item:" <+> pprClassPred clas tys ] ; return NotSure } @@ -910,8 +911,11 @@ matchClassInst dflags inerts clas tys loc -- potentially, match the given class constraint. This is used when checking to see if a -- Given might overlap with an instance. See Note [Instance and Given overlap] -- in GHC.Tc.Solver.Dict -noMatchableGivenDicts :: InertSet -> CtLoc -> Class -> [TcType] -> Bool -noMatchableGivenDicts inerts@(IS { inert_cans = inert_cans }) loc_w clas tys +noMatchableGivenDicts :: TcSMode -> InertSet -> CtLoc -> Class -> [TcType] -> Bool +noMatchableGivenDicts mode inerts@(IS { inert_cans = inert_cans }) loc_w clas tys + | TcSShortCut <- mode + = True -- In TcSShortCut mode we behave as if there were no Givens at all + | otherwise = not $ anyBag matchable_given $ findDictsByClass (inert_dicts inert_cans) clas where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a729a7c6e96bd24724f3605adb96fb1e... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a729a7c6e96bd24724f3605adb96fb1e... You're receiving this email because of your account on gitlab.haskell.org.
participants (1)
-
Simon Peyton Jones (@simonpj)