Implement #5462 (deriving clause for arbitrary classes)
authorJose Pedro Magalhaes <jpm@cs.ox.ac.uk>
Fri, 21 Nov 2014 04:41:28 +0000 (22:41 -0600)
committerAustin Seipp <austin@well-typed.com>
Fri, 21 Nov 2014 04:41:29 +0000 (22:41 -0600)
Summary: (this has been submitted on behalf on @dreixel)

Reviewers: simonpj, hvr, austin

Reviewed By: simonpj, austin

Subscribers: goldfire, thomie, carter, dreixel

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

GHC Trac Issues: #5462

17 files changed:
compiler/basicTypes/BasicTypes.lhs
compiler/main/DynFlags.hs
compiler/typecheck/TcDeriv.lhs
compiler/typecheck/TcGenDeriv.lhs
docs/users_guide/flags.xml
docs/users_guide/glasgow_exts.xml
testsuite/tests/driver/T4437.hs
testsuite/tests/generics/GEnum/Enum.hs [new file with mode: 0644]
testsuite/tests/generics/GEq/GEq1A.hs
testsuite/tests/generics/T5462No1.hs [new file with mode: 0644]
testsuite/tests/generics/T5462No1.stderr [new file with mode: 0644]
testsuite/tests/generics/T5462Yes1.hs [new file with mode: 0644]
testsuite/tests/generics/T5462Yes1.stdout [new file with mode: 0644]
testsuite/tests/generics/T5462Yes2.hs [new file with mode: 0644]
testsuite/tests/generics/T5462Yes2.stdout [new file with mode: 0644]
testsuite/tests/generics/all.T
testsuite/tests/module/mod53.stderr

index 4fbfb60..252d0fe 100644 (file)
@@ -736,6 +736,7 @@ Class object.
 data DefMethSpec = NoDM        -- No default method
                  | VanillaDM   -- Default method given with polymorphic code
                  | GenericDM   -- Default method given with generic code
+  deriving Eq
 
 instance Outputable DefMethSpec where
   ppr NoDM      = empty
index 3fa2c5f..9105d7f 100644 (file)
@@ -564,6 +564,7 @@ data ExtensionFlag
    | Opt_DeriveFoldable
    | Opt_DeriveGeneric            -- Allow deriving Generic/1
    | Opt_DefaultSignatures        -- Allow extra signatures for defmeths
+   | Opt_DeriveAnyClass           -- Allow deriving any class
 
    | Opt_TypeSynonymInstances
    | Opt_FlexibleContexts
@@ -2873,6 +2874,7 @@ xFlags = [
              $ deprecate $ "It was widely considered a misfeature, " ++
                            "and has been removed from the Haskell language." ),
   ( "DefaultSignatures",                Opt_DefaultSignatures, nop ),
+  ( "DeriveAnyClass",                   Opt_DeriveAnyClass, nop ),
   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, nop ),
   ( "DeriveFoldable",                   Opt_DeriveFoldable, nop ),
   ( "DeriveFunctor",                    Opt_DeriveFunctor, nop ),
index c662b18..c76d19e 100644 (file)
@@ -530,8 +530,8 @@ makeDerivSpecs is_boot tycl_decls inst_decls deriv_decls
 
         -- If AutoDeriveTypeable is set, we automatically add Typeable instances
         -- for every data type and type class declared in the module
-       ; auto_typeable <- xoptM Opt_AutoDeriveTypeable
-       ; eqns4 <- deriveAutoTypeable auto_typeable (eqns1 ++ eqns3) tycl_decls
+        ; auto_typeable <- xoptM Opt_AutoDeriveTypeable
+        ; eqns4 <- deriveAutoTypeable auto_typeable (eqns1 ++ eqns3) tycl_decls
 
         ; let eqns = eqns1 ++ eqns2 ++ eqns3 ++ eqns4
 
@@ -782,7 +782,7 @@ deriveTyData is_instance tvs tc tc_args (L loc deriv_pred)
                 --              newtype K a a = ... deriving( Monad )
 
         ; spec <- mkEqnHelp Nothing (univ_kvs' ++ univ_tvs')
-                            cls final_cls_tys tc final_tc_args Nothing 
+                            cls final_cls_tys tc final_tc_args Nothing
         ; return [spec] } }
 
 derivePolyKindedTypeable :: Bool -> Class -> [Type]
@@ -1001,9 +1001,10 @@ mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
               tycon tc_args rep_tc rep_tc_args mtheta
   = case checkSideConditions dflags mtheta cls cls_tys rep_tc rep_tc_args of
         -- NB: pass the *representation* tycon to checkSideConditions
-        CanDerive               -> go_for_it
-        NonDerivableClass       -> bale_out (nonStdErr cls)
+        NonDerivableClass   msg -> bale_out (nonStdErr cls $$ msg)
         DerivableClassError msg -> bale_out msg
+        CanDerive               -> go_for_it
+        DerivableViaInstance    -> go_for_it
   where
     go_for_it    = mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tc rep_tc_args mtheta
     bale_out msg = failWithTc (derivingThingErr False cls cls_tys (mkTyConApp tycon tc_args) msg)
@@ -1049,7 +1050,7 @@ mkPolyKindedTypeableEqn cls tc
                     2 (ptext (sLit "You need DeriveDataTypeable to derive Typeable instances")))
 
        ; loc <- getSrcSpanM
-       ; let prom_dcs = mapMaybe promoteDataCon_maybe (tyConDataCons tc) 
+       ; let prom_dcs = mapMaybe promoteDataCon_maybe (tyConDataCons tc)
        ; mapM (mk_one loc) (tc : prom_dcs) }
   where
      mk_one loc tc = do { traceTc "mkPolyKindedTypeableEqn" (ppr tc)
@@ -1112,7 +1113,11 @@ inferConstraints cls inst_tys rep_tc rep_tc_args
                 -- (a) We recurse over argument types to generate constraints
                 --     See Functor examples in TcGenDeriv
                 -- (b) The rep_tc_args will be one short
-    is_functor_like = getUnique cls `elem` functorLikeClassKeys
+    is_functor_like =    getUnique cls `elem` functorLikeClassKeys
+                      || onlyOneAndTypeConstr inst_tys
+    onlyOneAndTypeConstr [inst_ty] =
+      typeKind inst_ty `tcEqKind` mkArrowKind liftedTypeKind liftedTypeKind
+    onlyOneAndTypeConstr _         = False
 
     get_std_constrained_tys :: Type -> [Type]
     get_std_constrained_tys ty
@@ -1165,6 +1170,37 @@ We have some special hacks to support things like
 Specifically, we use TcGenDeriv.box_if_necy to box the Int# into an Int
 (which we know how to show). It's a bit ad hoc.
 
+Note [Deriving any class]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Currently, you can use a deriving clause, or standalone-deriving declaration,
+only for:
+  *  a built-in class like Eq or Show, for which GHC knows how to generate
+     the instance code
+  * a newtype, via the "newtype-deriving" mechanism.
+
+However, with GHC.Generics we can write this:
+
+  data T a = ...blah..blah... deriving( Generic )
+  instance C a => C (T a)  -- No 'where' clause
+
+where C is some "random" user-defined class. Usually, an instance decl with no
+'where' clause would be pretty useless, but now that we have default method
+signatures, in conjunction with deriving( Generic ), the instance can be useful.
+
+That in turn leads to a desire to say
+
+  data T a = ...blah..blah... deriving( Generic, C )
+
+which is even more compact. That is what DeriveAnyClass implements. This is
+not restricted to Generics; any class can be derived, simply giving rise to
+an empty instance.
+
+The only thing left to answer is how to determine the context (in case of
+standard deriving; in standalone deriving, the user provides the context).
+GHC uses the same heuristic for figuring out the class context that it uses for
+Eq in the case of *-kinded classes, and for Functor in the case of
+* -> *-kinded classes. That may not be optimal or even wrong. But in such
+cases, standalone deriving can still be used.
 
 \begin{code}
 ------------------------------------------------------------------
@@ -1177,7 +1213,8 @@ Specifically, we use TcGenDeriv.box_if_necy to box the Int# into an Int
 
 data DerivStatus = CanDerive
                  | DerivableClassError SDoc  -- Standard class, but can't do it
-                 | NonDerivableClass         -- Non-standard class
+                 | DerivableViaInstance      -- See Note [Deriving any class]
+                 | NonDerivableClass SDoc    -- Non-standard class
 
 checkSideConditions :: DynFlags -> DerivContext -> Class -> [TcType]
                     -> TyCon -> [Type] -- tycon and its parameters
@@ -1190,7 +1227,8 @@ checkSideConditions dflags mtheta cls cls_tys rep_tc rep_tc_args
                                                  -- cls_tys (the type args other than last)
                                                  -- should be null
                  | otherwise    -> DerivableClassError (classArgsErr cls cls_tys)  -- e.g. deriving( Eq s )
-  | otherwise = NonDerivableClass       -- Not a standard class
+  | otherwise = maybe DerivableViaInstance NonDerivableClass
+                      (canDeriveAnyClass dflags rep_tc cls)
 
 classArgsErr :: Class -> [Type] -> SDoc
 classArgsErr cls cls_tys = quotes (ppr (mkClassPred cls cls_tys)) <+> ptext (sLit "is not a class")
@@ -1225,7 +1263,7 @@ sideConditions mtheta cls
   | cls_key == gen1ClassKey        = Just (checkFlag Opt_DeriveGeneric `andCond`
                                            cond_vanilla `andCond`
                                            cond_Representable1Ok)
-  | otherwise = Nothing
+  | otherwise                      = Nothing
   where
     cls_key = getUnique cls
     cond_std     = cond_stdOK mtheta False  -- Vanilla data constructors, at least one,
@@ -1495,7 +1533,8 @@ mkNewTypeEqn dflags overlap_mode tvs
              cls cls_tys tycon tc_args rep_tycon rep_tc_args mtheta
 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
   | ASSERT( length cls_tys + 1 == classArity cls )
-    might_derive_via_coercible && (newtype_deriving || std_class_via_coercible cls)
+    might_derive_via_coercible && ((newtype_deriving && not deriveAnyClass)
+                                  || std_class_via_coercible cls)
   = do traceTc "newtype deriving:" (ppr tycon <+> ppr rep_tys <+> ppr all_preds)
        dfun_name <- new_dfun_name cls tycon
        loc <- getSrcSpanM
@@ -1518,18 +1557,29 @@ mkNewTypeEqn dflags overlap_mode tvs
             , ds_newtype = True }
   | otherwise
   = case checkSideConditions dflags mtheta cls cls_tys rep_tycon rep_tc_args of
-      CanDerive -> go_for_it    -- Use the standard H98 method
-      DerivableClassError msg   -- Error with standard class
+      -- Error with standard class
+      DerivableClassError msg
         | might_derive_via_coercible -> bale_out (msg $$ suggest_nd)
         | otherwise                  -> bale_out msg
-      NonDerivableClass         -- Must use newtype deriving
-        | newtype_deriving           -> bale_out cant_derive_err  -- Too hard, even with newtype deriving
-        | might_derive_via_coercible -> bale_out (non_std $$ suggest_nd) -- Try newtype deriving!
+      -- Must use newtype deriving or DeriveAnyClass
+      NonDerivableClass _msg
+        -- Too hard, even with newtype deriving
+        | newtype_deriving           -> bale_out cant_derive_err
+        -- Try newtype deriving!
+        | might_derive_via_coercible -> bale_out (non_std $$ suggest_nd)
         | otherwise                  -> bale_out non_std
+      -- CanDerive/DerivableViaInstance
+      _ -> do when (newtype_deriving && deriveAnyClass) $
+                addWarnTc (sep [ ptext (sLit "Both DeriveAnyClass and GeneralizedNewtypeDeriving are enabled")
+                               , ptext (sLit "Defaulting to the DeriveAnyClass strategy for instantiating") <+> ppr cls ])
+              go_for_it
   where
-        newtype_deriving = xopt Opt_GeneralizedNewtypeDeriving dflags
-        go_for_it        = mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tycon rep_tc_args mtheta
-        bale_out msg     = failWithTc (derivingThingErr newtype_deriving cls cls_tys inst_ty msg)
+        newtype_deriving  = xopt Opt_GeneralizedNewtypeDeriving dflags
+        deriveAnyClass    = xopt Opt_DeriveAnyClass             dflags
+        go_for_it         = mk_data_eqn overlap_mode tvs cls tycon tc_args
+                              rep_tycon rep_tc_args mtheta
+        bale_out    = bale_out' newtype_deriving
+        bale_out' b = failWithTc . derivingThingErr b cls cls_tys inst_ty
 
         non_std    = nonStdErr cls
         suggest_nd = ptext (sLit "Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension")
@@ -2041,7 +2091,7 @@ genDerivStuff loc clas dfun_name tycon comaux_maybe
 
 Note [Bindings for Generalised Newtype Deriving]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider 
+Consider
   class Eq a => C a where
      f :: a -> a
   newtype N a = MkN [a] deriving( C )
index 31e31ed..df45001 100644 (file)
@@ -17,7 +17,8 @@ This is where we do all the grimy bindings' generation.
 module TcGenDeriv (
         BagDerivStuff, DerivStuff(..),
 
-        genDerivedBinds, 
+        canDeriveAnyClass,
+        genDerivedBinds,
         FFoldType(..), functorLikeTraverse,
         deepSubtypesContaining, foldDataConArgs,
         mkCoerceClassMethEqn,
@@ -65,8 +66,9 @@ import Bag
 import Fingerprint
 import TcEnv (InstInfo)
 
-import ListSetOps( assocMaybe )
-import Data.List ( partition, intersperse )
+import ListSetOps ( assocMaybe )
+import Data.List  ( partition, intersperse )
+import Data.Maybe ( isNothing )
 \end{code}
 
 \begin{code}
@@ -106,7 +108,12 @@ genDerivedBinds dflags fix_env clas loc tycon
   = gen_fn loc tycon
 
   | otherwise
-  = pprPanic "genDerivStuff: bad derived class" (ppr clas)
+  -- Deriving any class simply means giving an empty instance, so no
+  -- bindings have to be generated.
+  = ASSERT2( isNothing (canDeriveAnyClass dflags tycon clas)
+           , ppr "genDerivStuff: bad derived class" <+> ppr clas )
+    (emptyBag, emptyBag)
+
   where
     gen_list :: [(Unique, SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff))]
     gen_list = [ (eqClassKey,          gen_Eq_binds)
@@ -121,6 +128,20 @@ genDerivedBinds dflags fix_env clas loc tycon
                , (functorClassKey,     gen_Functor_binds)
                , (foldableClassKey,    gen_Foldable_binds)
                , (traversableClassKey, gen_Traversable_binds) ]
+
+
+-- Nothing: we can (try to) derive it via Generics
+-- Just s:  we can't, reason s
+canDeriveAnyClass :: DynFlags -> TyCon -> Class -> Maybe SDoc
+canDeriveAnyClass dflags _tycon clas =
+  let b `orElse` s = if b then Nothing else Just (ptext (sLit s))
+      Just m  <> _ = Just m
+      Nothing <> n = n
+  -- We can derive a given class for a given tycon via Generics iff
+  in  -- 1) The class is not a "standard" class (like Show, Functor, etc.)
+        (not (getUnique clas `elem` standardClassKeys) `orElse` "")
+      -- 2) Opt_DeriveAnyClass is on
+     <> (xopt Opt_DeriveAnyClass dflags `orElse` "Try enabling DeriveAnyClass")
 \end{code}
 
 %************************************************************************
@@ -1231,7 +1252,7 @@ we generate
 We are passed the Typeable2 class as well as T
 
 \begin{code}
-gen_Typeable_binds :: DynFlags -> SrcSpan -> TyCon 
+gen_Typeable_binds :: DynFlags -> SrcSpan -> TyCon
                    -> (LHsBinds RdrName, BagDerivStuff)
 gen_Typeable_binds dflags loc tycon
   = ( unitBag $ mk_easy_FunBind loc typeRep_RDR [nlWildPat]
index 5c5e05e..c1ef0f0 100644 (file)
             <entry><option>-XNoDefaultSignatures</option></entry>
           </row>
           <row>
+            <entry><option>-XDeriveAnyClass</option></entry>
+            <entry>Enable <link linkend="derive-any-class">deriving for any
+                   class</link>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoDeriveAnyClass</option></entry>
+          </row>
+          <row>
             <entry><option>-XDeriveDataTypeable</option></entry>
             <entry>Enable <link linkend="deriving-typeable">deriving for the Data and Typeable classes</link>.
               Implied by <option>-XAutoDeriveTypeable</option>.</entry>
index 51d7b73..30742b3 100644 (file)
@@ -456,10 +456,10 @@ Indeed, the bindings can even be recursive.
       </para>
 
       <para>
-      This can make a difference when the positive and negative range of 
-      a numeric data type don't match up.  For example, 
+      This can make a difference when the positive and negative range of
+      a numeric data type don't match up.  For example,
       in 8-bit arithmetic -128 is representable, but +128 is not.
-      So <literal>negate (fromInteger 128)</literal> will elicit an 
+      So <literal>negate (fromInteger 128)</literal> will elicit an
       unexpected integer-literal-overflow message.
       </para>
    </sect2>
@@ -998,7 +998,7 @@ synonym using the following syntax:
 
 <para>
 The syntax and semantics of pattern synonyms are elaborated in the
-following subsections.  
+following subsections.
 See the <ulink
 url="http://ghc.haskell.org/trac/ghc/wiki/PatternSynonyms">Wiki
 page</ulink> for more details.
@@ -2533,10 +2533,10 @@ import safe qualified Network.Socket as NS
 <sect3 id="explicit-namespaces">
 <title>Explicit namespaces in import/export</title>
 
-<para> In an import or export list, such as 
+<para> In an import or export list, such as
 <programlisting>
   module M( f, (++) ) where ...
-    import N( f, (++) ) 
+    import N( f, (++) )
     ...
 </programlisting>
 the entities <literal>f</literal> and <literal>(++)</literal> are <emphasis>values</emphasis>.
@@ -2545,12 +2545,12 @@ to declare <literal>(++)</literal> as a <emphasis>type constructor</emphasis>.
 case, how would you export or import it?
 </para>
 <para>
-The <option>-XExplicitNamespaces</option> extension allows you to prefix the name of 
-a type constructor in an import or export list with "<literal>type</literal>" to 
+The <option>-XExplicitNamespaces</option> extension allows you to prefix the name of
+a type constructor in an import or export list with "<literal>type</literal>" to
 disambiguate this case, thus:
 <programlisting>
   module M( f, type (++) ) where ...
-    import N( f, type (++) ) 
+    import N( f, type (++) )
     ...
   module N( f, type (++) ) where
     data family a ++ b = L a | R b
@@ -2854,11 +2854,11 @@ allow you to write them infix.
 The language <option>-XTypeOperators</option> changes this behaviour:
 <itemizedlist>
 <listitem><para>
-Operator symbols become type <emphasis>constructors</emphasis> rather than 
+Operator symbols become type <emphasis>constructors</emphasis> rather than
 type <emphasis>variables</emphasis>.
 </para></listitem>
 <listitem><para>
-Operator symbols in types can be written infix, both in definitions and uses. 
+Operator symbols in types can be written infix, both in definitions and uses.
 for example:
 <programlisting>
 data a + b = Plus a b
@@ -2867,8 +2867,8 @@ type Foo = Int + Bool
 </para></listitem>
 <listitem><para>
 There is now some potential ambiguity in import and export lists; for example
-if you write <literal>import M( (+) )</literal> do you mean the 
-<emphasis>function</emphasis> <literal>(+)</literal> or the 
+if you write <literal>import M( (+) )</literal> do you mean the
+<emphasis>function</emphasis> <literal>(+)</literal> or the
 <emphasis>type constructor</emphasis> <literal>(+)</literal>?
 The default is the former, but with <option>-XExplicitNamespaces</option> (which is implied
 by <option>-XExplicitTypeOperators</option>) GHC allows you to specify the latter
@@ -3973,7 +3973,7 @@ defined in <literal>GHC.Base</literal>.
 
 <listitem><para> With <option>-XDeriveDataTypeable</option>, you can derive instances of
 the class <literal>Data</literal>,
-defined in <literal>Data.Data</literal>.  See <xref linkend="deriving-typeable"/> for 
+defined in <literal>Data.Data</literal>.  See <xref linkend="deriving-typeable"/> for
 deriving <literal>Typeable</literal>.
 </para></listitem>
 
@@ -3985,7 +3985,7 @@ defined in <literal>Data.Foldable</literal>.
 <listitem><para> With <option>-XDeriveTraversable</option>, you can derive instances of
 the class <literal>Traversable</literal>,
 defined in <literal>Data.Traversable</literal>. Since the <literal>Traversable</literal>
-instance dictates the instances of <literal>Functor</literal> and 
+instance dictates the instances of <literal>Functor</literal> and
 <literal>Foldable</literal>, you'll probably want to derive them too, so
 <option>-XDeriveTraversable</option> implies
 <option>-XDeriveFunctor</option> and <option>-XDeriveFoldable</option>.
@@ -4017,9 +4017,9 @@ programmer cannot subert the type system by writing bogus instances.
 </para></listitem>
 
 <listitem><para>
-With <option>-XDeriveDataTypeable</option> 
+With <option>-XDeriveDataTypeable</option>
 GHC allows you to derive instances of <literal>Typeable</literal> for data types or newtypes,
-using a <literal>deriving</literal> clause, or using 
+using a <literal>deriving</literal> clause, or using
 a standalone deriving declaration (<xref linkend="stand-alone-deriving"/>).
 </para></listitem>
 
@@ -4044,7 +4044,7 @@ a <literal>Typeable</literal> instance for a type class.
 
 <listitem><para>
 The flag <option>-XAutoDeriveTypeable</option> triggers the generation
-of derived <literal>Typeable</literal> instances for every datatype, data family, 
+of derived <literal>Typeable</literal> instances for every datatype, data family,
 and type class declaration in the module it is used, unless a manually-specified one is
 already provided.
 This flag implies <option>-XDeriveDataTypeable</option>.
@@ -4185,7 +4185,7 @@ A derived instance is derived only for declarations of these forms (after expans
 where
  <itemizedlist>
 <listitem><para>
-<literal>v1..vn</literal> are type variables, and <literal>t</literal>, 
+<literal>v1..vn</literal> are type variables, and <literal>t</literal>,
 <literal>s1..sk</literal>, <literal>t1..tj</literal> are types.
 </para></listitem>
 <listitem><para>
@@ -4263,6 +4263,25 @@ the standard method is used or the one described here.)
 </para>
 </sect3>
 </sect2>
+
+<sect2 id="derive-any-class">
+<title>Deriving any other class</title>
+
+<para>
+With <option>-XDeriveAnyClass</option> you can derive any other class. The
+compiler will simply generate an empty instance. The instance context will be
+generated according to the same rules used when deriving <literal>Eq</literal>.
+This is mostly useful in classes whose <link linkend="minimal-pragma">minimal
+set</link> is empty, and especially when writing
+<link linkend="generic-programming">generic functions</link>.
+
+In case you try to derive some class on a newtype, and
+<option>-XGeneralizedNewtypeDeriving</option> is also on,
+<option>-XDeriveAnyClass</option> takes precedence.
+</para>
+
+</sect2>
+
 </sect1>
 
 
@@ -5144,7 +5163,7 @@ These rules make it possible for a library author to design a library that relie
 overlapping instances without the client having to know.
 </para>
 <para>
-Errors are reported <emphasis>lazily</emphasis> (when attempting to solve a constraint), rather than <emphasis>eagerly</emphasis> 
+Errors are reported <emphasis>lazily</emphasis> (when attempting to solve a constraint), rather than <emphasis>eagerly</emphasis>
 (when the instances themselves are defined).  Consider, for example
 <programlisting>
   instance C Int  b where ..
@@ -6128,7 +6147,7 @@ instance Eq (Elem [e]) => Collects [e] where
 </para></listitem>
 <listitem><para>
      The instance for an associated type can be omitted in class instances.  In that case,
-     unless there is a default instance (see <xref linkend="assoc-decl-defs"/>), 
+     unless there is a default instance (see <xref linkend="assoc-decl-defs"/>),
      the corresponding instance type is not inhabited;
        i.e., only diverging expressions, such
        as <literal>undefined</literal>, can assume the type.
@@ -7235,13 +7254,13 @@ restriction on class declarations (<xref linkend="superclass-rules"/>) and insta
 
 <para>
 Each user-written type signature is subjected to an
-<emphasis>ambiguity check</emphasis>.  
+<emphasis>ambiguity check</emphasis>.
 The ambiguity check rejects functions that can never be called; for example:
 <programlisting>
    f :: C a => Int
 </programlisting>
 The idea is there can be no legal calls to <literal>f</literal> because every call will
-give rise to an ambiguous constraint.  
+give rise to an ambiguous constraint.
 Indeed, the <emphasis>only</emphasis> purpose of the
 ambiguity check is to report functions that cannot possibly be called.
 We could soundly omit the
@@ -7253,7 +7272,7 @@ delaying ambiguity errors to call sites.  Indeed, the language extension
 Ambiguity can be subtle.  Consider this example which uses functional dependencies:
 <programlisting>
    class D a b | a -> b where ..
-   h :: D Int b => Int 
+   h :: D Int b => Int
 </programlisting>
 The <literal>Int</literal> may well fix <literal>b</literal> at the call site, so that signature should
 not be rejected.  Moreover, the dependencies might be hidden. Consider
@@ -7268,12 +7287,12 @@ Here <literal>h</literal>'s type looks ambiguous in <literal>b</literal>, but he
    ...(h [True])...
 </programlisting>
 That gives rise to a <literal>(X [Bool] beta)</literal> constraint, and using the
-instance means we need <literal>(D Bool beta)</literal> and that 
+instance means we need <literal>(D Bool beta)</literal> and that
 fixes <literal>beta</literal> via <literal>D</literal>'s
 fundep!
 </para>
 <para>
-Behind all these special cases there is a simple guiding principle. 
+Behind all these special cases there is a simple guiding principle.
 Consider
 <programlisting>
   f :: <replaceable>type</replaceable>
@@ -7283,7 +7302,7 @@ Consider
   g = f
 </programlisting>
 You would think that the definition of <literal>g</literal> would surely typecheck!
-After all <literal>f</literal> has exactly the same type, and <literal>g=f</literal>. 
+After all <literal>f</literal> has exactly the same type, and <literal>g=f</literal>.
 But in fact <literal>f</literal>'s type
 is instantiated and the instantiated constraints are solved against
 the constraints bound by <literal>g</literal>'s signature.  So, in the case an ambiguous type, solving will fail.
@@ -7337,7 +7356,7 @@ GHC used to impose some more restrictive and less principled conditions
 on type signatures. For type type
 <literal>forall tv1..tvn (c1, ...,cn) => type</literal>
 GHC used to require (a) that each universally quantified type variable
-<literal>tvi</literal> must be "reachable" from <literal>type</literal>, 
+<literal>tvi</literal> must be "reachable" from <literal>type</literal>,
 and (b) that every constraint <literal>ci</literal> mentions at least one of the
 universally quantified type variables <literal>tvi</literal>.
 These ad-hoc restrictions are completely subsumed by the new ambiguity check.
@@ -8350,9 +8369,9 @@ using the following rules:
 
   <listitem><para>
   A binding group is <emphasis>fully generalised</emphasis> if and only if
-    <itemizedlist> 
+    <itemizedlist>
     <listitem><para>each of its free variables is either imported or closed, and</para></listitem>
-    <listitem><para>the binding is not affected by the monomorphism restriction 
+    <listitem><para>the binding is not affected by the monomorphism restriction
         (<ulink url="http://www.haskell.org/onlinereport/decls.html#sect4.5.5">Haskell Report, Section 4.5.5</ulink>)</para></listitem>
     </itemizedlist>
   </para></listitem>
@@ -8751,7 +8770,7 @@ h z = z-1
 </programlisting>
             This abbreviation makes top-level declaration slices quieter and less intimidating.
            </para></listitem>
-           
+
            <listitem>
              <para>
                Binders are lexically scoped. For example, consider the
@@ -10191,11 +10210,11 @@ mindef ::= name
       A comma denotes conjunction, i.e. both sides are required.
       Conjunction binds stronger than disjunction.</para>
       <para>
-      If no MINIMAL pragma is given in the class declaration, it is just as if 
+      If no MINIMAL pragma is given in the class declaration, it is just as if
       a pragma <literal>{-# MINIMAL op1, op2, ..., opn #-}</literal> was given, where
-      the <literal>opi</literal> are the methods 
-      (a) that lack a default method in the class declaration, and 
-      (b) whose name that does not start with an underscore  
+      the <literal>opi</literal> are the methods
+      (a) that lack a default method in the class declaration, and
+      (b) whose name that does not start with an underscore
       (c.f. <option>-fwarn-missing-methods</option>, <xref linkend="options-sanity"/>).
       </para>
       <para>This warning can be turned off with the flag <option>-fno-warn-missing-methods</option>.</para>
@@ -11569,8 +11588,9 @@ general <link linkend="generic-programming">support for generic programming</lin
 
 <para>
 Using a combination of <option>-XDeriveGeneric</option>
-(<xref linkend="deriving-typeable"/>) and
+(<xref linkend="deriving-typeable"/>),
 <option>-XDefaultSignatures</option> (<xref linkend="class-default-signatures"/>),
+and <option>-XDeriveAnyClass</option> (<xref linkend="derive-any-class"/>),
 you can easily do datatype-generic
 programming using the <literal>GHC.Generics</literal> framework. This section
 gives a very brief overview of how to do it.
@@ -11746,6 +11766,10 @@ instance (Serialize a) => Serialize (UserTree a)
 The default method for <literal>put</literal> is then used, corresponding to the
 generic implementation of serialization.
 
+If you are using <option>-XDeriveAnyClass</option>, the same instance is
+generated by simply attaching a <literal>deriving Serialize</literal> clause
+to the <literal>UserTree</literal> datatype declaration.
+
 For more examples of generic functions please refer to the
 <ulink url="http://hackage.haskell.org/package/generic-deriving">generic-deriving</ulink>
 package on Hackage.
index 40ddb4b..1dfaa8b 100644 (file)
@@ -33,6 +33,7 @@ expectedGhcOnlyExtensions :: [String]
 expectedGhcOnlyExtensions = ["RelaxedLayout",
                              "AlternativeLayoutRule",
                              "AlternativeLayoutRuleTransitional",
+                             "DeriveAnyClass",
                              "JavaScriptFFI",
                              "PatternSynonyms"]
 
diff --git a/testsuite/tests/generics/GEnum/Enum.hs b/testsuite/tests/generics/GEnum/Enum.hs
new file mode 100644 (file)
index 0000000..5bf99b4
--- /dev/null
@@ -0,0 +1,87 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Enum where
+
+
+import GHC.Generics
+
+
+-----------------------------------------------------------------------------
+-- Utility functions for Enum'
+-----------------------------------------------------------------------------
+
+infixr 5 |||
+
+-- | Interleave elements from two lists. Similar to (++), but swap left and
+-- right arguments on every recursive application.
+--
+-- From Mark Jones' talk at AFP2008
+(|||) :: [a] -> [a] -> [a]
+[]     ||| ys = ys
+(x:xs) ||| ys = x : ys ||| xs
+
+-- | Diagonalization of nested lists. Ensure that some elements from every
+-- sublist will be included. Handles infinite sublists.
+--
+-- From Mark Jones' talk at AFP2008
+diag :: [[a]] -> [a]
+diag = concat . foldr skew [] . map (map (\x -> [x]))
+
+skew :: [[a]] -> [[a]] -> [[a]]
+skew []     ys = ys
+skew (x:xs) ys = x : combine (++) xs ys
+
+combine :: (a -> a -> a) -> [a] -> [a] -> [a]
+combine _ xs     []     = xs
+combine _ []     ys     = ys
+combine f (x:xs) (y:ys) = f x y : combine f xs ys
+
+findIndex :: (a -> Bool) -> [a] -> Maybe Int
+findIndex p xs = let l = [ i | (y,i) <- zip xs [(0::Int)..], p y]
+                 in if (null l)
+                    then Nothing
+                    else Just (head l)
+
+--------------------------------------------------------------------------------
+-- Generic enum
+--------------------------------------------------------------------------------
+
+class Enum' f where
+  enum' :: [f a]
+
+instance Enum' U1 where
+  enum' = [U1]
+
+instance (GEnum c) => Enum' (K1 i c) where
+  enum' = map K1 genum
+
+instance (Enum' f) => Enum' (M1 i c f) where
+  enum' = map M1 enum'
+
+instance (Enum' f, Enum' g) => Enum' (f :+: g) where
+  enum' = map L1 enum' ||| map R1 enum'
+
+instance (Enum' f, Enum' g) => Enum' (f :*: g) where
+  enum' = diag [ [ x :*: y | y <- enum' ] | x <- enum' ]
+
+instance (GEnum a) => GEnum (Maybe a)
+instance (GEnum a) => GEnum [a]
+
+
+genumDefault :: (Generic a, Enum' (Rep a)) => [a]
+genumDefault = map to enum'
+
+class GEnum a where
+  genum :: [a]
+
+  default genum :: (Generic a, Enum' (Rep a)) => [a]
+  genum = genumDefault
+
+instance GEnum Int where
+  genum = [0..] ||| (neg 0) where
+    neg n = (n-1) : neg (n-1)
index 6450091..7bdfbeb 100644 (file)
@@ -37,8 +37,7 @@ class GEq a where
 instance GEq Char   where geq = (==)
 instance GEq Int    where geq = (==)
 instance GEq Float  where geq = (==)
-{-
+
 -- Generic instances
 instance (GEq a) => GEq (Maybe a)
 instance (GEq a) => GEq [a]
--}
diff --git a/testsuite/tests/generics/T5462No1.hs b/testsuite/tests/generics/T5462No1.hs
new file mode 100644 (file)
index 0000000..fc24f63
--- /dev/null
@@ -0,0 +1,27 @@
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE DeriveFunctor          #-}
+{-# LANGUAGE DefaultSignatures      #-}
+{-# LANGUAGE StandaloneDeriving     #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+-- DeriveAnyClass not enabled
+
+module T5462No1 where
+
+import GHC.Generics hiding (C, C1, D)
+import GFunctor
+
+class C1 a where
+  c1 :: a -> Int
+
+class C2 a where
+  c2 :: a -> Int
+  c2 _ = 0
+
+newtype F a = F1 [a]
+  deriving (Show, Eq, Generic, Generic1, GFunctor)
+
+data G = G1 deriving (C1)
+data H = H1 deriving (C2)
diff --git a/testsuite/tests/generics/T5462No1.stderr b/testsuite/tests/generics/T5462No1.stderr
new file mode 100644 (file)
index 0000000..9deb08a
--- /dev/null
@@ -0,0 +1,20 @@
+[1 of 2] Compiling GFunctor         ( GFunctor/GFunctor.hs, GFunctor/GFunctor.o )
+[2 of 2] Compiling T5462No1         ( T5462No1.hs, T5462No1.o )
+
+T5462No1.hs:24:42:
+    Can't make a derived instance of ‘GFunctor F’:
+      ‘GFunctor’ is not a derivable class
+      Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension
+    In the newtype declaration for ‘F’
+
+T5462No1.hs:26:23:
+    Can't make a derived instance of ‘C1 G’:
+      ‘C1’ is not a derivable class
+      Try enabling DeriveAnyClass
+    In the data declaration for ‘G’
+
+T5462No1.hs:27:23:
+    Can't make a derived instance of ‘C2 H’:
+      ‘C2’ is not a derivable class
+      Try enabling DeriveAnyClass
+    In the data declaration for ‘H’
diff --git a/testsuite/tests/generics/T5462Yes1.hs b/testsuite/tests/generics/T5462Yes1.hs
new file mode 100644 (file)
index 0000000..3578529
--- /dev/null
@@ -0,0 +1,48 @@
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE DeriveFunctor          #-}
+{-# LANGUAGE DefaultSignatures      #-}
+{-# LANGUAGE StandaloneDeriving     #-}
+{-# LANGUAGE UndecidableInstances   #-}
+{-# LANGUAGE DeriveAnyClass    #-}
+
+module Main where
+
+import GHC.Generics hiding (C, C1, D)
+import GEq1A
+import Enum
+import GFunctor
+
+data A = A1
+  deriving (Show, Generic, GEq, GEnum)
+
+data B a = B1 | B2 a (B a)
+  deriving (Show, Generic, Generic1, GEq, GEnum, GFunctor)
+
+data C phantom a = C1 | C2 a (C phantom a)
+  deriving (Show, Generic, Generic1, GEq, GEnum, GFunctor)
+
+data D f a = D1 (f a) (f (D f a)) deriving (Generic, Generic1)
+deriving instance (Show (f a), Show (f (D f a))) => Show (D f a)
+deriving instance (GEq  (f a), GEq  (f (D f a))) => GEq  (D f a)
+
+data E f a = E1 (f a)
+  deriving (Show, Eq, Generic, Generic1, GFunctor)
+
+
+main = print (
+               geq A1 A1
+             , take 10 (genum :: [A])
+
+             , geq (B2 A1 B1) B1
+             , gmap (++ "lo") (B2 "hel" B1)
+             , take 3 (genum :: [B A])
+
+             , geq (C2 A1 C1) C1
+             , gmap (++ "lo") (C2 "hel" C1)
+
+             , geq (D1 "a" []) (D1 "a" [])
+
+             , gmap (++ "lo") (E1 ["hel"])
+             )
diff --git a/testsuite/tests/generics/T5462Yes1.stdout b/testsuite/tests/generics/T5462Yes1.stdout
new file mode 100644 (file)
index 0000000..6a2dc67
--- /dev/null
@@ -0,0 +1 @@
+(True,[A1],False,B2 "hello" B1,[B1,B2 A1 B1,B2 A1 (B2 A1 B1)],False,C2 "hello" C1,True,E1 ["hello"])\r
diff --git a/testsuite/tests/generics/T5462Yes2.hs b/testsuite/tests/generics/T5462Yes2.hs
new file mode 100644 (file)
index 0000000..9c22255
--- /dev/null
@@ -0,0 +1,37 @@
+{-# LANGUAGE FlexibleContexts              #-}
+{-# LANGUAGE FlexibleInstances             #-}
+{-# LANGUAGE DeriveGeneric                 #-}
+{-# LANGUAGE DefaultSignatures             #-}
+{-# LANGUAGE StandaloneDeriving            #-}
+{-# LANGUAGE UndecidableInstances          #-}
+{-# LANGUAGE DeriveAnyClass                #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving    #-}
+
+module Main where
+
+import GHC.Generics hiding (C, C1, D)
+import GFunctor
+
+class C1 a where
+  c1 :: a -> Int
+  c1 _ = 1
+
+class C2 a where
+  c21 :: a -> Int
+  c21 = c22
+  c22 :: a -> Int
+  c22 = c21
+  {-# MINIMAL c21 | c22 #-}
+
+newtype D = D Int deriving C1
+
+instance C1 Int where c1 _ = 2
+
+newtype F a = F1 [a]
+  deriving (Show, Eq, Generic, Generic1, GFunctor)
+
+data G = G1 deriving (C1)
+data H = H1 deriving (C2)
+
+
+main = print (c1 (D 3))
diff --git a/testsuite/tests/generics/T5462Yes2.stdout b/testsuite/tests/generics/T5462Yes2.stdout
new file mode 100644 (file)
index 0000000..d00491f
--- /dev/null
@@ -0,0 +1 @@
+1
index df95fa6..694f214 100644 (file)
@@ -19,11 +19,15 @@ test('GenCannotDoRep1_6', normal, compile_fail, [''])
 test('GenCannotDoRep1_7', normal, compile_fail, [''])
 test('GenCannotDoRep1_8', normal, compile_fail, [''])
 
-test('T5884',           normal, compile, [''])
-test('GenNewtype',      normal, compile_and_run, [''])
+test('T5462Yes1', normal, multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor'])
+test('T5462Yes2', normal, multimod_compile_and_run, ['T5462Yes2', '-iGFunctor'])
+test('T5462No1', normal, multimod_compile_fail, ['T5462No1', '-iGFunctor'])
 
-test('GenDerivOutput1_0',  normal, compile, ['-dsuppress-uniques'])
-test('GenDerivOutput1_1',  normal, compile, ['-dsuppress-uniques'])
+test('T5884',      normal, compile, [''])
+test('GenNewtype', normal, compile_and_run, [''])
+
+test('GenDerivOutput1_0', normal, compile, ['-dsuppress-uniques'])
+test('GenDerivOutput1_1', normal, compile, ['-dsuppress-uniques'])
 
 test('T7878', extra_clean(['T7878A.o'     ,'T7878A.hi'
                           ,'T7878A.o-boot','T7878A.hi-boot'
index 14ec2e2..2630e9c 100644 (file)
@@ -2,4 +2,5 @@
 mod53.hs:4:22:
     Can't make a derived instance of ‘C T’:
       ‘C’ is not a derivable class
+      Try enabling DeriveAnyClass
     In the data declaration for ‘T’