Commit 8035d1a5 authored by eir@cis.upenn.edu's avatar eir@cis.upenn.edu

Fix #10963 and #11975 by adding new cmds to GHCi.

See the user's guide entry or the Note [TcRnExprMode] in TcRnDriver.

Test cases: ghci/scripts/T{10963,11975}
parent 9a34bf19
...@@ -116,7 +116,7 @@ module GHC ( ...@@ -116,7 +116,7 @@ module GHC (
isModuleInterpreted, isModuleInterpreted,
-- ** Inspecting types and kinds -- ** Inspecting types and kinds
exprType, exprType, TcRnExprMode(..),
typeKind, typeKind,
-- ** Looking up a Name -- ** Looking up a Name
......
...@@ -65,7 +65,7 @@ module HscMain ...@@ -65,7 +65,7 @@ module HscMain
, hscTcRnLookupRdrName , hscTcRnLookupRdrName
, hscStmt, hscStmtWithLocation, hscParsedStmt , hscStmt, hscStmtWithLocation, hscParsedStmt
, hscDecls, hscDeclsWithLocation , hscDecls, hscDeclsWithLocation
, hscTcExpr, hscImport, hscKcType , hscTcExpr, TcRnExprMode(..), hscImport, hscKcType
, hscParseExpr , hscParseExpr
, hscCompileCoreExpr , hscCompileCoreExpr
-- * Low-level exports for hooks -- * Low-level exports for hooks
...@@ -1609,14 +1609,14 @@ hscImport hsc_env str = runInteractiveHsc hsc_env $ do ...@@ -1609,14 +1609,14 @@ hscImport hsc_env str = runInteractiveHsc hsc_env $ do
text "parse error in import declaration" text "parse error in import declaration"
-- | Typecheck an expression (but don't run it) -- | Typecheck an expression (but don't run it)
-- Returns its most general type
hscTcExpr :: HscEnv hscTcExpr :: HscEnv
-> TcRnExprMode
-> String -- ^ The expression -> String -- ^ The expression
-> IO Type -> IO Type
hscTcExpr hsc_env0 expr = runInteractiveHsc hsc_env0 $ do hscTcExpr hsc_env0 mode expr = runInteractiveHsc hsc_env0 $ do
hsc_env <- getHscEnv hsc_env <- getHscEnv
parsed_expr <- hscParseExpr expr parsed_expr <- hscParseExpr expr
ioMsgMaybe $ tcRnExpr hsc_env parsed_expr ioMsgMaybe $ tcRnExpr hsc_env mode parsed_expr
-- | Find the kind of a type -- | Find the kind of a type
-- Currently this does *not* generalise the kinds of the type -- Currently this does *not* generalise the kinds of the type
......
...@@ -864,10 +864,10 @@ parseThing parser dflags stmt = do ...@@ -864,10 +864,10 @@ parseThing parser dflags stmt = do
-- Getting the type of an expression -- Getting the type of an expression
-- | Get the type of an expression -- | Get the type of an expression
-- Returns its most general type -- Returns the type as described by 'TcRnExprMode'
exprType :: GhcMonad m => String -> m Type exprType :: GhcMonad m => TcRnExprMode -> String -> m Type
exprType expr = withSession $ \hsc_env -> do exprType mode expr = withSession $ \hsc_env -> do
ty <- liftIO $ hscTcExpr hsc_env expr ty <- liftIO $ hscTcExpr hsc_env mode expr
return $ tidyType emptyTidyEnv ty return $ tidyType emptyTidyEnv ty
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
......
...@@ -710,15 +710,16 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list ...@@ -710,15 +710,16 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
<- pushLevelAndCaptureConstraints $ <- pushLevelAndCaptureConstraints $
tcMonoBinds rec_tc tc_sig_fn LetLclBndr bind_list tcMonoBinds rec_tc tc_sig_fn LetLclBndr bind_list
; let name_taus = [ (mbi_poly_name info, idType (mbi_mono_id info)) ; let name_taus = [ (mbi_poly_name info, idType (mbi_mono_id info))
| info <- mono_infos ] | info <- mono_infos ]
sigs = [ sig | MBI { mbi_sig = Just sig } <- mono_infos ] sigs = [ sig | MBI { mbi_sig = Just sig } <- mono_infos ]
infer_mode = if mono then ApplyMR else NoRestrictions
; mapM_ (checkOverloadedSig mono) sigs ; mapM_ (checkOverloadedSig mono) sigs
; traceTc "simplifyInfer call" (ppr tclvl $$ ppr name_taus $$ ppr wanted) ; traceTc "simplifyInfer call" (ppr tclvl $$ ppr name_taus $$ ppr wanted)
; (qtvs, givens, ev_binds) ; (qtvs, givens, ev_binds)
<- simplifyInfer tclvl mono sigs name_taus wanted <- simplifyInfer tclvl infer_mode sigs name_taus wanted
; let inferred_theta = map evVarPred givens ; let inferred_theta = map evVarPred givens
; exports <- checkNoErrs $ ; exports <- checkNoErrs $
......
...@@ -29,7 +29,7 @@ import BasicTypes ...@@ -29,7 +29,7 @@ import BasicTypes
import Inst import Inst
import TcBinds ( chooseInferredQuantifiers, tcLocalBinds ) import TcBinds ( chooseInferredQuantifiers, tcLocalBinds )
import TcSigs ( tcUserTypeSig, tcInstSig ) import TcSigs ( tcUserTypeSig, tcInstSig )
import TcSimplify ( simplifyInfer ) import TcSimplify ( simplifyInfer, InferMode(..) )
import FamInst ( tcGetFamInstEnvs, tcLookupDataFamInst ) import FamInst ( tcGetFamInstEnvs, tcLookupDataFamInst )
import FamInstEnv ( FamInstEnvs ) import FamInstEnv ( FamInstEnvs )
import RnEnv ( addUsedGRE, addNameClashErrRn import RnEnv ( addUsedGRE, addNameClashErrRn
...@@ -1472,10 +1472,13 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc }) ...@@ -1472,10 +1472,13 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
; return (expr', sig_inst) } ; return (expr', sig_inst) }
-- See Note [Partial expression signatures] -- See Note [Partial expression signatures]
; let tau = sig_inst_tau sig_inst ; let tau = sig_inst_tau sig_inst
mr = null (sig_inst_theta sig_inst) && infer_mode | null (sig_inst_theta sig_inst)
isNothing (sig_inst_wcx sig_inst) , isNothing (sig_inst_wcx sig_inst)
= ApplyMR
| otherwise
= NoRestrictions
; (qtvs, givens, ev_binds) ; (qtvs, givens, ev_binds)
<- simplifyInfer tclvl mr [sig_inst] [(name, tau)] wanted <- simplifyInfer tclvl infer_mode [sig_inst] [(name, tau)] wanted
; tau <- zonkTcType tau ; tau <- zonkTcType tau
; let inferred_theta = map evVarPred givens ; let inferred_theta = map evVarPred givens
tau_tvs = tyCoVarsOfType tau tau_tvs = tyCoVarsOfType tau
......
...@@ -81,7 +81,8 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, ...@@ -81,7 +81,8 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
; let named_taus = (name, pat_ty) : map (\arg -> (getName arg, varType arg)) args ; let named_taus = (name, pat_ty) : map (\arg -> (getName arg, varType arg)) args
; (qtvs, req_dicts, ev_binds) <- simplifyInfer tclvl False [] named_taus wanted ; (qtvs, req_dicts, ev_binds) <- simplifyInfer tclvl NoRestrictions []
named_taus wanted
; let ((ex_tvs, ex_vars), prov_dicts) = tcCollectEx lpat' ; let ((ex_tvs, ex_vars), prov_dicts) = tcCollectEx lpat'
univ_tvs = filter (not . (`elemVarSet` ex_vars)) qtvs univ_tvs = filter (not . (`elemVarSet` ex_vars)) qtvs
......
...@@ -13,7 +13,7 @@ https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeChecker ...@@ -13,7 +13,7 @@ https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeChecker
module TcRnDriver ( module TcRnDriver (
#ifdef GHCI #ifdef GHCI
tcRnStmt, tcRnExpr, tcRnType, tcRnStmt, tcRnExpr, TcRnExprMode(..), tcRnType,
tcRnImportDecls, tcRnImportDecls,
tcRnLookupRdrName, tcRnLookupRdrName,
getModuleInterface, getModuleInterface,
...@@ -1972,13 +1972,17 @@ isGHCiMonad hsc_env ty ...@@ -1972,13 +1972,17 @@ isGHCiMonad hsc_env ty
Just _ -> failWithTc $ text "Ambiguous type!" Just _ -> failWithTc $ text "Ambiguous type!"
Nothing -> failWithTc $ text ("Can't find type:" ++ ty) Nothing -> failWithTc $ text ("Can't find type:" ++ ty)
-- tcRnExpr just finds the type of an expression -- | How should we infer a type? See Note [TcRnExprMode]
data TcRnExprMode = TM_Inst -- ^ Instantiate the type fully (:type)
| TM_NoInst -- ^ Do not instantiate the type (:type +v)
| TM_Default -- ^ Default the type eagerly (:type +d)
-- | tcRnExpr just finds the type of an expression
tcRnExpr :: HscEnv tcRnExpr :: HscEnv
-> TcRnExprMode
-> LHsExpr RdrName -> LHsExpr RdrName
-> IO (Messages, Maybe Type) -> IO (Messages, Maybe Type)
-- Type checks the expression and returns its most general type tcRnExpr hsc_env mode rdr_expr
tcRnExpr hsc_env rdr_expr
= runTcInteractive hsc_env $ = runTcInteractive hsc_env $
do { do {
...@@ -1993,15 +1997,15 @@ tcRnExpr hsc_env rdr_expr ...@@ -1993,15 +1997,15 @@ tcRnExpr hsc_env rdr_expr
(tclvl, lie, res_ty) (tclvl, lie, res_ty)
<- pushLevelAndCaptureConstraints $ <- pushLevelAndCaptureConstraints $
do { (_tc_expr, expr_ty) <- tcInferSigma rn_expr do { (_tc_expr, expr_ty) <- tcInferSigma rn_expr
; (_wrap, res_ty) <- deeplyInstantiate orig expr_ty ; if inst
-- See [Note Deeply instantiate in :type] then snd <$> deeplyInstantiate orig expr_ty
; return res_ty } ; else return expr_ty } ;
-- Generalise -- Generalise
((qtvs, dicts, _), lie_top) <- captureConstraints $ ((qtvs, dicts, _), lie_top) <- captureConstraints $
{-# SCC "simplifyInfer" #-} {-# SCC "simplifyInfer" #-}
simplifyInfer tclvl simplifyInfer tclvl
False {- No MR for now -} infer_mode
[] {- No sig vars -} [] {- No sig vars -}
[(fresh_it, res_ty)] [(fresh_it, res_ty)]
lie ; lie ;
...@@ -2009,7 +2013,8 @@ tcRnExpr hsc_env rdr_expr ...@@ -2009,7 +2013,8 @@ tcRnExpr hsc_env rdr_expr
stWC <- tcg_static_wc <$> getGblEnv >>= readTcRef ; stWC <- tcg_static_wc <$> getGblEnv >>= readTcRef ;
-- Ignore the dictionary bindings -- Ignore the dictionary bindings
_ <- simplifyInteractive (andWC stWC lie_top) ; _ <- perhaps_disable_default_warnings $
simplifyInteractive (andWC stWC lie_top) ;
let { all_expr_ty = mkInvForAllTys qtvs (mkLamTypes dicts res_ty) } ; let { all_expr_ty = mkInvForAllTys qtvs (mkLamTypes dicts res_ty) } ;
ty <- zonkTcType all_expr_ty ; ty <- zonkTcType all_expr_ty ;
...@@ -2022,6 +2027,12 @@ tcRnExpr hsc_env rdr_expr ...@@ -2022,6 +2027,12 @@ tcRnExpr hsc_env rdr_expr
-- irrelevant -- irrelevant
return (snd (normaliseType fam_envs Nominal ty)) return (snd (normaliseType fam_envs Nominal ty))
} }
where
-- See Note [Deeply instantiate in :type]
(inst, infer_mode, perhaps_disable_default_warnings) = case mode of
TM_Inst -> (True, NoRestrictions, id)
TM_NoInst -> (False, NoRestrictions, id)
TM_Default -> (True, EagerDefaulting, unsetWOptM Opt_WarnTypeDefaults)
-------------------------- --------------------------
tcRnImportDecls :: HscEnv tcRnImportDecls :: HscEnv
...@@ -2038,7 +2049,6 @@ tcRnImportDecls hsc_env import_decls ...@@ -2038,7 +2049,6 @@ tcRnImportDecls hsc_env import_decls
zap_rdr_env gbl_env = gbl_env { tcg_rdr_env = emptyGlobalRdrEnv } zap_rdr_env gbl_env = gbl_env { tcg_rdr_env = emptyGlobalRdrEnv }
-- tcRnType just finds the kind of a type -- tcRnType just finds the kind of a type
tcRnType :: HscEnv tcRnType :: HscEnv
-> Bool -- Normalise the returned type -> Bool -- Normalise the returned type
-> LHsType RdrName -> LHsType RdrName
...@@ -2073,20 +2083,63 @@ tcRnType hsc_env normalise rdr_type ...@@ -2073,20 +2083,63 @@ tcRnType hsc_env normalise rdr_type
; return (ty', mkInvForAllTys kvs (typeKind ty')) } ; return (ty', mkInvForAllTys kvs (typeKind ty')) }
{- Note [Deeply instantiate in :type] {- Note [TcRnExprMode]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~
Suppose (Trac #11376) How should we infer a type when a user asks for the type of an expression e
bar :: forall a b. Show a => a -> b -> a at the GHCi prompt? We offer 3 different possibilities, described below. Each
What should `:t bar @Int` show? considers this example, with -fprint-explicit-foralls enabled:
1. forall b. Show Int => Int -> b -> Int foo :: forall a f b. (Show a, Num b, Foldable f) => a -> f b -> String
2. forall b. Int -> b -> Int :type{,-spec,-def} foo @Int
3. forall {b}. Int -> b -> Int
4. Int -> b -> Int :type / TM_Inst
We choose (3), which is the effect of deeply instantiating and In this mode, we report the type that would be inferred if a variable
re-generalising. All the others seem deeply confusing. That is were assigned to expression e, without applying the monomorphism restriction.
why we deeply instantiate here. This means we deeply instantiate the type and then regeneralize, as discussed
in #11376.
> :type foo @Int
forall {b} {f :: * -> *}. (Foldable f, Num b) => Int -> f b -> String
Note that the variables and constraints are reordered here, because this
is possible during regeneralization. Also note that the variables are
reported as Invisible instead of Specified.
:type +v / TM_NoInst
This mode is for the benefit of users using TypeApplications. It does no
instantiation whatsoever, sometimes meaning that class constraints are not
solved.
> :type +v foo @Int
forall f b. (Show Int, Num b, Foldable f) => Int -> f b -> String
Note that Show Int is still reported, because the solver never got a chance
to see it.
:type +d / TM_Default
This mode is for the benefit of users who wish to see instantiations of
generalized types, and in particular to instantiate Foldable and Traversable.
In this mode, any type variable that can be defaulted is defaulted. Because
GHCi uses -XExtendedDefaultRules, this means that Foldable and Traversable are
defaulted.
> :type +d foo @Int
Int -> [Integer] -> String
Note that this mode can sometimes lead to a type error, if a type variable is
used with a defaultable class but cannot actually be defaulted:
bar :: (Num a, Monoid a) => a -> a
> :type +d bar
** error **
The error arises because GHC tries to default a but cannot find a concrete
type in the defaulting list that is both Num and Monoid. (If this list is
modified to include an element that is both Num and Monoid, the defaulting
would succeed, of course.)
Note [Kind-generalise in tcRnType] Note [Kind-generalise in tcRnType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module TcSimplify( module TcSimplify(
simplifyInfer, simplifyInfer, InferMode(..),
growThetaTyVars, growThetaTyVars,
simplifyAmbiguityCheck, simplifyAmbiguityCheck,
simplifyDefault, simplifyDefault,
...@@ -514,8 +514,22 @@ the let binding. ...@@ -514,8 +514,22 @@ the let binding.
-} -}
-- | How should we choose which constraints to quantify over?
data InferMode = ApplyMR -- ^ Apply the monomorphism restriction,
-- never quantifying over any constraints
| EagerDefaulting -- ^ See Note [TcRnExprMode] in TcRnDriver,
-- the :type +d case; this mode refuses
-- to quantify over any defaultable constraint
| NoRestrictions -- ^ Quantify over any constraint that
-- satisfies TcType.pickQuantifiablePreds
instance Outputable InferMode where
ppr ApplyMR = text "ApplyMR"
ppr EagerDefaulting = text "EagerDefaulting"
ppr NoRestrictions = text "NoRestrictions"
simplifyInfer :: TcLevel -- Used when generating the constraints simplifyInfer :: TcLevel -- Used when generating the constraints
-> Bool -- Apply monomorphism restriction -> InferMode
-> [TcIdSigInst] -- Any signatures (possibly partial) -> [TcIdSigInst] -- Any signatures (possibly partial)
-> [(Name, TcTauType)] -- Variables to be generalised, -> [(Name, TcTauType)] -- Variables to be generalised,
-- and their tau-types -- and their tau-types
...@@ -523,7 +537,7 @@ simplifyInfer :: TcLevel -- Used when generating the constraints ...@@ -523,7 +537,7 @@ simplifyInfer :: TcLevel -- Used when generating the constraints
-> TcM ([TcTyVar], -- Quantify over these type variables -> TcM ([TcTyVar], -- Quantify over these type variables
[EvVar], -- ... and these constraints (fully zonked) [EvVar], -- ... and these constraints (fully zonked)
TcEvBinds) -- ... binding these evidence variables TcEvBinds) -- ... binding these evidence variables
simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds
| isEmptyWC wanteds | isEmptyWC wanteds
= do { gbl_tvs <- tcGetGlobalTyCoVars = do { gbl_tvs <- tcGetGlobalTyCoVars
; dep_vars <- zonkTcTypesAndSplitDepVars (map snd name_taus) ; dep_vars <- zonkTcTypesAndSplitDepVars (map snd name_taus)
...@@ -536,7 +550,7 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds ...@@ -536,7 +550,7 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
[ text "sigs =" <+> ppr sigs [ text "sigs =" <+> ppr sigs
, text "binds =" <+> ppr name_taus , text "binds =" <+> ppr name_taus
, text "rhs_tclvl =" <+> ppr rhs_tclvl , text "rhs_tclvl =" <+> ppr rhs_tclvl
, text "apply_mr =" <+> ppr apply_mr , text "infer_mode =" <+> ppr infer_mode
, text "(unzonked) wanted =" <+> ppr wanteds , text "(unzonked) wanted =" <+> ppr wanteds
] ]
...@@ -616,7 +630,7 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds ...@@ -616,7 +630,7 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
-- Decide what type variables and constraints to quantify -- Decide what type variables and constraints to quantify
-- NB: bound_theta are constraints we want to quantify over, -- NB: bound_theta are constraints we want to quantify over,
-- /apart from/ the psig_theta, which we always quantify over -- /apart from/ the psig_theta, which we always quantify over
; (qtvs, bound_theta) <- decideQuantification apply_mr name_taus psig_theta ; (qtvs, bound_theta) <- decideQuantification infer_mode name_taus psig_theta
quant_pred_candidates quant_pred_candidates
-- Promote any type variables that are free in the inferred type -- Promote any type variables that are free in the inferred type
...@@ -763,23 +777,31 @@ including all covars -- and the quantified constraints are empty/insoluble. ...@@ -763,23 +777,31 @@ including all covars -- and the quantified constraints are empty/insoluble.
-} -}
decideQuantification decideQuantification
:: Bool -- try the MR restriction? :: InferMode
-> [(Name, TcTauType)] -- Variables to be generalised -> [(Name, TcTauType)] -- Variables to be generalised
-> [PredType] -- All annotated constraints from signatures -> [PredType] -- All annotated constraints from signatures
-> [PredType] -- Candidate theta -> [PredType] -- Candidate theta
-> TcM ( [TcTyVar] -- Quantify over these (skolems) -> TcM ( [TcTyVar] -- Quantify over these (skolems)
, [PredType] ) -- and this context (fully zonked) , [PredType] ) -- and this context (fully zonked)
-- See Note [Deciding quantification] -- See Note [Deciding quantification]
decideQuantification apply_mr name_taus psig_theta candidates decideQuantification infer_mode name_taus psig_theta candidates
= do { gbl_tvs <- tcGetGlobalTyCoVars = do { gbl_tvs <- tcGetGlobalTyCoVars
; zonked_taus <- mapM TcM.zonkTcType (psig_theta ++ taus) ; zonked_taus <- mapM TcM.zonkTcType (psig_theta ++ taus)
-- psig_theta: see Note [Quantification and partial signatures] -- psig_theta: see Note [Quantification and partial signatures]
; let DV { dv_kvs = zkvs, dv_tvs = ztvs} = splitDepVarsOfTypes zonked_taus ; ovl_strings <- xoptM LangExt.OverloadedStrings
; let DV {dv_kvs = zkvs, dv_tvs = ztvs} = splitDepVarsOfTypes zonked_taus
(gbl_cand, quant_cand) -- gbl_cand = do not quantify me (gbl_cand, quant_cand) -- gbl_cand = do not quantify me
= case apply_mr of -- quant_cand = try to quantify me = case infer_mode of -- quant_cand = try to quantify me
True -> (candidates, []) ApplyMR -> (candidates, [])
False -> ([], candidates) NoRestrictions -> ([], candidates)
zonked_tkvs = dVarSetToVarSet zkvs `unionVarSet` dVarSetToVarSet ztvs EagerDefaulting -> partition is_interactive_ct candidates
where
is_interactive_ct ct
| Just (cls, _) <- getClassPredTys_maybe ct
= isInteractiveClass ovl_strings cls
| otherwise
= False
eq_constraints = filter isEqPred quant_cand eq_constraints = filter isEqPred quant_cand
constrained_tvs = tyCoVarsOfTypes gbl_cand constrained_tvs = tyCoVarsOfTypes gbl_cand
mono_tvs = growThetaTyVars eq_constraints $ mono_tvs = growThetaTyVars eq_constraints $
...@@ -804,7 +826,10 @@ decideQuantification apply_mr name_taus psig_theta candidates ...@@ -804,7 +826,10 @@ decideQuantification apply_mr name_taus psig_theta candidates
-- Warn about the monomorphism restriction -- Warn about the monomorphism restriction
; warn_mono <- woptM Opt_WarnMonomorphism ; warn_mono <- woptM Opt_WarnMonomorphism
; let mr_bites = constrained_tvs `intersectsVarSet` zonked_tkvs ; let mr_bites | ApplyMR <- infer_mode
= constrained_tvs `intersectsVarSet` tcDepVarSet dvs_plus
| otherwise
= False
; warnTc (Reason Opt_WarnMonomorphism) (warn_mono && mr_bites) $ ; warnTc (Reason Opt_WarnMonomorphism) (warn_mono && mr_bites) $
hang (text "The Monomorphism Restriction applies to the binding" hang (text "The Monomorphism Restriction applies to the binding"
<> plural bndrs <+> text "for" <+> pp_bndrs) <> plural bndrs <+> text "for" <+> pp_bndrs)
...@@ -812,8 +837,9 @@ decideQuantification apply_mr name_taus psig_theta candidates ...@@ -812,8 +837,9 @@ decideQuantification apply_mr name_taus psig_theta candidates
<+> if isSingleton bndrs then pp_bndrs <+> if isSingleton bndrs then pp_bndrs
else text "these binders") else text "these binders")
; traceTc "decideQuantification 2" ; traceTc "decideQuantification"
(vcat [ text "gbl_cand:" <+> ppr gbl_cand (vcat [ text "infer_mode:" <+> ppr infer_mode
, text "gbl_cand:" <+> ppr gbl_cand
, text "quant_cand:" <+> ppr quant_cand , text "quant_cand:" <+> ppr quant_cand
, text "gbl_tvs:" <+> ppr gbl_tvs , text "gbl_tvs:" <+> ppr gbl_tvs
, text "mono_tvs:" <+> ppr mono_tvs , text "mono_tvs:" <+> ppr mono_tvs
...@@ -1676,7 +1702,7 @@ approximateWC to produce a list of candidate constraints. Then we MUST ...@@ -1676,7 +1702,7 @@ approximateWC to produce a list of candidate constraints. Then we MUST
approximateWC, to restore invariant (MetaTvInv) described in approximateWC, to restore invariant (MetaTvInv) described in
Note [TcLevel and untouchable type variables] in TcType. Note [TcLevel and untouchable type variables] in TcType.
b) Default the kind of any meta-tyyvars that are not mentioned in b) Default the kind of any meta-tyvars that are not mentioned in
in the environment. in the environment.
To see (b), suppose the constraint is (C ((a :: OpenKind) -> Int)), and we To see (b), suppose the constraint is (C ((a :: OpenKind) -> Int)), and we
...@@ -1994,22 +2020,13 @@ findDefaultableGroups (default_tys, (ovl_strings, extended_defaults)) wanteds ...@@ -1994,22 +2020,13 @@ findDefaultableGroups (default_tys, (ovl_strings, extended_defaults)) wanteds
in b1 && b2 in b1 && b2
defaultable_classes clss defaultable_classes clss
| extended_defaults = any isInteractiveClass clss | extended_defaults = any (isInteractiveClass ovl_strings) clss
| otherwise = all is_std_class clss && (any is_num_class clss) | otherwise = all is_std_class clss && (any (isNumClass ovl_strings) clss)
-- In interactive mode, or with -XExtendedDefaultRules,
-- we default Show a to Show () to avoid graututious errors on "show []"
isInteractiveClass cls
= is_num_class cls || (classKey cls `elem` [showClassKey, eqClassKey
, ordClassKey, foldableClassKey
, traversableClassKey])
is_num_class cls = isNumericClass cls || (ovl_strings && (cls `hasKey` isStringClassKey))
-- is_num_class adds IsString to the standard numeric classes,
-- when -foverloaded-strings is enabled
is_std_class cls = isStandardClass cls || (ovl_strings && (cls `hasKey` isStringClassKey)) -- is_std_class adds IsString to the standard numeric classes,
-- Similarly is_std_class -- when -foverloaded-strings is enabled
is_std_class cls = isStandardClass cls ||
(ovl_strings && (cls `hasKey` isStringClassKey))
------------------------------ ------------------------------
disambigGroup :: [Type] -- The default types disambigGroup :: [Type] -- The default types
...@@ -2061,6 +2078,20 @@ disambigGroup (default_ty:default_tys) group@(the_tv, wanteds) ...@@ -2061,6 +2078,20 @@ disambigGroup (default_ty:default_tys) group@(the_tv, wanteds)
-- With the addition of polykinded defaulting we also want to reject -- With the addition of polykinded defaulting we also want to reject
-- ill-kinded defaulting attempts like (Eq []) or (Foldable Int) here. -- ill-kinded defaulting attempts like (Eq []) or (Foldable Int) here.
-- In interactive mode, or with -XExtendedDefaultRules,
-- we default Show a to Show () to avoid graututious errors on "show []"
isInteractiveClass :: Bool -- -XOverloadedStrings?
-> Class -> Bool
isInteractiveClass ovl_strings cls
= isNumClass ovl_strings cls || (classKey cls `elem` interactiveClassKeys)
-- isNumClass adds IsString to the standard numeric classes,
-- when -foverloaded-strings is enabled
isNumClass :: Bool -- -XOverloadedStrings?
-> Class -> Bool
isNumClass ovl_strings cls
= isNumericClass cls || (ovl_strings && (cls `hasKey` isStringClassKey))
{- {-
Note [Avoiding spurious errors] Note [Avoiding spurious errors]
......
...@@ -977,6 +977,10 @@ Type defaulting in GHCi ...@@ -977,6 +977,10 @@ Type defaulting in GHCi
single: Type defaulting; in GHCi single: Type defaulting; in GHCi
single: Show class single: Show class
.. ghc-flag:: -XExtendedDefaultRules
Allow defaulting to take place for more than just numeric classes.
Consider this GHCi session: Consider this GHCi session:
.. code-block:: none .. code-block:: none
...@@ -1014,7 +1018,7 @@ is given, the following additional differences apply: ...@@ -1014,7 +1018,7 @@ is given, the following additional differences apply:
single-parameter type classes. single-parameter type classes.