Extended default rules now specialize Foldable, Traversable to [] (#10971)

Default rules deliberately accept any kind.

Reviewed By: simonpj, thomie, goldfire

Differential Revision: https://phabricator.haskell.org/D1329

compiler/typecheck/TcEnv.hs

@@ -633,16 +633,18 @@ tcGetDefaultTys
         { integer_ty <- tcMetaTy integerTyConName
         ; checkWiredInTyCon doubleTyCon
         ; string_ty <- tcMetaTy stringTyConName
-        ; let deflt_tys = opt_deflt extended_defaults unitTy  -- Note [Default unitTy]
+        ; list_ty <- tcMetaTy listTyConName
+        ; let deflt_tys = opt_deflt extended_defaults [unitTy, list_ty]
+                          -- Note [Extended defaults]
                           ++ [integer_ty, doubleTy]
-                          ++ opt_deflt ovl_strings string_ty
+                          ++ opt_deflt ovl_strings [string_ty]
         ; return (deflt_tys, flags) } } }
   where
-    opt_deflt True  ty = [ty]
+    opt_deflt True  xs = xs
     opt_deflt False _  = []
 
 {-
-Note [Default unitTy]
+Note [Extended defaults]
 ~~~~~~~~~~~~~~~~~~~~~
 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
 try when defaulting.  This has very little real impact, except in the following case.
@@ -654,6 +656,9 @@ default the 'a' to (), rather than to Integer (which is what would otherwise hap
 and then GHCi doesn't attempt to print the ().  So in interactive mode, we add
 () to the list of defaulting types.  See Trac #1200.
 
+Additonally, the list type [] is added as a default specialization for
+Traversable and Foldable. As such the default default list now has types of
+varying kinds, e.g. ([] :: * -> *)  and (Integer :: *).
 
 ************************************************************************
 *                                                                      *

compiler/typecheck/TcSimplify.hs

@@ -1793,7 +1793,9 @@ findDefaultableGroups (default_tys, (ovl_strings, extended_defaults)) wanteds
     -- 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])
+        = 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,
@@ -1847,6 +1849,8 @@ disambigGroup (default_ty:default_tys) group@(the_tv, wanteds)
     mb_subst = tcMatchTy tmpl_tvs (mkTyVarTy the_tv) default_ty
       -- Make sure the kinds match too; hence this call to tcMatchTy
       -- E.g. suppose the only constraint was (Typeable k (a::k))
+      -- With the addition of polykinded defaulting we also want to reject
+      -- ill-kinded defaulting attempts like (Eq []) or (Foldable Int) here.
 
 
 {-

compiler/typecheck/TcValidity.hs

@@ -346,13 +346,16 @@ check_kind ctxt ty
 -- Depending on the context, we might accept any kind (for instance, in a TH
 -- splice), or only certain kinds (like in type signatures).
 expectedKindInCtxt :: UserTypeCtxt -> Maybe Kind
-expectedKindInCtxt (TySynCtxt _)  = Nothing -- Any kind will do
-expectedKindInCtxt ThBrackCtxt    = Nothing
-expectedKindInCtxt GhciCtxt       = Nothing
-expectedKindInCtxt (ForSigCtxt _) = Just liftedTypeKind
-expectedKindInCtxt InstDeclCtxt   = Just constraintKind
-expectedKindInCtxt SpecInstCtxt   = Just constraintKind
-expectedKindInCtxt _              = Just openTypeKind
+expectedKindInCtxt (TySynCtxt _)   = Nothing -- Any kind will do
+expectedKindInCtxt ThBrackCtxt     = Nothing
+expectedKindInCtxt GhciCtxt        = Nothing
+-- The types in a 'default' decl can have varying kinds
+-- See Note [Extended defaults]" in TcEnv
+expectedKindInCtxt DefaultDeclCtxt = Nothing
+expectedKindInCtxt (ForSigCtxt _)  = Just liftedTypeKind
+expectedKindInCtxt InstDeclCtxt    = Just constraintKind
+expectedKindInCtxt SpecInstCtxt    = Just constraintKind
+expectedKindInCtxt _               = Just openTypeKind
 
 {-
 Note [Higher rank types]

docs/users_guide/ghci.rst

@@ -1022,10 +1022,10 @@ is given, the following additional differences apply:
    single-parameter type classes.
 
 -  Rule 3 above is relaxed this: At least one of the classes ``Ci`` is
-   numeric, or is ``Show``, ``Eq``, or ``Ord``.
+   numeric, or is ``Show``, ``Eq``, ``Ord``, ``Foldable`` or ``Traversable``.
 
--  The unit type ``()`` is added to the start of the standard list of
-   types which are tried when doing type defaulting.
+-  The unit type ``()`` and the list type ``[]`` are added to the start of
+   the standard list of types which are tried when doing type defaulting.
 
 The last point means that, for example, this program:
 

testsuite/tests/typecheck/should_compile/T10971a.hs

+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE MonomorphismRestriction, ExtendedDefaultRules #-}
+module T10971a where
+
+import Data.Traversable (fmapDefault)
+
+f = \x -> length x
+g = \f x -> fmapDefault f x
+h = \f x -> (fmapDefault f x, length x)

testsuite/tests/typecheck/should_compile/T10971a.stderr

+
+T10971a.hs:7:1: warning:
+    Top-level binding with no type signature: f :: forall a. [a] -> Int
+
+T10971a.hs:7:11: warning:
+    Defaulting the following constraint(s) to type ‘[]’
+      Foldable t0 arising from a use of ‘length’
+    In the expression: length x
+    In the expression: \ x -> length x
+    In an equation for ‘f’: f = \ x -> length x
+
+T10971a.hs:8:1: warning:
+    Top-level binding with no type signature:
+      g :: forall a b. (a -> b) -> [a] -> [b]
+
+T10971a.hs:8:6: warning:
+    This binding for ‘f’ shadows the existing binding
+      defined at T10971a.hs:7:1
+
+T10971a.hs:8:13: warning:
+    Defaulting the following constraint(s) to type ‘[]’
+      Traversable t0 arising from a use of ‘fmapDefault’
+    In the expression: fmapDefault f x
+    In the expression: \ f x -> fmapDefault f x
+    In an equation for ‘g’: g = \ f x -> fmapDefault f x
+
+T10971a.hs:9:1: warning:
+    Top-level binding with no type signature:
+      h :: forall b a. (a -> b) -> [a] -> ([b], Int)
+
+T10971a.hs:9:6: warning:
+    This binding for ‘f’ shadows the existing binding
+      defined at T10971a.hs:7:1
+
+T10971a.hs:9:31: warning:
+    Defaulting the following constraint(s) to type ‘[]’
+      (Foldable t0) arising from a use of ‘length’ at T10971a.hs:9:31-36
+      (Traversable t0)
+        arising from a use of ‘fmapDefault’ at T10971a.hs:9:14-24
+    In the expression: length x
+    In the expression: (fmapDefault f x, length x)
+    In the expression: \ f x -> (fmapDefault f x, length x)

testsuite/tests/typecheck/should_compile/all.T

@@ -478,3 +478,4 @@ test('T10347', expect_broken(10347), compile, [''])
 test('T10770a', expect_broken(10770), compile, [''])
 test('T10770b', expect_broken(10770), compile, [''])
 test('T10935', normal, compile, [''])
+test('T10971a', normal, compile, [''])

testsuite/tests/typecheck/should_fail/T10971b.hs

+{-# LANGUAGE MonomorphismRestriction, NoExtendedDefaultRules #-}
+module T10971b where
+import Data.Traversable (fmapDefault)
+f = \x -> length x
+g = \f x -> fmapDefault f x
+h = \f x -> (fmapDefault f x, length x)

testsuite/tests/typecheck/should_fail/T10971b.stderr

+
+T10971b.hs:4:11: error:
+    Ambiguous type variable ‘t2’ arising from a use of ‘length’
+    prevents the constraint ‘(Foldable t2)’ from being solved.
+    Relevant bindings include
+      x :: t2 a (bound at T10971b.hs:4:6)
+      f :: t2 a -> Int (bound at T10971b.hs:4:1)
+    Probable fix: use a type annotation to specify what ‘t2’ should be.
+    These potential instances exist:
+      instance Foldable (Const m) -- Defined in ‘Control.Applicative’
+      instance Foldable ZipList -- Defined in ‘Control.Applicative’
+      instance Foldable (Either a) -- Defined in ‘Data.Foldable’
+      ...plus 10 others
+      (use -fprint-potential-instances to see them all)
+    In the expression: length x
+    In the expression: \ x -> length x
+    In an equation for ‘f’: f = \ x -> length x
+
+T10971b.hs:5:13: error:
+    Ambiguous type variable ‘t1’ arising from a use of ‘fmapDefault’
+    prevents the constraint ‘(Traversable t1)’ from being solved.
+    Relevant bindings include
+      x :: t1 a (bound at T10971b.hs:5:8)
+      g :: (a -> b) -> t1 a -> t1 b (bound at T10971b.hs:5:1)
+    Probable fix: use a type annotation to specify what ‘t1’ should be.
+    These potential instances exist:
+      instance Traversable (Const m) -- Defined in ‘Data.Traversable’
+      instance Traversable ZipList -- Defined in ‘Data.Traversable’
+      instance Traversable (Either a) -- Defined in ‘Data.Traversable’
+      ...plus 10 others
+      (use -fprint-potential-instances to see them all)
+    In the expression: fmapDefault f x
+    In the expression: \ f x -> fmapDefault f x
+    In an equation for ‘g’: g = \ f x -> fmapDefault f x
+
+T10971b.hs:6:14: error:
+    Ambiguous type variable ‘t0’ arising from a use of ‘fmapDefault’
+    prevents the constraint ‘(Traversable t0)’ from being solved.
+    Relevant bindings include
+      x :: t0 a (bound at T10971b.hs:6:8)
+      h :: (a -> b) -> t0 a -> (t0 b, Int) (bound at T10971b.hs:6:1)
+    Probable fix: use a type annotation to specify what ‘t0’ should be.
+    These potential instances exist:
+      instance Traversable (Const m) -- Defined in ‘Data.Traversable’
+      instance Traversable ZipList -- Defined in ‘Data.Traversable’
+      instance Traversable (Either a) -- Defined in ‘Data.Traversable’
+      ...plus 10 others
+      (use -fprint-potential-instances to see them all)
+    In the expression: fmapDefault f x
+    In the expression: (fmapDefault f x, length x)
+    In the expression: \ f x -> (fmapDefault f x, length x)
+
+T10971b.hs:6:31: error:
+    Ambiguous type variable ‘t0’ arising from a use of ‘length’
+    prevents the constraint ‘(Foldable t0)’ from being solved.
+    Relevant bindings include
+      x :: t0 a (bound at T10971b.hs:6:8)
+      h :: (a -> b) -> t0 a -> (t0 b, Int) (bound at T10971b.hs:6:1)
+    Probable fix: use a type annotation to specify what ‘t0’ should be.
+    These potential instances exist:
+      instance Foldable (Const m) -- Defined in ‘Control.Applicative’
+      instance Foldable ZipList -- Defined in ‘Control.Applicative’
+      instance Foldable (Either a) -- Defined in ‘Data.Foldable’
+      ...plus 10 others
+      (use -fprint-potential-instances to see them all)
+    In the expression: length x
+    In the expression: (fmapDefault f x, length x)
+    In the expression: \ f x -> (fmapDefault f x, length x)

testsuite/tests/typecheck/should_fail/T10971c.hs

+{-# LANGUAGE MonomorphismRestriction, ExtendedDefaultRules #-}
+module T10971c where
+
+import Data.Traversable (fmapDefault)
+
+f = \x -> length x
+g = \f x -> fmapDefault f x
+h = \f x -> (fmapDefault f x, length x)

testsuite/tests/typecheck/should_fail/T10971d.hs

+import T10971c
+
+main = do
+  print $ f (Just 1)
+  print $ g (+1) (Just 5)
+  print $ h (const 5) Nothing

testsuite/tests/typecheck/should_fail/T10971d.stderr

+
+T10971d.hs:4:14: error:
+    Couldn't match expected type ‘[a0]’
+                with actual type ‘Maybe Integer’
+    In the first argument of ‘f’, namely ‘(Just 1)’
+    In the second argument of ‘($)’, namely ‘f (Just 1)’
+
+T10971d.hs:5:19: error:
+    Couldn't match expected type ‘[Integer]’
+                with actual type ‘Maybe Integer’
+    In the second argument of ‘g’, namely ‘(Just 5)’
+    In the second argument of ‘($)’, namely ‘g (+ 1) (Just 5)’
+
+T10971d.hs:6:23: error:
+    Couldn't match expected type ‘[b0]’ with actual type ‘Maybe a1’
+    In the second argument of ‘h’, namely ‘Nothing’
+    In the second argument of ‘($)’, namely ‘h (const 5) Nothing’

testsuite/tests/typecheck/should_fail/all.T

@@ -388,3 +388,5 @@ test('T10698', expect_broken(10698), compile_fail, [''])
 test('T10836', normal, compile_fail, [''])
 test('T10715', normal, compile_fail, [''])
 test('T10715b', normal, compile_fail, [''])
+test('T10971b', normal, compile_fail, [''])
+test('T10971d', extra_clean(['T10971c.hi', 'T10971c.o']), multimod_compile_fail, ['T10971d','-v0'])