[Git][ghc/ghc][wip/T23070] More wibbles
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Sat Mar 4 21:52:12 UTC 2023
Simon Peyton Jones pushed to branch wip/T23070 at Glasgow Haskell Compiler / GHC
Commits:
925bb0f1 by Simon Peyton Jones at 2023-03-04T21:53:12+00:00
More wibbles
- - - - -
2 changed files:
- compiler/GHC/Tc/Solver/Equality.hs
- testsuite/tests/linters/notes.stdout
Changes:
=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -241,6 +241,7 @@ can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2
do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ps_ty1
; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ps_ty2
; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2
+ ; traceTcS "can_eq_nc: go round again" (ppr new_ev $$ ppr xi1 $$ ppr xi2)
; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 }
----------------------------
@@ -274,8 +275,8 @@ can_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2
can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2
= do { traceTcS "can_eq_nc' catch-all case" (ppr ps_ty1 $$ ppr ps_ty2)
; case eq_rel of -- See Note [Unsolved equalities]
- ReprEq -> continueWith (mkIrredCt ReprEqReason ev)
- NomEq -> continueWith (mkIrredCt ShapeMismatchReason ev) }
+ ReprEq -> finishIrredEquality ReprEqReason ev
+ NomEq -> finishIrredEquality ShapeMismatchReason ev }
-- No need to call canEqFailure/canEqHardFailure because they
-- rewrite, and the types involved here are already rewritten
@@ -731,7 +732,7 @@ canTyConApp ev eq_rel tc1 tys1 tc2 tys2
-- See Note [Skolem abstract data] in GHC.Core.Tycon
| tyConSkolem tc1 || tyConSkolem tc2
= do { traceTcS "canTyConApp: skolem abstract" (ppr tc1 $$ ppr tc2)
- ; continueWith (mkIrredCt AbstractTyConReason ev) }
+ ; finishIrredEquality AbstractTyConReason ev }
-- Fail straight away for better error messages
-- See Note [Use canEqFailure in canDecomposableTyConApp]
@@ -1706,7 +1707,9 @@ canEqCanLHSFinish ev eq_rel swapped lhs rhs
NomEq -> result0
ReprEq -> cterSetOccursCheckSoluble result0
- reason = NonCanonicalReason result
+ non_canonical_result what
+ = do { traceTcS ("canEqCanLHSFinish: " ++ what) (ppr lhs $$ ppr rhs)
+ ; finishIrredEquality (NonCanonicalReason result) new_ev }
; ics <- getInertCans
; if cterHasNoProblem result
@@ -1718,22 +1721,17 @@ canEqCanLHSFinish ev eq_rel swapped lhs rhs
-- See Note [Type equality cycles];
-- returning Nothing is the vastly common case
; case m_stuff of
- { Nothing ->
- do { traceTcS "canEqCanLHSFinish can't make a canonical"
- (ppr lhs $$ ppr rhs)
- ; continueWith (mkIrredCt reason new_ev) }
+ { Nothing -> non_canonical_result "Can't make canonical"
+
; Just rhs_redn@(Reduction _ new_rhs) ->
do { traceTcS "canEqCanLHSFinish breaking a cycle" $
- ppr lhs $$ ppr rhs
- ; traceTcS "new RHS:" (ppr new_rhs)
+ vcat [ text "lhs:" <+> ppr lhs, text "rhs:" <+> ppr rhs
+ , text "new_rhs:" <+> ppr new_rhs ]
-- This check is Detail (1) in the Note
; if cterHasOccursCheck (checkTypeEq lhs new_rhs)
-
- then do { traceTcS "Note [Type equality cycles] Detail (1)"
- (ppr new_rhs)
- ; continueWith (mkIrredCt reason new_ev) }
+ then non_canonical_result "Note [Type equality cycles] Detail (1)"
else do { -- See Detail (6) of Note [Type equality cycles]
new_new_ev <- rewriteEqEvidence emptyRewriterSet
@@ -2365,7 +2363,6 @@ interactEq inerts
downgradeRole (eqRelRole eq_rel)
(ctEvRole ev_i)
(ctEvCoercion ev_i))
-
; stopWith ev "Solved from inert" }
| otherwise
@@ -2374,7 +2371,7 @@ interactEq inerts
TyFamLHS tc args -> do { improveLocalFunEqs inerts tc args work_item
; improveTopFunEqs tc args work_item
- ; doTopReactEq work_item }
+ ; finishEqCt work_item }
inertsCanDischarge :: InertCans -> EqCt
@@ -2438,7 +2435,7 @@ tryToSolveByUnification tv
| ReprEq <- eq_rel -- See Note [Do not unify representational equalities]
= do { traceTcS "Not unifying representational equality" (ppr work_item)
- ; doTopReactEq work_item }
+ ; dont_unify }
| otherwise
= do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv rhs
@@ -2446,7 +2443,7 @@ tryToSolveByUnification tv
, ppr is_touchable ])
; case is_touchable of
- Untouchable -> doTopReactEq work_item
+ Untouchable -> dont_unify
-- For the latter two cases see Note [Solve by unification]
TouchableSameLevel -> solveByUnification ev tv rhs
@@ -2455,6 +2452,8 @@ tryToSolveByUnification tv
-> do { wrapTcS $ mapM_ (promoteMetaTyVarTo tv_lvl) free_metas
; setUnificationFlag tv_lvl
; solveByUnification ev tv rhs } }
+ where
+ dont_unify = finishEqCt work_item
solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS (StopOrContinue Ct)
-- Solve with the identity coercion
@@ -2544,7 +2543,7 @@ at the ambient level because of the kick-out mechanism.)
{-********************************************************************
* *
- Top-level reaction for equality constraints
+ Final wrap-up for equalities
* *
********************************************************************-}
@@ -2561,22 +2560,40 @@ See
-}
--------------------
-doTopReactEq :: EqCt -> TcS (StopOrContinue Ct)
--- See GHC.Tc.Solver.Canonical
--- Note [Equality superclasses in quantified constraints]
-doTopReactEq work_item@(EqCt { eq_ev = ev, eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = eq_rel })
- -- See Note [Looking up primitive equalities in quantified constraints]
- | Just (cls, tys) <- boxEqPred eq_rel (canEqLHSType lhs) rhs
+finishIrredEquality :: CtIrredReason -> CtEvidence -> TcS (StopOrContinue Ct)
+finishIrredEquality reason ev
+ | EqPred eq_rel t1 t2 <- classifyPredType (ctEvPred ev)
+ = final_qci_check (mkIrredCt reason ev) eq_rel t1 t2
+ | otherwise -- All the calls come from in this module, where we deal
+ -- only with equalities. We could pass eq_rel, t1, t2 as arguments
+ -- but it's not a hot path, and this is simple and robust
+ = pprPanic "finishIrredEquality" (ppr ev)
+
+--------------------
+finishEqCt :: EqCt -> TcS (StopOrContinue Ct)
+finishEqCt work_item@(EqCt { eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = eq_rel })
+ = final_qci_check (CEqCan work_item) eq_rel (canEqLHSType lhs) rhs
+
+--------------------
+final_qci_check :: Ct -> EqRel -> TcType -> TcType -> TcS (StopOrContinue Ct)
+-- The "final QCI check" checks to see if we have
+-- [W] t1 ~# t2
+-- and a Given quantified contraint like (forall a b. blah => a :~: b)
+-- Why? See Note [Looking up primitive equalities in quantified constraints]
+final_qci_check work_ct eq_rel lhs rhs
+ | isWanted ev
+ , Just (cls, tys) <- boxEqPred eq_rel lhs rhs
= do { res <- matchLocalInst (mkClassPred cls tys) loc
; case res of
OneInst { cir_mk_ev = mk_ev }
- -> chooseInstance (CEqCan work_item)
+ -> chooseInstance work_ct
(res { cir_mk_ev = mk_eq_ev cls tys mk_ev })
- _ -> continueWith (CEqCan work_item) }
+ _ -> continueWith work_ct }
| otherwise
- = continueWith (CEqCan work_item)
+ = continueWith work_ct
where
+ ev = ctEvidence work_ct
loc = ctEvLoc ev
mk_eq_ev cls tys mk_ev evs
@@ -2584,7 +2601,7 @@ doTopReactEq work_item@(EqCt { eq_ev = ev, eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel
= assert (null rest) $ case (mk_ev evs) of
EvExpr e -> EvExpr (Var sc_id `mkTyApps` tys `App` e)
ev -> pprPanic "mk_eq_ev" (ppr ev)
- | otherwise = pprPanic "doTopReactEq" (ppr work_item)
+ | otherwise = pprPanic "finishEqCt" (ppr work_ct)
{-
**********************************************************************
=====================================
testsuite/tests/linters/notes.stdout
=====================================
@@ -1,63 +1,61 @@
-ref compiler/GHC/Core/Coercion/Axiom.hs:461:2: Note [RoughMap and rm_empty]
-ref compiler/GHC/Core/Opt/OccurAnal.hs:857:15: Note [Loop breaking]
-ref compiler/GHC/Core/Opt/SetLevels.hs:1580:30: Note [Top level scope]
-ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2675:13: Note [Case binder next]
-ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:3854:8: Note [Lambda-bound unfoldings]
-ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1257:37: Note [Gentle mode]
-ref compiler/GHC/Core/Opt/Specialise.hs:1623:28: Note [Arity decrease]
-ref compiler/GHC/Core/TyCo/Rep.hs:1748:31: Note [What prevents a constraint from floating]
-ref compiler/GHC/Driver/Main.hs:1641:34: Note [simpleTidyPgm - mkBootModDetailsTc]
-ref compiler/GHC/Driver/Session.hs:3961:49: Note [Eta-reduction in -O0]
+ref compiler/GHC/Core/Coercion/Axiom.hs:463:2: Note [RoughMap and rm_empty]
+ref compiler/GHC/Core/Opt/OccurAnal.hs:983:7: Note [Loop breaking]
+ref compiler/GHC/Core/Opt/SetLevels.hs:1574:30: Note [Top level scope]
+ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2825:13: Note [Case binder next]
+ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4009:8: Note [Lambda-bound unfoldings]
+ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode]
+ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease]
+ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating]
+ref compiler/GHC/Driver/Main.hs:1761:34: Note [simpleTidyPgm - mkBootModDetailsTc]
+ref compiler/GHC/Driver/Session.hs:3976:49: Note [Eta-reduction in -O0]
ref compiler/GHC/Hs/Expr.hs:191:63: Note [Pending Splices]
-ref compiler/GHC/Hs/Expr.hs:1704:87: Note [Lifecycle of a splice]
-ref compiler/GHC/Hs/Expr.hs:1740:7: Note [Pending Splices]
-ref compiler/GHC/Hs/Extension.hs:144:5: Note [Strict argument type constraints]
+ref compiler/GHC/Hs/Expr.hs:1706:87: Note [Lifecycle of a splice]
+ref compiler/GHC/Hs/Expr.hs:1742:7: Note [Pending Splices]
+ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constraints]
ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice]
-ref compiler/GHC/HsToCore/Pmc/Solver.hs:854:20: Note [COMPLETE sets on data families]
-ref compiler/GHC/HsToCore/Quote.hs:1460:7: Note [How brackets and nested splices are handled]
-ref compiler/GHC/Rename/Pat.hs:888:29: Note [Disambiguating record fields]
-ref compiler/GHC/Stg/Unarise.hs:313:32: Note [Renaming during unarisation]
+ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families]
+ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled]
+ref compiler/GHC/Rename/Pat.hs:890:29: Note [Disambiguating record fields]
+ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation]
ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init]
ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init]
-ref compiler/GHC/StgToCmm/Expr.hs:584:4: Note [case on bool]
-ref compiler/GHC/StgToCmm/Expr.hs:848:3: Note [alg-alt heap check]
-ref compiler/GHC/Tc/Gen/Expr.hs:1207:23: Note [Disambiguating record fields]
-ref compiler/GHC/Tc/Gen/Expr.hs:1422:7: Note [Disambiguating record fields]
-ref compiler/GHC/Tc/Gen/Expr.hs:1525:11: Note [Deprecating ambiguous fields]
-ref compiler/GHC/Tc/Gen/HsType.hs:551:56: Note [Skolem escape prevention]
-ref compiler/GHC/Tc/Gen/HsType.hs:2619:7: Note [Matching a kind signature with a declaration]
-ref compiler/GHC/Tc/Gen/Pat.hs:171:20: Note [Typing patterns in pattern bindings]
-ref compiler/GHC/Tc/Gen/Pat.hs:1101:7: Note [Matching polytyped patterns]
-ref compiler/GHC/Tc/Gen/Sig.hs:79:10: Note [Overview of type signatures]
+ref compiler/GHC/StgToCmm/Expr.hs:585:4: Note [case on bool]
+ref compiler/GHC/StgToCmm/Expr.hs:853:3: Note [alg-alt heap check]
+ref compiler/GHC/Tc/Gen/Expr.hs:1212:23: Note [Disambiguating record fields]
+ref compiler/GHC/Tc/Gen/Expr.hs:1427:7: Note [Disambiguating record fields]
+ref compiler/GHC/Tc/Gen/Expr.hs:1530:11: Note [Deprecating ambiguous fields]
+ref compiler/GHC/Tc/Gen/HsType.hs:557:56: Note [Skolem escape prevention]
+ref compiler/GHC/Tc/Gen/HsType.hs:2622:7: Note [Matching a kind signature with a declaration]
+ref compiler/GHC/Tc/Gen/Pat.hs:176:20: Note [Typing patterns in pattern bindings]
+ref compiler/GHC/Tc/Gen/Pat.hs:1127:7: Note [Matching polytyped patterns]
+ref compiler/GHC/Tc/Gen/Sig.hs:81:10: Note [Overview of type signatures]
ref compiler/GHC/Tc/Gen/Splice.hs:359:16: Note [How brackets and nested splices are handled]
ref compiler/GHC/Tc/Gen/Splice.hs:534:35: Note [PendingRnSplice]
ref compiler/GHC/Tc/Gen/Splice.hs:658:7: Note [How brackets and nested splices are handled]
-ref compiler/GHC/Tc/Gen/Splice.hs:897:11: Note [How brackets and nested splices are handled]
-ref compiler/GHC/Tc/Instance/Family.hs:515:35: Note [Constrained family instances]
-ref compiler/GHC/Tc/Module.hs:704:15: Note [Extra dependencies from .hs-boot files]
-ref compiler/GHC/Tc/Solver/Canonical.hs:1087:33: Note [Canonical LHS]
-ref compiler/GHC/Tc/Solver/Interact.hs:1611:9: Note [No touchables as FunEq RHS]
-ref compiler/GHC/Tc/Solver/Rewrite.hs:988:7: Note [Stability of rewriting]
-ref compiler/GHC/Tc/TyCl.hs:1106:6: Note [Unification variables need fresh Names]
-ref compiler/GHC/Tc/Types.hs:703:33: Note [Extra dependencies from .hs-boot files]
-ref compiler/GHC/Tc/Types.hs:1434:47: Note [Care with plugin imports]
-ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics]
-ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win]
-ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods]
-ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO]
-ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match]
-ref compiler/Language/Haskell/Syntax/Pat.hs:336:12: Note [Disambiguating record fields]
-ref configure.ac:212:10: Note [Linking ghc-bin against threaded stage0 RTS]
+ref compiler/GHC/Tc/Gen/Splice.hs:891:11: Note [How brackets and nested splices are handled]
+ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances]
+ref compiler/GHC/Tc/Module.hs:708:15: Note [Extra dependencies from .hs-boot files]
+ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting]
+ref compiler/GHC/Tc/TyCl.hs:1119:6: Note [Unification variables need fresh Names]
+ref compiler/GHC/Tc/Types.hs:697:33: Note [Extra dependencies from .hs-boot files]
+ref compiler/GHC/Tc/Types.hs:1428:47: Note [Care with plugin imports]
+ref compiler/GHC/Tc/Types/Constraint.hs:223:34: Note [NonCanonical Semantics]
+ref compiler/GHC/Types/Demand.hs:306:25: Note [Preserving Boxity of results is rarely a win]
+ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods]
+ref compiler/GHC/Utils/Monad.hs:400:34: Note [multiShotIO]
+ref compiler/Language/Haskell/Syntax/Binds.hs:200:31: Note [fun_id in Match]
+ref compiler/Language/Haskell/Syntax/Pat.hs:356:12: Note [Disambiguating record fields]
+ref configure.ac:210:10: Note [Linking ghc-bin against threaded stage0 RTS]
ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders]
-ref hadrian/src/Expression.hs:130:30: Note [Linking ghc-bin against threaded stage0 RTS]
+ref hadrian/src/Expression.hs:134:30: Note [Linking ghc-bin against threaded stage0 RTS]
ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "]
ref linters/lint-notes/Notes.hs:69:22: Note [...]
-ref testsuite/config/ghc:243:10: Note [WayFlags]
-ref testsuite/driver/testlib.py:153:10: Note [Why is there no stage1 setup function?]
-ref testsuite/driver/testlib.py:157:2: Note [Why is there no stage1 setup function?]
+ref testsuite/config/ghc:272:10: Note [WayFlags]
+ref testsuite/driver/testlib.py:160:10: Note [Why is there no stage1 setup function?]
+ref testsuite/driver/testlib.py:164:2: Note [Why is there no stage1 setup function?]
ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags]
ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables]
-ref testsuite/tests/perf/should_run/all.T:3:6: Note [Solving from instances when interacting Dicts]
+ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instances when interacting Dicts]
ref testsuite/tests/polykinds/CuskFam.hs:16:11: Note [Unifying implicit CUSK variables]
ref testsuite/tests/simplCore/should_compile/T5776.hs:16:7: Note [Simplifying RULE lhs constraints]
ref testsuite/tests/simplCore/should_compile/simpl018.hs:3:7: Note [Float coercions]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/925bb0f1f085e857b4b87689801fe2ff0d28fa12
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/925bb0f1f085e857b4b87689801fe2ff0d28fa12
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/20230304/c2a4d9f7/attachment-0001.html>
More information about the ghc-commits
mailing list