Commit 041c35e5 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Fix defaulting for overloaded strings

This patch fixes the typechecking of the default declaration itself,
when overloaded strings are involved.  It also documents the behaviour
in the user manual.

nofib/spectral/power should work again now!
parent b2b9ba4a
......@@ -11,13 +11,16 @@ module TcDefaults ( tcDefaults ) where
import HsSyn
import Name
import Class
import TcRnMonad
import TcEnv
import TcHsType
import TcSimplify
import TcType
import PrelNames
import DynFlags
import SrcLoc
import Maybe
import Outputable
\end{code}
......@@ -45,29 +48,38 @@ tcDefaults [L locn (DefaultDecl [])]
tcDefaults [L locn (DefaultDecl mono_tys)]
= setSrcSpan locn $
addErrCtxt defaultDeclCtxt $
tcLookupClass numClassName `thenM` \ num_class ->
tcLookupClass isStringClassName `thenM` \ num_class ->
mappM tc_default_ty mono_tys `thenM` \ tau_tys ->
do { ovl_str <- doptM Opt_OverloadedStrings
; num_class <- tcLookupClass numClassName
; is_str_class <- tcLookupClass isStringClassName
; let deflt_clss | ovl_str = [num_class, is_str_class]
| otherwise = [num_class]
-- Check that all the types are instances of Num
-- We only care about whether it worked or not
tcSimplifyDefault [mkClassPred num_class [ty] | ty <- tau_tys] `thenM_`
; tau_tys <- mappM (tc_default_ty deflt_clss) mono_tys
returnM (Just tau_tys)
; return (Just tau_tys) }
tcDefaults decls@(L locn (DefaultDecl _) : _) =
setSrcSpan locn $
tcDefaults decls@(L locn (DefaultDecl _) : _)
= setSrcSpan locn $
failWithTc (dupDefaultDeclErr decls)
tc_default_ty hs_ty
= tcHsSigType DefaultDeclCtxt hs_ty `thenM` \ ty ->
checkTc (isTauTy ty) (polyDefErr hs_ty) `thenM_`
returnM ty
tc_default_ty deflt_clss hs_ty
= do { ty <- tcHsSigType DefaultDeclCtxt hs_ty
; checkTc (isTauTy ty) (polyDefErr hs_ty)
-- Check that the type is an instance of at least one of the deflt_clss
; oks <- mapM (check_instance ty) deflt_clss
; checkTc (or oks) (badDefaultTy ty deflt_clss)
; return ty }
defaultDeclCtxt = ptext SLIT("when checking that each type in a default declaration")
$$ ptext SLIT("is an instance of class Num")
check_instance :: Type -> Class -> TcM Bool
-- Check that ty is an instance of cls
-- We only care about whether it worked or not; return a boolean
check_instance ty cls
= do { (_, mb_res) <- tryTc (tcSimplifyDefault [mkClassPred cls [ty]])
; return (isJust mb_res) }
defaultDeclCtxt = ptext SLIT("When checking the types in a default declaration")
dupDefaultDeclErr (L _ (DefaultDecl _) : dup_things)
= hang (ptext SLIT("Multiple default declarations"))
......@@ -77,5 +89,9 @@ dupDefaultDeclErr (L _ (DefaultDecl _) : dup_things)
polyDefErr ty
= hang (ptext SLIT("Illegal polymorphic type in default declaration") <> colon) 4 (ppr ty)
badDefaultTy ty deflt_clss
= hang (ptext SLIT("The default type") <+> quotes (ppr ty) <+> ptext SLIT("is not an instance of"))
2 (foldr1 (\a b -> a <+> ptext SLIT("or") <+> b) (map (quotes. ppr) deflt_clss))
\end{code}
......@@ -2194,9 +2194,8 @@ tc_simplify_top doc interactive wanteds
-- OK, so there are some errors
{ -- Use the defaulting rules to do extra unification
-- NB: irreds are already zonked
; extended_default <- if interactive then return True
else doptM Opt_ExtendedDefaultRules
; disambiguate extended_default irreds1 -- Does unification
; dflags <- getDOpts
; disambiguate interactive dflags irreds1 -- Does unification
; (irreds2, binds2) <- topCheckLoop doc irreds1
-- Deal with implicit parameter
......@@ -2244,10 +2243,10 @@ Since we're not using the result of @foo@, the result if (presumably)
@void@.
\begin{code}
disambiguate :: Bool -> [Inst] -> TcM ()
disambiguate :: Bool -> DynFlags -> [Inst] -> TcM ()
-- Just does unification to fix the default types
-- The Insts are assumed to be pre-zonked
disambiguate extended_defaulting insts
disambiguate interactive dflags insts
| null defaultable_groups
= do { traceTc (text "disambigutate" <+> vcat [ppr unaries, ppr bad_tvs, ppr defaultable_groups])
; return () }
......@@ -2261,14 +2260,16 @@ disambiguate extended_defaulting insts
do { integer_ty <- tcMetaTy integerTyConName
; checkWiredInTyCon doubleTyCon
; string_ty <- tcMetaTy stringTyConName
; ovl_str <- doptM Opt_OverloadedStrings
; if ovl_str -- Add String if -foverloaded-strings
; if ovl_strings -- 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
extended_defaulting = interactive || dopt Opt_ExtendedDefaultRules dflags
ovl_strings = dopt Opt_OverloadedStrings dflags
unaries :: [(Inst,Class, TcTyVar)] -- (C tv) constraints
bad_tvs :: TcTyVarSet -- Tyvars mentioned by *other* constraints
(unaries, bad_tvs) = getDefaultableDicts insts
......@@ -2287,14 +2288,19 @@ disambiguate extended_defaulting insts
defaultable_classes clss
| extended_defaulting = any isInteractiveClass clss
| otherwise = all isStandardClass clss && (any isNumericClass clss || any ((== isStringClassKey) . classKey) clss)
| otherwise = all is_std_class clss && (any is_num_class 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, isStringClassKey])
= is_num_class cls || (classKey cls `elem` [showClassKey, eqClassKey, ordClassKey])
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))
-- Similarly is_std_class
disambigGroup :: [Type] -- The default types
-> [(Inst,Class,TcTyVar)] -- All standard classes of form (C a)
......
......@@ -4086,15 +4086,39 @@ The class <literal>IsString</literal> is defined as:
class IsString a where
fromString :: String -> a
</programlisting>
And the only predefined instance is the obvious one to make strings work as usual:
The only predefined instance is the obvious one to make strings work as usual:
<programlisting>
instance IsString [Char] where
fromString cs = cs
</programlisting>
The class <literal>IsString</literal> is not in scope by default. If you want to mention
it explicitly (for exmaple, to give an instance declaration for it), you can import it
from module <literal>GHC.Exts</literal>.
</para>
<para>
Haskell's defaulting mechanism is extended to cover string literals, when <option>-foverloaded-strings</option> is specified.
Specifically:
<itemizedlist>
<listitem><para>
Each type in a default declaration must be an
instance of <literal>Num</literal> <emphasis>or</emphasis> of <literal>IsString</literal>.
</para></listitem>
<listitem><para>
The standard defaulting rule (<ulink url="http://haskell.org/onlinereport/decls.html#sect4.3.4">Haskell Report, Section 4.3.4</ulink>)
is extended thus: defaulting applies when all the unresolved constraints involve standard classes
<emphasis>or</emphasis> <literal>IsString</literal>; and at least one is a numeric class
<emphasis>or</emphasis> <literal>IsString</literal>.
</para></listitem>
</itemizedlist>
</para>
<para>
A small example:
<programlisting>
module Main where
import GHC.Exts( IsString(..) )
newtype MyString = MyString String deriving (Eq, Show)
instance IsString MyString where
fromString = MyString
......
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