Skip to content
Snippets Groups Projects
Commit 0ac2073a authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Make simplifyInfer generalise only over simple class constraints

So we never infer
   f :: Eq (Tree a) => blah
when there isn't an instance for Eq (Tree a).

This fixes Trac #6022.

It does represent a change in behaviour: certain (bizarre) programs
will be rejected that were previously accepted. Specifically, if you
have

   module A where
   f x = ...somethign needing (C T)...

   moudule B where
   import A
   instance C T
   test = f True

Here the (C T) instance is provided "later".  But this is wierd; it
would be better to give a type signature for f
   f :: C T => Bool -> Bool
and then you'd be fine.
parent 05debbb4
No related branches found
Tags 0.3
No related merge requests found
......@@ -37,6 +37,7 @@ import PrelNames
import Class ( classKey )
import BasicTypes ( RuleName )
import Control.Monad ( when )
import Data.List ( partition )
import Outputable
import FastString
import TrieMap () -- DV: for now
......@@ -324,22 +325,21 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds
else do
-- Step 4, zonk quantified variables
{ let minimal_flat_preds = mkMinimalBySCs $
map ctPred $ bagToList bound
{ qtvs_to_return <- zonkQuantifiedTyVars (varSetElems qtvs)
-- Step 5
-- Minimize `bound' and emit an implication
; let minimal_flat_preds = predsToQuantify bound
skol_info = InferSkol [ (name, mkSigmaTy [] minimal_flat_preds ty)
| (name, ty) <- name_taus ]
-- Don't add the quantified variables here, because
-- they are also bound in ic_skols and we want them to be
-- tidied uniformly
; qtvs_to_return <- zonkQuantifiedTyVars (varSetElems qtvs)
-- Step 5
-- Minimize `bound' and emit an implication
; minimal_bound_ev_vars <- mapM TcMType.newEvVar minimal_flat_preds
; ev_binds_var <- newTcEvBinds
; mapBagM_ (\(EvBind evar etrm) -> addTcEvBind ev_binds_var evar etrm)
tc_binds
tc_binds
; lcl_env <- getLclTypeEnv
; gloc <- getCtLoc skol_info
; let implic = Implic { ic_untch = NoUntouchables
......@@ -362,12 +362,22 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds
; return ( qtvs_to_return, minimal_bound_ev_vars
, mr_bites, TcEvBinds ev_binds_var) } }
predsToQuantify :: Cts -> [PredType]
-- From a bunch of (non-insoluble) flat constraints, pick the ones to generalise
-- an inferred type over. In particular:
-- * Omit superclasses: (Eq a, Ord a) ---> Ord a
-- * Reject non-tyvar clases: (Eq a, Show (Tree b)) --> Eq a
predsToQuantify bound
= non_cls_preds ++ mkMinimalBySCs (filter isTyVarClassPred cls_preds)
where
(cls_preds, non_cls_preds) = partition isClassPred $
map ctPred $ bagToList bound
\end{code}
Note [Minimize by Superclasses]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we quantify over a constraint, in simplifyInfer we need to
quantify over a constraint that is minimal in some sense: For
instance, if the final wanted constraint is (Eq alpha, Ord alpha),
......
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