Commit 40d3a06b authored by simonpj's avatar simonpj
Browse files

[project @ 2005-05-20 11:32:03 by simonpj]

Liberalise the defaulting rules for GHCi

		Merge to STABLE?

The H98 defaulting rules are these.  Group constraints of the form (C v),
for some particular type variable v. Then default v if

a) v appears only in this group (no implicit params or D [v])
b) at least one of the C's is numeric
c) all the C's are standard

GHCi changed rules (b) to

(b') at least one of the C's is numeric, or Eq,Ord,Show

This commit further liberalises GHCi to change (c):

(c') any of the C's are standard

Otherwise the existence of a non-standard class (e.g. Random) is enough
to kill defaulting altogether.
parent 79cbcc81
......@@ -28,7 +28,7 @@ import TcRnMonad
import Inst ( lookupInst, LookupInstResult(..),
tyVarsOfInst, fdPredsOfInsts, newDicts,
isDict, isClassDict, isLinearInst, linearInstType,
isStdClassTyVarDict, isMethodFor, isMethod,
isMethodFor, isMethod,
instToId, tyVarsOfInsts, cloneDict,
ipNamesOfInsts, ipNamesOfInst, dictPred,
instBindingRequired, fdPredsOfInst,
......@@ -53,7 +53,7 @@ import Name ( Name, getOccName, getSrcLoc )
import NameSet ( NameSet, mkNameSet, elemNameSet )
import Class ( classBigSig, classKey )
import FunDeps ( oclose, grow, improve, pprEquationDoc )
import PrelInfo ( isNumericClass )
import PrelInfo ( isNumericClass, isStandardClass )
import PrelNames ( splitName, fstName, sndName, integerTyConName,
showClassKey, eqClassKey, ordClassKey )
import Type ( zipTopTvSubst, substTheta, substTy )
......@@ -2021,21 +2021,32 @@ tc_simplify_top doc is_interactive want_scs wanteds
; (frees, binds, irreds) <- simpleReduceLoop doc try_me wanteds
; let
-- All the non-std ones are definite errors
(stds, non_stds) = partition isStdClassTyVarDict irreds
-- Group by type variable
std_groups = equivClasses cmp_by_tyvar stds
-- Pick the ones which its worth trying to disambiguate
-- namely, the onese whose type variable isn't bound
-- up with one of the non-standard classes
(std_oks, std_bads) = partition worth_a_try std_groups
worth_a_try group@(d:_) = not (non_std_tyvars `intersectsVarSet` tyVarsOfInst d)
non_std_tyvars = unionVarSets (map tyVarsOfInst non_stds)
-- All the non-tv ones are definite errors
(tv_dicts, non_tvs) = partition isTyVarDict irreds
bad_tyvars = unionVarSets (map tyVarsOfInst non_tvs)
-- Group by type variable
tv_groups = equivClasses cmp_by_tyvar tv_dicts
-- Pick the ones which its worth trying to disambiguate
-- namely, the ones whose type variable isn't bound
-- up with one of the non-tyvar classes
(default_gps, non_default_gps) = partition defaultable_group tv_groups
defaultable_group ds@(d:_)
= not (bad_tyvars `intersectsVarSet` tyVarsOfInst d)
&& defaultable_classes (map get_clas ds)
defaultable_classes clss
| is_interactive = any isInteractiveClass clss
| otherwise = all isStandardClass clss && any isNumericClass clss
isInteractiveClass cls = isNumericClass cls
|| (classKey cls `elem` [showClassKey, eqClassKey, ordClassKey])
-- In interactive mode, we default Show a to Show ()
-- to avoid graututious errors on "show []"
-- Collect together all the bad guys
bad_guys = non_stds ++ concat std_bads
bad_guys = non_tvs ++ concat non_default_gps
(non_ips, bad_ips) = partition isClassDict bad_guys
(ambigs, no_insts) = partition isTyVarDict non_ips
-- If the dict has no type constructors involved, it must be ambiguous,
......@@ -2069,7 +2080,7 @@ tc_simplify_top doc is_interactive want_scs wanteds
addTopAmbigErrs ambigs
-- Disambiguate the ones that look feasible
; mappM (disambigGroup is_interactive) std_oks }
; mappM (disambigGroup is_interactive) default_gps }
; return (binds `unionBags` unionManyBags binds_ambig) }
......@@ -2120,7 +2131,6 @@ disambigGroup :: Bool -- True <=> simplifying at top-level interactive loop
-> TcM TcDictBinds
disambigGroup is_interactive dicts
| any std_default_class classes -- Guaranteed all standard classes
= -- THE DICTS OBEY THE DEFAULTABLE CONSTRAINT
-- SO, TRY DEFAULT TYPES IN ORDER
......@@ -2146,21 +2156,10 @@ disambigGroup is_interactive dicts
case mb_ty of
Left _ -> bomb_out
Right chosen_default_ty -> choose_default chosen_default_ty
| otherwise -- No defaults
= bomb_out
where
tyvar = get_tv (head dicts) -- Should be non-empty
classes = map get_clas dicts
std_default_class cls
= isNumericClass cls
|| (is_interactive &&
classKey cls `elem` [showClassKey, eqClassKey, ordClassKey])
-- In interactive mode, we default Show a to Show ()
-- to avoid graututious errors on "show []"
choose_default default_ty -- Commit to tyvar = default_ty
= -- Bind the type variable
unifyTauTy default_ty (mkTyVarTy tyvar) `thenM_`
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment