-- The givens can include methods
-- See Note [Pruning the givens in an implication constraint]
- -- If there are no 'givens', then it's safe to
+ -- If there are no 'givens' *and* the refinement is empty
+ -- (the refinement is like more givens), then it's safe to
-- partition the 'wanteds' by their qtvs, thereby trimming irreds
-- See Note [Freeness and implications]
- ; irreds' <- if null givens'
+ ; irreds' <- if null givens' && isEmptyRefinement reft
then do
{ let qtv_set = mkVarSet qtvs
(frees, real_irreds) = partition (isFreeWrtTyVars qtv_set) irreds
; let all_tvs = qtvs ++ co_vars -- Abstract over all these
; (implics, bind) <- makeImplicationBind loc all_tvs reft givens' irreds'
- -- This call does the real work
+ -- This call does the real work
+ -- If irreds' is empty, it does something sensible
; extendLIEs implics
; return bind }
-- The binding looks like
-- (ir1, .., irn) = f qtvs givens
-- where f is (evidence for) the new implication constraint
+-- f :: forall qtvs. {reft} givens => (ir1, .., irn)
+-- qtvs includes coercion variables
--
-- This binding must line up the 'rhs' in reduceImplication
makeImplicationBind loc all_tvs reft
-- use [Integer, Double]
do { integer_ty <- tcMetaTy integerTyConName
; checkWiredInTyCon doubleTyCon
- ; return [integer_ty, doubleTy] }
+ ; string_ty <- tcMetaTy stringTyConName
+ ; ovl_str <- doptM Opt_OverloadedStrings
+ ; if ovl_str -- Add String if -foverloaded-strings
+ then return [integer_ty,doubleTy,string_ty]
+ else return [integer_ty,doubleTy] }
+
; traceTc (text "disambigutate" <+> vcat [ppr unaries, ppr bad_tvs, ppr defaultable_groups])
; mapM_ (disambigGroup default_tys) defaultable_groups }
where
defaultable_group :: [(Inst,Class,TcTyVar)] -> Bool
defaultable_group ds@((_,_,tv):_)
- = not (isImmutableTyVar tv) -- Note [Avoiding spurious errors]
+ = isTyConableTyVar tv -- Note [Avoiding spurious errors]
&& not (tv `elemVarSet` bad_tvs)
&& defaultable_classes [c | (_,c,_) <- ds]
defaultable_group [] = panic "defaultable_group"
defaultable_classes clss
| extended_defaulting = any isInteractiveClass clss
- | otherwise = all isStandardClass clss && any isNumericClass clss
+ | otherwise = all isStandardClass clss && (any isNumericClass clss || any ((== isStringClassKey) . classKey) clss)
-- In interactive mode, or with -fextended-default-rules,
-- we default Show a to Show () to avoid graututious errors on "show []"
isInteractiveClass cls
= isNumericClass cls
- || (classKey cls `elem` [showClassKey, eqClassKey, ordClassKey])
+ || (classKey cls `elem` [showClassKey, eqClassKey, ordClassKey, isStringClassKey])
disambigGroup :: [Type] -- The default types
; wanteds <- newDictBndrsO orig (substTheta tenv theta)
; (irreds, _) <- topCheckLoop doc wanteds
- ; let (dicts, non_dicts) = partition isDict irreds
- -- Exclude implication consraints
- ; addNoInstanceErrs non_dicts -- I'm not sure if these can really happen
+ -- Insist that the context of a derived instance declaration
+ -- consists of constraints of form (C a b), where a,b are
+ -- type variables
+ -- NB: the caller will further check the tv_dicts for
+ -- legal instance-declaration form
+ ; let (tv_dicts, non_tv_dicts) = partition isTyVarDict irreds
+ ; addNoInstanceErrs non_tv_dicts
; let rev_env = zipTopTvSubst tvs (mkTyVarTys tyvars)
- simpl_theta = substTheta rev_env (map dictPred dicts)
- -- This reverse-mapping is a Royal Pain,
- -- but the result should mention TyVars not TcTyVars
+ simpl_theta = substTheta rev_env (map dictPred tv_dicts)
+ -- This reverse-mapping is a pain, but the result
+ -- should mention the original TyVars not TcTyVars
; return simpl_theta }
where