[Git][ghc/ghc][wip/T25266] Respond to rae review
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Fri Oct 11 11:27:13 UTC 2024
Simon Peyton Jones pushed to branch wip/T25266 at Glasgow Haskell Compiler / GHC
Commits:
5cce9971 by Simon Peyton Jones at 2024-10-11T12:26:52+01:00
Respond to rae review
- - - - -
4 changed files:
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Types/Constraint.hs
Changes:
=====================================
compiler/GHC/Tc/Deriv/Infer.hs
=====================================
@@ -763,10 +763,10 @@ simplifyDeriv (DS { ds_loc = loc, ds_tvs = tvs
-- See [STEP DAC HOIST]
-- From the simplified constraints extract a subset 'good' that will
-- become the context 'min_theta' for the derived instance.
- ; let (simple1, simple2) = approximateWC solved_wanteds
- residual_simple = simple1 `unionBags` simple2
- head_size = pSizeClassPred clas inst_tys
- good = mapMaybeBag get_good residual_simple
+ ; let (residual_simple, _) = approximateWC solved_wanteds
+ -- Ignore any equalities hidden under Given equalities
+ head_size = pSizeClassPred clas inst_tys
+ good = mapMaybeBag get_good residual_simple
-- Returns @Just p@ (where @p@ is the type of the Ct) if a Ct is
-- suitable to be inferred in the context of a derived instance.
=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -59,6 +59,7 @@ import GHC.Types.Basic
import GHC.Types.Error
import GHC.Driver.DynFlags( DynFlags, xopt )
+import GHC.Driver.Flags( WarningFlag(..) )
import GHC.Utils.Panic
import GHC.Utils.Outputable
import GHC.Utils.Misc( filterOut )
@@ -1408,7 +1409,7 @@ When generalising `f`, closeWrtFunDeps will promote beta[1] to beta[0].
But we do NOT want to make a top level type
f :: C Int beta[0] => blah
The danger is that beta[0] is defaulted to Any, and that then appears
-in a user error message. Even the type `blah` mentions beta[0], /and/
+in a user error message. Even if the type `blah` mentions beta[0], /and/
there is a call that fixes beta[0] to (say) Bool, we'll end up with
[W] C Int Bool, which is insoluble. Why insoluble? If there was an
instance C Int Bool
@@ -1417,9 +1418,9 @@ then fundeps would have fixed beta:=Bool in the first place.
If the binding of `f` is nested, things are different: we can
definitely see all the calls.
-TODO: this reasoning is incomplete. Shouldn't it apply to nested
-bindings too, when this promotion happens so it's not because
-beta is already free in the envt???
+For nested bindings, I think it just doesn't matter. No one cares what this
+variable ends up being; it seems silly to halt compilation around it. (Like in
+the length [] case.)
-}
decideAndPromoteTyVars :: InferMode
@@ -1521,7 +1522,8 @@ decideAndPromoteTyVars infer_mode name_taus psigs wanted
| otherwise = post_mr_quant
-- Check if the Monomorphism Restriction has bitten
- ; when (case infer_mode of { ApplyMR -> True; _ -> False}) $
+ ; warn_mr <- woptM Opt_WarnMonomorphism
+ ; when (warn_mr && case infer_mode of { ApplyMR -> True; _ -> False}) $
do { let mono_tvs_wo_mr = closeWrtFunDeps post_mr_quant mono_tvs0
`delVarSetList` psig_qtvs
@@ -1662,7 +1664,8 @@ decideQuantifiedTyVars skol_info name_taus psigs candidates
; quantifyTyVars skol_info DefaultNonStandardTyVars dvs_plus }
------------------
-getSeedTys :: [(Name,TcType)] -> [TcIdSigInst]
+getSeedTys :: [(Name,TcType)] -- The type of each RHS in the group
+ -> [TcIdSigInst] -- Any partial type signatures
-> TcM ( [TcTyVar] -- Zonked partial-sig quantified tyvars
, ThetaType -- Zonked partial signature thetas
, [TcType] ) -- Zonked tau-tys from the bindings
=====================================
compiler/GHC/Tc/Solver/Default.hs
=====================================
@@ -822,6 +822,8 @@ findDefaultableGroups (default_tys, extended_defaults) wanteds
simples = simples1 `unionBags` simples2
-- simples: for the purpose of defaulting we don't care
-- about shape or enclosing equalities
+ -- See (W3) in Note [ApproximateWC] in GHC.Tc.Types.Constraint
+
(unaries, non_unaries) = partitionWith find_unary (bagToList simples)
unary_groups = equivClasses cmp_tv unaries
=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -1776,9 +1776,10 @@ At the end, we will hopefully have substituted uf1 := F alpha, and we
will be able to report a more informative error:
'Can't construct the infinite type beta ~ F alpha beta'
+
************************************************************************
* *
- Invariant checking (debug only)
+ approximateWC
* *
************************************************************************
-}
@@ -1813,8 +1814,8 @@ approximateWC wc
float_ct :: Bool -> TcTyCoVarSet -> Ct
-> ApproxWC -> ApproxWC
float_ct encl_eqs skol_tvs ct acc@(quant, no_quant)
- | isGivenCt ct = acc
- | insolubleCt ct = acc
+ | assertPpr (isWantedCt ct) (ppr ct) $ -- Only Wanteds expected here
+ insolubleCt ct = acc
| tyCoVarsOfCt ct `intersectsVarSet` skol_tvs = acc
| otherwise
= case classifyPredType (ctPred ct) of
@@ -1894,9 +1895,9 @@ Wrinkle (W2)
abstracting over more constraints does no harm.
Wrinkle (W3)
- In findDefaultableGroups we are not worried about the
- most-general type; and we /do/ want to float out of equalities
- (#12797). Hence the boolean flag to approximateWC.
+ In findDefaultableGroups we are not worried about the most-general type; and
+ we /do/ want to float out of equalities (#12797). Hence we just union the two
+ returned lists.
------ Historical note -----------
There used to be a second caveat, driven by #8155
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cce9971b5b86d21e619ae4d5a0dacf7c4f769b8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cce9971b5b86d21e619ae4d5a0dacf7c4f769b8
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/20241011/98cfb5dc/attachment-0001.html>
More information about the ghc-commits
mailing list