Skip to content
Snippets Groups Projects
Commit 924f7494 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Austin Seipp
Browse files

Unflatten the constraints of an inferred types (Trac #8889)

There was even a comment to warn about this possiblity,
and it finally showed up in practice!  This patch fixes
it quite nicely, with commens to explain.

(cherry picked from commit 7a7af1ff)
parent b95b3fbd
No related merge requests found
...@@ -56,7 +56,7 @@ module TcMType ( ...@@ -56,7 +56,7 @@ module TcMType (
zonkTcTyVarBndr, zonkTcType, zonkTcTypes, zonkTcThetaType, zonkTcTyVarBndr, zonkTcType, zonkTcTypes, zonkTcThetaType,
zonkTcKind, defaultKindVarToStar, zonkTcKind, defaultKindVarToStar,
zonkEvVar, zonkWC, zonkId, zonkCt, zonkCts, zonkSkolemInfo, zonkEvVar, zonkWC, zonkFlats, zonkId, zonkCt, zonkCts, zonkSkolemInfo,
tcGetGlobalTyVars, tcGetGlobalTyVars,
) where ) where
......
...@@ -253,39 +253,50 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds ...@@ -253,39 +253,50 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds
; ev_binds_var <- newTcEvBinds ; ev_binds_var <- newTcEvBinds
; wanted_transformed_incl_derivs ; wanted_transformed_incl_derivs
<- solveWantedsTcMWithEvBinds ev_binds_var wanteds solve_wanteds <- solveWantedsTcMWithEvBinds ev_binds_var wanteds solve_wanteds
-- Post: wanted_transformed are zonked -- Post: wanted_transformed_incl_derivs are zonked
-- Step 4) Candidates for quantification are an approximation of wanted_transformed -- Step 4) Candidates for quantification are an approximation of wanted_transformed
-- NB: Already the fixpoint of any unifications that may have happened -- NB: Already the fixpoint of any unifications that may have happened
-- NB: We do not do any defaulting when inferring a type, this can lead -- NB: We do not do any defaulting when inferring a type, this can lead
-- to less polymorphic types, see Note [Default while Inferring] -- to less polymorphic types, see Note [Default while Inferring]
-- Step 5) Minimize the quantification candidates
-- Step 6) Final candidates for quantification
-- We discard bindings, insolubles etc, because all we are
-- care aout it
; tc_lcl_env <- TcRnMonad.getLclEnv ; tc_lcl_env <- TcRnMonad.getLclEnv
; let untch = tcl_untch tc_lcl_env ; let untch = tcl_untch tc_lcl_env
wanted_transformed = dropDerivedWC wanted_transformed_incl_derivs wanted_transformed = dropDerivedWC wanted_transformed_incl_derivs
; quant_pred_candidates -- Fully zonked ; quant_pred_candidates -- Fully zonked
<- if insolubleWC wanted_transformed_incl_derivs <- if insolubleWC wanted_transformed_incl_derivs
then return [] -- See Note [Quantification with errors] then return [] -- See Note [Quantification with errors]
-- NB: must include derived errors -- NB: must include derived errors in this test,
else do { gbl_tvs <- tcGetGlobalTyVars -- hence "incl_derivs"
; let quant_cand = approximateWC wanted_transformed
else do { let quant_cand = approximateWC wanted_transformed
meta_tvs = filter isMetaTyVar (varSetElems (tyVarsOfCts quant_cand)) meta_tvs = filter isMetaTyVar (varSetElems (tyVarsOfCts quant_cand))
; ((flats, _insols), _extra_binds) <- runTcS $ ; gbl_tvs <- tcGetGlobalTyVars
; null_ev_binds_var <- newTcEvBinds
-- Miminise quant_cand. We are not interested in any evidence
-- produced, because we are going to simplify wanted_transformed
-- again later. All we want here is the predicates over which to
-- quantify.
--
-- If any meta-tyvar unifications take place (unlikely), we'll
-- pick that up later.
; (flats, _insols) <- runTcSWithEvBinds null_ev_binds_var $
do { mapM_ (promoteAndDefaultTyVar untch gbl_tvs) meta_tvs do { mapM_ (promoteAndDefaultTyVar untch gbl_tvs) meta_tvs
-- See Note [Promote _and_ default when inferring] -- See Note [Promote _and_ default when inferring]
; _implics <- solveInteract quant_cand ; _implics <- solveInteract quant_cand
; getInertUnsolved } ; getInertUnsolved }
; return (map ctPred $ filter isWantedCt (bagToList flats)) }
-- NB: Dimitrios is slightly worried that we will get ; flats' <- zonkFlats null_ev_binds_var untch $
-- family equalities (F Int ~ alpha) in the quantification filterBag isWantedCt flats
-- candidates, as we have performed no further unflattening -- The quant_cand were already fully zonked, so this zonkFlats
-- at this point. Nothing bad, but inferred contexts might -- really only unflattens the flattening that solveInteract
-- look complicated. -- may have done (Trac #8889).
-- E.g. quant_cand = F a, where F :: * -> Constraint
-- We'll flatten to (alpha, F a ~ alpha)
-- fail to make any further progress and must unflatten again
; return (map ctPred $ bagToList flats') }
-- NB: quant_pred_candidates is already the fixpoint of any -- NB: quant_pred_candidates is already the fixpoint of any
-- unifications that may have happened -- unifications that may have happened
...@@ -326,6 +337,7 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds ...@@ -326,6 +337,7 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds
{ -- Step 7) Emit an implication { -- Step 7) Emit an implication
let minimal_flat_preds = mkMinimalBySCs bound let minimal_flat_preds = mkMinimalBySCs bound
-- See Note [Minimize by Superclasses]
skol_info = InferSkol [ (name, mkSigmaTy [] minimal_flat_preds ty) skol_info = InferSkol [ (name, mkSigmaTy [] minimal_flat_preds ty)
| (name, ty) <- name_taus ] | (name, ty) <- name_taus ]
-- Don't add the quantified variables here, because -- Don't add the quantified variables here, because
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment