Make Generic1 poly-kinded
authorRyanGlScott <ryan.gl.scott@gmail.com>
Wed, 11 May 2016 13:57:48 +0000 (15:57 +0200)
committerBen Gamari <ben@smart-cactus.org>
Thu, 12 May 2016 13:39:30 +0000 (15:39 +0200)
This generalizes the `Generic1` typeclass to be of kind `k -> *`, and
this also makes the relevant datatypes and typeclasses in `GHC.Generics`
poly-kinded. If `PolyKinds` is enabled, `DeriveGeneric` derives
`Generic1` instances such that they use the most general kind possible.
Otherwise, deriving `Generic1` defaults to make an instance where the
argument is of kind `* -> *` (the current behavior).

Fixes #10604. Depends on D2117.

Test Plan: ./validate

Reviewers: kosmikus, dreixel, goldfire, austin, hvr, simonpj, bgamari

Reviewed By: simonpj, bgamari

Subscribers: thomie, ekmett

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

GHC Trac Issues: #10604

17 files changed:
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcGenGenerics.hs
docs/users_guide/glasgow_exts.rst
libraries/base/Data/Data.hs
libraries/base/GHC/Generics.hs
libraries/base/changelog.md
testsuite/tests/generics/T10604/Makefile [new file with mode: 0644]
testsuite/tests/generics/T10604/T10604_Authenticated.hs [new file with mode: 0644]
testsuite/tests/generics/T10604/T10604_bad_variable_occurrence.hs [new file with mode: 0644]
testsuite/tests/generics/T10604/T10604_bad_variable_occurrence.stderr [new file with mode: 0644]
testsuite/tests/generics/T10604/T10604_deriving.hs [new file with mode: 0644]
testsuite/tests/generics/T10604/T10604_deriving.stderr [new file with mode: 0644]
testsuite/tests/generics/T10604/T10604_no_PolyKinds.hs [new file with mode: 0644]
testsuite/tests/generics/T10604/T10604_no_PolyKinds.stderr [new file with mode: 0644]
testsuite/tests/generics/T10604/all.T [new file with mode: 0644]
testsuite/tests/perf/compiler/all.T
testsuite/tests/perf/haddock/all.T

index 8d741b4..271652a 100644 (file)
@@ -645,14 +645,18 @@ deriveTyData tvs tc tc_args deriv_pred
               -- to the types.  See Note [Unify kinds in deriving]
               -- We are assuming the tycon tyvars and the class tyvars are distinct
               mb_match        = tcUnifyTy inst_ty_kind cls_arg_kind
-              Just kind_subst = mb_match
-              ki_subst_range  = getTCvSubstRangeFVs kind_subst
+              enough_args     = n_args_to_keep >= 0
+
+        -- Check that the result really is well-kinded
+        ; checkTc (enough_args && isJust mb_match)
+                  (derivingKindErr tc cls cls_tys cls_arg_kind enough_args)
 
+        ; let Just kind_subst = mb_match
+              ki_subst_range  = getTCvSubstRangeFVs kind_subst
               all_tkvs        = toposortTyVars $
                                 fvVarList $ unionFV
                                   (tyCoFVsOfTypes tc_args_to_keep)
                                   (FV.mkFVs deriv_tvs)
-
               -- See Note [Unification of two kind variables in deriving]
               unmapped_tkvs   = filter (\v -> v `notElemTCvSubst` kind_subst
                                       && not (v `elemVarSet` ki_subst_range))
@@ -670,10 +674,6 @@ deriveTyData tvs tc tc_args deriv_pred
                                        , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
                                        , ppr final_tc_args, ppr final_cls_tys ])
 
-        -- Check that the result really is well-kinded
-        ; checkTc (n_args_to_keep >= 0 && isJust mb_match)
-                  (derivingKindErr tc cls cls_tys cls_arg_kind)
-
         ; traceTc "derivTyData2" (vcat [ ppr tkvs ])
 
         ; checkTc (allDistinctTyVars (mkVarSet tkvs) args_to_drop)     -- (a, b, c)
@@ -1062,12 +1062,12 @@ inferConstraints :: [TyVar] -> Class -> [TcType] -> TcType
 -- generated method definitions should succeed.   This set will be simplified
 -- before being used in the instance declaration
 inferConstraints tvs main_cls cls_tys inst_ty rep_tc rep_tc_args mkTheta
-  | main_cls `hasKey` genClassKey    -- Generic constraints are easy
+  | is_generic                        -- Generic constraints are easy
   = mkTheta [] tvs inst_tys
 
-  | main_cls `hasKey` gen1ClassKey   -- Gen1 needs Functor
+  | is_generic1                       -- Generic1 needs Functor
   = ASSERT( length rep_tc_tvs > 0 )   -- See Note [Getting base classes]
-    ASSERT( null cls_tys )
+    ASSERT( length cls_tys   == 1 )   -- Generic1 has a single kind variable
     do { functorClass <- tcLookupClass functorClassName
        ; con_arg_constraints (get_gen1_constraints functorClass) mkTheta }
 
@@ -1116,19 +1116,25 @@ inferConstraints tvs main_cls cls_tys inst_ty rep_tc rep_tc_args mkTheta
             -- (which is the case for functor-like constraints), then we
             -- explicitly unify the subtype's kinds with (* -> *).
             -- See Note [Inferring the instance context]
-            subst          = foldl' composeTCvSubst
-                                    emptyTCvSubst (catMaybes mbSubsts)
-            subst_range    = getTCvSubstRangeFVs subst
-            unmapped_tvs   = filter (\v -> v `notElemTCvSubst` subst
-                                   && not (v `elemVarSet` subst_range)) tvs
-            (subst', _)    = mapAccumL substTyVarBndr subst unmapped_tvs
-            preds'         = substThetaOrigin subst' preds
-            inst_tys'      = substTys subst' inst_tys
-            tvs'           = tyCoVarsOfTypesWellScoped inst_tys'
+            subst        = foldl' composeTCvSubst
+                                  emptyTCvSubst (catMaybes mbSubsts)
+            unmapped_tvs = filter (\v -> v `notElemTCvSubst` subst
+                                      && not (v `isInScope` subst)) tvs
+            (subst', _)  = mapAccumL substTyVarBndr subst unmapped_tvs
+            preds'       = substThetaOrigin subst' preds
+            inst_tys'    = substTys subst' inst_tys
+            tvs'         = tyCoVarsOfTypesWellScoped inst_tys'
         in mkTheta preds' tvs' inst_tys'
 
+    is_generic  = main_cls `hasKey` genClassKey
+    is_generic1 = main_cls `hasKey` gen1ClassKey
     -- is_functor_like: see Note [Inferring the instance context]
     is_functor_like = typeKind inst_ty `tcEqKind` typeToTypeKind
+                   || is_generic1 -- Technically, Generic1 requires a type of
+                                  -- kind (k -> *), not (* -> *), but we still
+                                  -- label it "functor-like" to make sure
+                                  -- all_rep_tc_args has all the necessary type
+                                  -- variables it needs to function.
 
     get_gen1_constraints :: Class -> CtOrigin -> TypeOrKind -> Type
                          -> [(ThetaOrigin, Maybe TCvSubst)]
@@ -1201,9 +1207,12 @@ inferConstraints tvs main_cls cls_tys inst_ty rep_tc rep_tc_args mkTheta
       | otherwise
       = []
 
-    mk_cls_pred orig t_or_k cls ty   -- Don't forget to apply to cls_tys too
-                              -- In the awkward Generic1 casde, cls_tys is empty
-       = mkPredOrigin orig t_or_k (mkClassPred cls (cls_tys ++ [ty]))
+    mk_cls_pred orig t_or_k cls ty   -- Don't forget to apply to cls_tys' too
+       = mkPredOrigin orig t_or_k (mkClassPred cls (cls_tys' ++ [ty]))
+    cls_tys' | is_generic1 = [] -- In the awkward Generic1 case, cls_tys'
+                                -- should be empty, since we are applying the
+                                -- class Functor.
+             | otherwise   = cls_tys
 
 {- Note [Getting base classes]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1280,10 +1289,15 @@ checkSideConditions dflags mtheta cls cls_tys rep_tc
   | Just cond <- sideConditions mtheta cls
   = case (cond (dflags, rep_tc)) of
         NotValid err -> DerivableClassError err  -- Class-specific error
-        IsValid  | null cls_tys -> CanDerive     -- All derivable classes are unary, so
-                                                 -- cls_tys (the type args other than last)
-                                                 -- should be null
-                 | otherwise    -> DerivableClassError (classArgsErr cls cls_tys)  -- e.g. deriving( Eq s )
+        IsValid  | null (filterOutInvisibleTypes (classTyCon cls) cls_tys)
+                   -> CanDerive
+                   -- All derivable classes are unary in the sense that there
+                   -- should be not types in cls_tys (i.e., no type args other
+                   -- than last). Note that cls_types can contain invisible
+                   -- types as well (e.g., for Generic1, which is poly-kinded),
+                   -- so make sure those are not counted.
+                 | otherwise -> DerivableClassError (classArgsErr cls cls_tys)
+                   -- e.g. deriving( Eq s )
 
   | Just err <- canDeriveAnyClass dflags rep_tc cls
   = NonDerivableClass err  -- DeriveAnyClass does not work
@@ -2294,9 +2308,7 @@ genDerivStuff loc clas dfun_name tycon inst_tys tyvars
   = let gk = if ck == genClassKey then Gen0 else Gen1
         -- TODO NSF: correctly identify when we're building Both instead of One
     in do
-      let inst_ty = ASSERT(not $ null inst_tys)
-                          head inst_tys
-      (binds, faminst) <- gen_Generic_binds gk tycon inst_ty
+      (binds, faminst) <- gen_Generic_binds gk tycon inst_tys
                                             (nameModule dfun_name)
       return (binds, unitBag (DerivFamInst faminst))
 
@@ -2404,12 +2416,20 @@ the empty instance declaration case).
 derivingNullaryErr :: MsgDoc
 derivingNullaryErr = text "Cannot derive instances for nullary classes"
 
-derivingKindErr :: TyCon -> Class -> [Type] -> Kind -> MsgDoc
-derivingKindErr tc cls cls_tys cls_kind
-  = hang (text "Cannot derive well-kinded instance of form"
-                <+> quotes (pprClassPred cls cls_tys <+> parens (ppr tc <+> text "...")))
-       2 (text "Class" <+> quotes (ppr cls)
-            <+> text "expects an argument of kind" <+> quotes (pprKind cls_kind))
+derivingKindErr :: TyCon -> Class -> [Type] -> Kind -> Bool -> MsgDoc
+derivingKindErr tc cls cls_tys cls_kind enough_args
+  = sep [ hang (text "Cannot derive well-kinded instance of form"
+                      <+> quotes (pprClassPred cls cls_tys
+                                    <+> parens (ppr tc <+> text "...")))
+               2 gen1_suggestion
+        , nest 2 (text "Class" <+> quotes (ppr cls)
+                      <+> text "expects an argument of kind"
+                      <+> quotes (pprKind cls_kind))
+        ]
+  where
+    gen1_suggestion | cls `hasKey` gen1ClassKey && enough_args
+                    = text "(Perhaps you intended to use PolyKinds)"
+                    | otherwise = Outputable.empty
 
 derivingEtaErr :: Class -> [Type] -> Type -> MsgDoc
 derivingEtaErr cls cls_tys inst_ty
index ebe9303..931508b 100644 (file)
@@ -63,10 +63,10 @@ For the generic representation we need to generate:
 \end{itemize}
 -}
 
-gen_Generic_binds :: GenericKind -> TyCon -> Type -> Module
+gen_Generic_binds :: GenericKind -> TyCon -> [Type] -> Module
                  -> TcM (LHsBinds RdrName, FamInst)
-gen_Generic_binds gk tc inst_ty mod = do
-  repTyInsts <- tc_mkRepFamInsts gk tc inst_ty mod
+gen_Generic_binds gk tc inst_tys mod = do
+  repTyInsts <- tc_mkRepFamInsts gk tc inst_tys mod
   return (mkBindsRep gk tc, repTyInsts)
 
 {-
@@ -347,13 +347,13 @@ mkBindsRep gk tycon =
 --       type Rep_D a b = ...representation type for D ...
 --------------------------------------------------------------------------------
 
-tc_mkRepFamInsts :: GenericKind     -- Gen0 or Gen1
-               -> TyCon           -- The type to generate representation for
-               -> Type            -- The above TyCon applied to its type
-                                  -- arguments in the generated instance
-               -> Module          -- Used as the location of the new RepTy
-               -> TcM (FamInst)   -- Generated representation0 coercion
-tc_mkRepFamInsts gk tycon inst_ty mod =
+tc_mkRepFamInsts :: GenericKind -- Gen0 or Gen1
+               -> TyCon         -- The type to generate representation for
+               -> [Type]        -- The type(s) to which Generic(1) is applied
+                                -- in the generated instance
+               -> Module        -- Used as the location of the new RepTy
+               -> TcM (FamInst) -- Generated representation0 coercion
+tc_mkRepFamInsts gk tycon inst_tys mod =
        -- Consider the example input tycon `D`, where data D a b = D_ a
        -- Also consider `R:DInt`, where { data family D x y :: * -> *
        --                               ; data instance D Int a b = D_ a }
@@ -364,6 +364,20 @@ tc_mkRepFamInsts gk tycon inst_ty mod =
 
      ; fam_envs <- tcGetFamInstEnvs
 
+     ; let -- If the derived instance is
+           --   instance Generic (Foo x)
+           -- then:
+           --   `arg_ki` = *, `inst_ty` = Foo x :: *
+           --
+           -- If the derived instance is
+           --   instance Generic1 (Bar x :: k -> *)
+           -- then:
+           --   `arg_k` = k, `inst_ty` = Bar x :: k -> *
+           (arg_ki, inst_ty) = case (gk, inst_tys) of
+             (Gen0, [inst_t])        -> (liftedTypeKind, inst_t)
+             (Gen1, [arg_k, inst_t]) -> (arg_k,          inst_t)
+             _ -> pprPanic "tc_mkRepFamInsts" (ppr inst_tys)
+
      ; let mbFamInst         = tyConFamInst_maybe tycon
            -- If we're examining a data family instance, we grab the parent
            -- TyCon (ptc) and use it to determine the type arguments
@@ -380,7 +394,7 @@ tc_mkRepFamInsts gk tycon inst_ty mod =
              where all_tyvars = tyConTyVars tycon
 
        -- `repTy` = D1 ... (C1 ... (S1 ... (Rec0 a))) :: * -> *
-     ; repTy <- tc_mkRepTy gk_ tycon
+     ; repTy <- tc_mkRepTy gk_ tycon arg_ki
 
        -- `rep_name` is a name we generate for the synonym
      ; rep_name <- let mkGen = case gk of Gen0 -> mkGenR; Gen1 -> mkGen1R
@@ -392,7 +406,7 @@ tc_mkRepFamInsts gk tycon inst_ty mod =
        -- of the tyvars might have been instantiated when deriving.
        -- See Note [Generating a correctly typed Rep instance].
      ; let env      = zipTyEnv tyvars inst_args
-           in_scope = mkInScopeSet (tyCoVarsOfType inst_ty)
+           in_scope = mkInScopeSet (tyCoVarsOfTypes inst_tys)
            subst    = mkTvSubst in_scope env
            repTy'   = substTy  subst repTy
            tcv' = tyCoVarsOfTypeList inst_ty
@@ -400,7 +414,7 @@ tc_mkRepFamInsts gk tycon inst_ty mod =
            tvs'     = toposortTyVars tv'
            cvs'     = toposortTyVars cv'
            axiom    = mkSingleCoAxiom Nominal rep_name tvs' cvs'
-                                      fam_tc [inst_ty] repTy'
+                                      fam_tc inst_tys repTy'
 
      ; newFamInst SynFamilyInst axiom  }
 
@@ -477,9 +491,12 @@ tc_mkRepTy ::  -- Gen0_ or Gen1_, for Rep or Rep1
                GenericKind_
               -- The type to generate representation for
             -> TyCon
+              -- The kind of the representation type's argument
+              -- See Note [Handling kinds in a Rep instance]
+            -> Kind
                -- Generated representation0 type
             -> TcM Type
-tc_mkRepTy gk_ tycon =
+tc_mkRepTy gk_ tycon =
   do
     d1      <- tcLookupTyCon d1TyConName
     c1      <- tcLookupTyCon c1TyConName
@@ -521,27 +538,30 @@ tc_mkRepTy gk_ tycon =
 
     fix_env <- getFixityEnv
 
-    let mkSum' a b = mkTyConApp plus  [a,b]
-        mkProd a b = mkTyConApp times [a,b]
-        mkComp a b = mkTyConApp comp  [a,b]
-        mkRec0 a   = mkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 a
-        mkRec1 a   = mkTyConApp rec1  [a]
+    let mkSum' a b = mkTyConApp plus  [k,a,b]
+        mkProd a b = mkTyConApp times [k,a,b]
+        -- The second kind variable of (:.:) must always be *.
+        -- See Note [Handling kinds in a Rep instance]
+        mkComp a b = mkTyConApp comp  [k,liftedTypeKind,a,b]
+        mkRec0 a   = mkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 k a
+        mkRec1 a   = mkTyConApp rec1  [k,a]
         mkPar1     = mkTyConTy  par1
-        mkD    a   = mkTyConApp d1 [ metaDataTy, sumP (tyConDataCons a) ]
-        mkC      a = mkTyConApp c1 [ metaConsTy a
+        mkD    a   = mkTyConApp d1 [ k, metaDataTy, sumP (tyConDataCons a) ]
+        mkC      a = mkTyConApp c1 [ k
+                                   , metaConsTy a
                                    , prod (dataConInstOrigArgTys a
                                             . mkTyVarTys . tyConTyVars $ tycon)
                                           (dataConSrcBangs    a)
                                           (dataConImplBangs   a)
                                           (dataConFieldLabels a)]
-        mkS mlbl su ss ib a = mkTyConApp s1 [metaSelTy mlbl su ss ib, a]
+        mkS mlbl su ss ib a = mkTyConApp s1 [k, metaSelTy mlbl su ss ib, a]
 
         -- Sums and products are done in the same way for both Rep and Rep1
-        sumP [] = mkTyConTy v1
+        sumP [] = mkTyConApp v1 [k]
         sumP l  = foldBal mkSum' . map mkC  $ l
         -- The Bool is True if this constructor has labelled fields
         prod :: [Type] -> [HsSrcBang] -> [HsImplBang] -> [FieldLabel] -> Type
-        prod [] _  _  _  = mkTyConTy u1
+        prod [] _  _  _  = mkTyConApp u1 [k]
         prod l  sb ib fl = foldBal mkProd
                                    [ ASSERT(null fl || length fl > j)
                                      arg t sb' ib' (if null fl
@@ -631,16 +651,17 @@ mkBoxTy :: TyCon -- UAddr
         -> TyCon -- UInt
         -> TyCon -- UWord
         -> TyCon -- Rec0
+        -> Kind  -- What to instantiate Rec0's kind variable with
         -> Type
         -> Type
-mkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 ty
-  | ty `eqType` addrPrimTy   = mkTyConTy uAddr
-  | ty `eqType` charPrimTy   = mkTyConTy uChar
-  | ty `eqType` doublePrimTy = mkTyConTy uDouble
-  | ty `eqType` floatPrimTy  = mkTyConTy uFloat
-  | ty `eqType` intPrimTy    = mkTyConTy uInt
-  | ty `eqType` wordPrimTy   = mkTyConTy uWord
-  | otherwise                = mkTyConApp rec0 [ty]
+mkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 ty
+  | ty `eqType` addrPrimTy   = mkTyConApp uAddr   [k]
+  | ty `eqType` charPrimTy   = mkTyConApp uChar   [k]
+  | ty `eqType` doublePrimTy = mkTyConApp uDouble [k]
+  | ty `eqType` floatPrimTy  = mkTyConApp uFloat  [k]
+  | ty `eqType` intPrimTy    = mkTyConApp uInt    [k]
+  | ty `eqType` wordPrimTy   = mkTyConApp uWord   [k]
+  | otherwise                = mkTyConApp rec0    [k,ty]
 
 --------------------------------------------------------------------------------
 -- Dealing with sums
@@ -867,4 +888,33 @@ a Rep(1) instance. To do so, we create a type variable substitution that maps
 the tyConTyVars of the TyCon to their counterparts in the fully instantiated
 type. (For example, using T above as example, you'd map a :-> Int.) We then
 apply the substitution to the RHS before generating the instance.
+
+Note [Handling kinds in a Rep instance]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Because Generic1 is poly-kinded, the representation types were generalized to
+be kind-polymorphic as well. As a result, tc_mkRepTy must explicitly apply
+the kind of the instance being derived to all the representation type
+constructors. For instance, if you have
+
+    data Empty (a :: k) = Empty deriving Generic1
+
+Then the generated code is now approximately (with -fprint-explicit-kinds
+syntax):
+
+    instance Generic1 k (Empty k) where
+      type Rep1 k (Empty k) = U1 k
+
+Most representation types have only one kind variable, making them easy to deal
+with. The only non-trivial case is (:.:), which is only used in Generic1
+instances:
+
+    newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =
+        Comp1 { unComp1 :: f (g p) }
+
+Here, we do something a bit counter-intuitive: we make k1 be the kind of the
+instance being derived, and we always make k2 be *. Why *? It's because
+the code that GHC generates using (:.:) is always of the form x :.: Rec1 y
+for some types x and y. In other words, the second type to which (:.:) is
+applied always has kind k -> *, for some kind k, so k2 cannot possibly be
+anything other than * in a generated Generic1 instance.
 -}
index 3f30dc5..9e30e93 100644 (file)
@@ -7429,7 +7429,7 @@ signature" for a type constructor? These are the forms:
 
 -  An associated type or data family declaration has a CUSK precisely if
    its enclosing class has a CUSK. ::
-       
+
        class C a where                -- no CUSK
          type AT a b                  -- no CUSK, b is defaulted
 
@@ -7545,7 +7545,7 @@ Explicit kind quantification
 
 Enabled by :ghc-flag:`-XTypeInType`, GHC now supports explicit kind quantification,
 as in these examples: ::
-  
+
   data Proxy :: forall k. k -> *
   f :: (forall k (a :: k). Proxy a -> ()) -> Int
 
@@ -7705,7 +7705,7 @@ Here is an example of this in action: ::
 
 In the last line, we use the promoted constructor ``'MkCompose``, which has
 kind ::
-  
+
   forall (a :: *) (b :: *) (f :: b -> *) (g :: a -> b) (x :: a).
     f (g x) -> Compose f g x
 
@@ -7728,7 +7728,7 @@ these flags, especially :ghc-flag:`-fprint-explicit-kinds`.
 .. index::
    single: TYPE
    single: representation polymorphism
-   
+
 .. _runtime-rep:
 
 Runtime representation polymorphism
@@ -7755,7 +7755,7 @@ Here are the key definitions, all available from ``GHC.Exts``: ::
                   | PtrRepUnlifted   -- for things like `Array#`
                   | IntRep           -- for things like `Int#`
                   | ...
-  
+
   type * = TYPE PtrRepLifted    -- * is just an ordinary type synonym
 
 The idea is that we have a new fundamental type constant ``TYPE``, which
@@ -11113,7 +11113,7 @@ bang it would be lazy. Bang patterns can be nested of course: ::
 
     f2 (!x, y) = [x,y]
 
-Here, ``f2`` is strict in ``x`` but not in ``y``. 
+Here, ``f2`` is strict in ``x`` but not in ``y``.
 
 Note the following points:
 
@@ -13019,16 +13019,20 @@ datatypes and their internal representation as a sum-of-products: ::
       -- Convert from the representation to the datatype
       to    :: (Rep a) x -> a
 
-    class Generic1 f where
-      type Rep1 f :: * -> *
+    class Generic1 (f :: k -> *) where
+      type Rep1 f :: k -> *
 
       from1  :: f a -> Rep1 f a
       to1    :: Rep1 f a -> f a
 
 ``Generic1`` is used for functions that can only be defined over type
-containers, such as ``map``. Instances of these classes can be derived
-by GHC with the :ghc-flag:`-XDeriveGeneric`, and are
-necessary to be able to define generic instances automatically.
+containers, such as ``map``. Note that ``Generic1`` ranges over types of kind
+``* -> *`` by default, but if the :ghc-flag:`-XPolyKinds` extension is enabled,
+then it can range of types of kind ``k -> *``, for any kind ``k``.
+
+Instances of these classes can be derived by GHC with the
+:ghc-flag:`-XDeriveGeneric` extension, and are necessary to be able to define
+generic instances automatically.
 
 For example, a user-defined datatype of trees ::
 
index fd189ed..df1b9de 100644 (file)
@@ -1632,7 +1632,8 @@ comp1Constr = mkConstr comp1DataType "Comp1" [] Prefix
 comp1DataType :: DataType
 comp1DataType = mkDataType "GHC.Generics.:.:" [comp1Constr]
 
-instance (Typeable f, Typeable g, Data p, Data (f (g p)))
+instance (Typeable (f :: * -> *), Typeable (g :: * -> *),
+          Data p, Data (f (g p)))
     => Data ((f :.: g) p) where
   gfoldl k z (Comp1 c) = z Comp1 `k` c
   toConstr (Comp1 _) = m1Constr
index 62c3576..e45b761 100644 (file)
@@ -475,7 +475,9 @@ module GHC.Generics  (
 --
 -- Like 'Generic', there is a class 'Generic1' that defines a
 -- representation 'Rep1' and conversion functions 'from1' and 'to1',
--- only that 'Generic1' ranges over types of kind @* -> *@.
+-- only that 'Generic1' ranges over types of kind @* -> *@. (More generally,
+-- it can range over types of kind @k -> *@, for any kind @k@, if the
+-- @PolyKinds@ extension is enabled. More on this later.)
 -- The 'Generic1' class is also derivable.
 --
 -- The representation 'Rep1' is ever so slightly different from 'Rep'.
@@ -512,7 +514,7 @@ module GHC.Generics  (
 --                          'DecidedLazy)
 --                ('Rec1' Tree)))
 --   ...
---  @
+-- @
 --
 -- The representation reuses 'D1', 'C1', 'S1' (and thereby 'M1') as well
 -- as ':+:' and ':*:' from 'Rep'. (This reusability is the reason that we
@@ -552,7 +554,7 @@ module GHC.Generics  (
 -- yields
 --
 -- @
--- class 'Rep1' WithInt where
+-- instance 'Generic1' WithInt where
 --   type 'Rep1' WithInt =
 --     'D1' ('MetaData \"WithInt\" \"Main\" \"package-name\" 'False)
 --       ('C1' ('MetaCons \"WithInt\" 'PrefixI 'False)
@@ -579,7 +581,7 @@ module GHC.Generics  (
 -- yields
 --
 -- @
--- class 'Rep1' Rose where
+-- instance 'Generic1' Rose where
 --   type 'Rep1' Rose =
 --     'D1' ('MetaData \"Rose\" \"Main\" \"package-name\" 'False)
 --       ('C1' ('MetaCons \"Fork\" 'PrefixI 'False)
@@ -602,6 +604,22 @@ module GHC.Generics  (
 -- newtype (':.:') f g p = 'Comp1' { 'unComp1' :: f (g p) }
 -- @
 
+-- *** Representation of @k -> *@ types
+--
+-- |
+--
+-- The 'Generic1' class can be generalized to range over types of kind
+-- @k -> *@, for any kind @k@. To do so, derive a 'Generic1' instance with the
+-- @PolyKinds@ extension enabled. For example, the declaration
+--
+-- @
+-- data Proxy (a :: k) = Proxy deriving 'Generic1'
+-- @
+--
+-- yields a slightly different instance depending on whether @PolyKinds@ is
+-- enabled. If compiled without @PolyKinds@, then @'Rep1' Proxy :: * -> *@, but
+-- if compiled with @PolyKinds@, then @'Rep1' Proxy :: k -> *@.
+
 -- *** Representation of unlifted types
 --
 -- |
@@ -609,8 +627,8 @@ module GHC.Generics  (
 -- If one were to attempt to derive a Generic instance for a datatype with an
 -- unlifted argument (for example, 'Int#'), one might expect the occurrence of
 -- the 'Int#' argument to be marked with @'Rec0' 'Int#'@. This won't work,
--- though, since 'Int#' is of kind @#@ and 'Rec0' expects a type of kind @*@.
--- In fact, polymorphism over unlifted types is disallowed completely.
+-- though, since 'Int#' is of an unlifted kind, and 'Rec0' expects a type of
+-- kind @*@.
 --
 -- One solution would be to represent an occurrence of 'Int#' with 'Rec0 Int'
 -- instead. With this approach, however, the programmer has no way of knowing
@@ -726,7 +744,7 @@ import GHC.TypeLits ( Nat, Symbol, KnownSymbol, KnownNat, symbolVal, natVal )
 --------------------------------------------------------------------------------
 
 -- | Void: used for datatypes without constructors
-data V1 (p :: *)
+data V1 (p :: k)
   deriving (Functor, Generic, Generic1)
 
 deriving instance Eq   (V1 p)
@@ -735,7 +753,7 @@ deriving instance Read (V1 p)
 deriving instance Show (V1 p)
 
 -- | Unit: used for constructors without arguments
-data U1 (p :: *) = U1
+data U1 (p :: k) = U1
   deriving (Generic, Generic1)
 
 instance Eq (U1 p) where
@@ -777,8 +795,9 @@ instance Applicative Par1 where
 instance Monad Par1 where
   Par1 x >>= f = f x
 
--- | Recursive calls of kind * -> *
-newtype Rec1 f (p :: *) = Rec1 { unRec1 :: f p }
+-- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@
+-- is enabled)
+newtype Rec1 (f :: k -> *) (p :: k) = Rec1 { unRec1 :: f p }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 instance Applicative f => Applicative (Rec1 f) where
@@ -794,8 +813,8 @@ instance Monad f => Monad (Rec1 f) where
 
 instance MonadPlus f => MonadPlus (Rec1 f)
 
--- | Constants, additional parameters and recursion of kind *
-newtype K1 (i :: *) c (p :: *) = K1 { unK1 :: c }
+-- | Constants, additional parameters and recursion of kind @*@
+newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 instance Applicative f => Applicative (M1 i c f) where
@@ -812,17 +831,17 @@ instance Monad f => Monad (M1 i c f) where
 instance MonadPlus f => MonadPlus (M1 i c f)
 
 -- | Meta-information (constructor names, etc.)
-newtype M1 (i :: *) (c :: Meta) f (p :: *) = M1 { unM1 :: f p }
+newtype M1 (i :: *) (c :: Meta) (f :: k -> *) (p :: k) = M1 { unM1 :: f p }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 -- | Sums: encode choice between constructors
 infixr 5 :+:
-data (:+:) f g (p :: *) = L1 (f p) | R1 (g p)
+data (:+:) (f :: k -> *) (g :: k -> *) (p :: k) = L1 (f p) | R1 (g p)
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 -- | Products: encode multiple arguments to constructors
 infixr 6 :*:
-data (:*:) f g (p :: *) = f p :*: g p
+data (:*:) (f :: k -> *) (g :: k -> *) (p :: k) = f p :*: g p
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 instance (Applicative f, Applicative g) => Applicative (f :*: g) where
@@ -843,7 +862,8 @@ instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g)
 
 -- | Composition of functors
 infixr 7 :.:
-newtype (:.:) f (g :: * -> *) (p :: *) = Comp1 { unComp1 :: f (g p) }
+newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =
+    Comp1 { unComp1 :: f (g p) }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 instance (Applicative f, Applicative g) => Applicative (f :.: g) where
@@ -854,76 +874,76 @@ instance (Alternative f, Applicative g) => Alternative (f :.: g) where
   empty = Comp1 empty
   Comp1 x <|> Comp1 y = Comp1 (x <|> y)
 
--- | Constants of kind @#@
+-- | Constants of unlifted kinds
 --
 -- @since 4.9.0.0
-data family URec (a :: *) (p :: *)
+data family URec (a :: *) (p :: k)
 
 -- | Used for marking occurrences of 'Addr#'
 --
 -- @since 4.9.0.0
-data instance URec (Ptr ()) p = UAddr { uAddr# :: Addr# }
+data instance URec (Ptr ()) (p :: k) = UAddr { uAddr# :: Addr# }
   deriving (Eq, Ord, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Char#'
 --
 -- @since 4.9.0.0
-data instance URec Char p = UChar { uChar# :: Char# }
+data instance URec Char (p :: k) = UChar { uChar# :: Char# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Double#'
 --
 -- @since 4.9.0.0
-data instance URec Double p = UDouble { uDouble# :: Double# }
+data instance URec Double (p :: k) = UDouble { uDouble# :: Double# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Float#'
 --
 -- @since 4.9.0.0
-data instance URec Float p = UFloat { uFloat# :: Float# }
+data instance URec Float (p :: k) = UFloat { uFloat# :: Float# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Int#'
 --
 -- @since 4.9.0.0
-data instance URec Int p = UInt { uInt# :: Int# }
+data instance URec Int (p :: k) = UInt { uInt# :: Int# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Word#'
 --
 -- @since 4.9.0.0
-data instance URec Word p = UWord { uWord# :: Word# }
+data instance URec Word (p :: k) = UWord { uWord# :: Word# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
--- | Type synonym for 'URec': 'Addr#'
+-- | Type synonym for @'URec' 'Addr#'@
 --
 -- @since 4.9.0.0
 type UAddr   = URec (Ptr ())
--- | Type synonym for 'URec': 'Char#'
+-- | Type synonym for @'URec' 'Char#'@
 --
 -- @since 4.9.0.0
 type UChar   = URec Char
--- | Type synonym for 'URec': 'Double#'
+-- | Type synonym for @'URec' 'Double#'@
 --
 -- @since 4.9.0.0
 type UDouble = URec Double
--- | Type synonym for 'URec': 'Float#'
+-- | Type synonym for @'URec' 'Float#'@
 --
 -- @since 4.9.0.0
 type UFloat  = URec Float
--- | Type synonym for 'URec': 'Int#'
+-- | Type synonym for @'URec' 'Int#'@
 --
 -- @since 4.9.0.0
 type UInt    = URec Int
--- | Type synonym for 'URec': 'Word#'
+-- | Type synonym for @'URec' 'Word#'@
 --
 -- @since 4.9.0.0
 type UWord   = URec Word
 
--- | Tag for K1: recursion (of kind *)
+-- | Tag for K1: recursion (of kind @*@)
 data R
 
--- | Type synonym for encoding recursion (of kind *)
+-- | Type synonym for encoding recursion (of kind @*@)
 type Rec0  = K1 R
 
 -- | Tag for M1: datatype
@@ -945,17 +965,17 @@ type S1 = M1 S
 -- | Class for datatypes that represent datatypes
 class Datatype d where
   -- | The name of the datatype (unqualified)
-  datatypeName :: t d (f :: * -> *) a -> [Char]
+  datatypeName :: t d (f :: k -> *) (a :: k) -> [Char]
   -- | The fully-qualified name of the module where the type is declared
-  moduleName   :: t d (f :: * -> *) a -> [Char]
+  moduleName   :: t d (f :: k -> *) (a :: k) -> [Char]
   -- | The package name of the module where the type is declared
   --
   -- @since 4.9.0.0
-  packageName :: t d (f :: * -> *) a -> [Char]
+  packageName :: t d (f :: k -> *) (a :: k) -> [Char]
   -- | Marks if the datatype is actually a newtype
   --
   -- @since 4.7.0.0
-  isNewtype    :: t d (f :: * -> *) a -> Bool
+  isNewtype    :: t d (f :: k -> *) (a :: k) -> Bool
   isNewtype _ = False
 
 instance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt)
@@ -968,14 +988,14 @@ instance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt)
 -- | Class for datatypes that represent data constructors
 class Constructor c where
   -- | The name of the constructor
-  conName :: t c (f :: * -> *) a -> [Char]
+  conName :: t c (f :: k -> *) (a :: k) -> [Char]
 
   -- | The fixity of the constructor
-  conFixity :: t c (f :: * -> *) a -> Fixity
+  conFixity :: t c (f :: k -> *) (a :: k) -> Fixity
   conFixity _ = Prefix
 
   -- | Marks if this constructor is a record
-  conIsRecord :: t c (f :: * -> *) a -> Bool
+  conIsRecord :: t c (f :: k -> *) (a :: k) -> Bool
   conIsRecord _ = False
 
 instance (KnownSymbol n, SingI f, SingI r)
@@ -1069,19 +1089,19 @@ data DecidedStrictness = DecidedLazy
 -- | Class for datatypes that represent records
 class Selector s where
   -- | The name of the selector
-  selName :: t s (f :: * -> *) a -> [Char]
+  selName :: t s (f :: k -> *) (a :: k) -> [Char]
   -- | The selector's unpackedness annotation (if any)
   --
   -- @since 4.9.0.0
-  selSourceUnpackedness :: t s (f :: * -> *) a -> SourceUnpackedness
+  selSourceUnpackedness :: t s (f :: k -> *) (a :: k) -> SourceUnpackedness
   -- | The selector's strictness annotation (if any)
   --
   -- @since 4.9.0.0
-  selSourceStrictness :: t s (f :: * -> *) a -> SourceStrictness
+  selSourceStrictness :: t s (f :: k -> *) (a :: k) -> SourceStrictness
   -- | The strictness that the compiler inferred for the selector
   --
   -- @since 4.9.0.0
-  selDecidedStrictness :: t s (f :: * -> *) a -> DecidedStrictness
+  selDecidedStrictness :: t s (f :: k -> *) (a :: k) -> DecidedStrictness
 
 instance (SingI mn, SingI su, SingI ss, SingI ds)
     => Selector ('MetaSel mn su ss ds) where
@@ -1101,11 +1121,12 @@ class Generic a where
   to    :: (Rep a) x -> a
 
 
--- | Representable types of kind * -> *.
--- This class is derivable in GHC with the DeriveGeneric flag on.
-class Generic1 f where
+-- | Representable types of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@
+-- is enabled).
+-- This class is derivable in GHC with the @DeriveGeneric@ flag on.
+class Generic1 (f :: k -> *) where
   -- | Generic representation type
-  type Rep1 f :: * -> *
+  type Rep1 f :: k -> *
   -- | Convert from the datatype to its representation
   from1  :: f a -> (Rep1 f) a
   -- | Convert from the representation to the datatype
index 4b40db7..4cb2533 100644 (file)
@@ -6,6 +6,9 @@
   * `Foreign.Ptr` now exports the constructors for `IntPtr` and `WordPtr`
     (#11983)
 
+  * `Generic1`, as well as the associated datatypes and typeclasses in
+    `GHC.Generics`, are now poly-kinded (#10604)
+
 ## 4.9.0.0  *TBA*
 
   * Bundled with GHC 8.0
diff --git a/testsuite/tests/generics/T10604/Makefile b/testsuite/tests/generics/T10604/Makefile
new file mode 100644 (file)
index 0000000..9101fbd
--- /dev/null
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/generics/T10604/T10604_Authenticated.hs b/testsuite/tests/generics/T10604/T10604_Authenticated.hs
new file mode 100644 (file)
index 0000000..b43c11b
--- /dev/null
@@ -0,0 +1,41 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeOperators #-}
+module T10604_Authenticated where
+
+import GHC.Generics
+
+data AuthParam = Prover | Verifier
+
+class MapAuth f where
+    mapAuth :: f 'Prover -> f 'Verifier
+    default mapAuth :: (GMapAuth (Rep1 f), Generic1 f)
+                    => f 'Prover -> f 'Verifier
+    mapAuth = to1 . gmapAuth . from1
+
+class GMapAuth f where
+    gmapAuth :: f 'Prover -> f 'Verifier
+
+instance GMapAuth V1 where
+    gmapAuth = undefined
+
+instance GMapAuth U1 where
+    gmapAuth U1 = U1
+
+instance (GMapAuth l, GMapAuth r) => GMapAuth (l :+: r) where
+    gmapAuth (L1 x) = L1 (gmapAuth x)
+    gmapAuth (R1 x) = R1 (gmapAuth x)
+
+instance (GMapAuth l, GMapAuth r) => GMapAuth (l :*: r) where
+    gmapAuth (x :*: y) = gmapAuth x :*: gmapAuth y
+
+instance GMapAuth (K1 i c) where
+    gmapAuth (K1 c) = K1 c
+
+instance (GMapAuth f) => GMapAuth (M1 i t f) where
+    gmapAuth (M1 x) = M1 (gmapAuth x)
+
+instance (MapAuth f) => GMapAuth (Rec1 f) where
+    gmapAuth (Rec1 x) = Rec1 (mapAuth x)
diff --git a/testsuite/tests/generics/T10604/T10604_bad_variable_occurrence.hs b/testsuite/tests/generics/T10604/T10604_bad_variable_occurrence.hs
new file mode 100644 (file)
index 0000000..53ad879
--- /dev/null
@@ -0,0 +1,8 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE PolyKinds #-}
+module T10604_bad_variable_occurrence where
+
+import GHC.Generics
+
+newtype Fix f = In { out :: f (Fix f) }
+  deriving Generic1
diff --git a/testsuite/tests/generics/T10604/T10604_bad_variable_occurrence.stderr b/testsuite/tests/generics/T10604/T10604_bad_variable_occurrence.stderr
new file mode 100644 (file)
index 0000000..26c6a55
--- /dev/null
@@ -0,0 +1,6 @@
+
+T10604_bad_variable_occurrence.hs:8:12: error:
+    • Can't make a derived instance of ‘Generic1 Fix’:
+        Constructor ‘In’ applies a type to an argument involving the last parameter
+                         but the applied type is not of kind * -> *
+    • In the newtype declaration for ‘Fix’
diff --git a/testsuite/tests/generics/T10604/T10604_deriving.hs b/testsuite/tests/generics/T10604/T10604_deriving.hs
new file mode 100644 (file)
index 0000000..5bdf586
--- /dev/null
@@ -0,0 +1,22 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE PolyKinds #-}
+{-# OPTIONS_GHC -ddump-deriv -fprint-explicit-kinds #-}
+module T10604_deriving where
+
+import GHC.Generics
+
+data Empty (a :: Bool)
+  deriving (Generic, Generic1)
+data Proxy (a :: k) = Proxy
+  deriving (Functor, Generic, Generic1)
+data Wrap (a :: * -> *) = Wrap (Proxy a)
+  deriving (Generic, Generic1)
+data Wrap2 (a :: k -> *) = Wrap2 (Proxy (Proxy a))
+  deriving (Generic, Generic1)
+data SumOfProducts a = Prod1 (Proxy a) (Proxy a) | Prod2 (Proxy a) (Proxy a)
+  deriving (Generic, Generic1)
+
+data Starify a = Starify1 a | Starify2 Int
+  deriving (Generic, Generic1)
diff --git a/testsuite/tests/generics/T10604/T10604_deriving.stderr b/testsuite/tests/generics/T10604/T10604_deriving.stderr
new file mode 100644 (file)
index 0000000..b4168d1
--- /dev/null
@@ -0,0 +1,518 @@
+
+==================== Derived instances ====================
+Derived instances:
+  instance GHC.Generics.Generic (T10604_deriving.Empty a) where
+    GHC.Generics.from _
+      = GHC.Generics.M1
+          (GHC.Err.error
+             "No generic representation for empty datatype Empty")
+    GHC.Generics.to (GHC.Generics.M1 _)
+      = GHC.Err.error "No values for empty datatype Empty"
+  
+  instance GHC.Generics.Generic1
+             GHC.Types.Bool T10604_deriving.Empty where
+    GHC.Generics.from1 _
+      = GHC.Generics.M1
+          (GHC.Err.error
+             "No generic representation for empty datatype Empty")
+    GHC.Generics.to1 (GHC.Generics.M1 _)
+      = GHC.Err.error "No values for empty datatype Empty"
+  
+  instance GHC.Base.Functor (T10604_deriving.Proxy *) where
+    GHC.Base.fmap f T10604_deriving.Proxy = T10604_deriving.Proxy
+  
+  instance forall k (a :: k).
+           GHC.Generics.Generic (T10604_deriving.Proxy k a) where
+    GHC.Generics.from T10604_deriving.Proxy
+      = GHC.Generics.M1 (GHC.Generics.M1 GHC.Generics.U1)
+    GHC.Generics.to (GHC.Generics.M1 (GHC.Generics.M1 GHC.Generics.U1))
+      = T10604_deriving.Proxy
+  
+  instance GHC.Generics.Generic1 k (T10604_deriving.Proxy k) where
+    GHC.Generics.from1 T10604_deriving.Proxy
+      = GHC.Generics.M1 (GHC.Generics.M1 GHC.Generics.U1)
+    GHC.Generics.to1
+      (GHC.Generics.M1 (GHC.Generics.M1 GHC.Generics.U1))
+      = T10604_deriving.Proxy
+  
+  instance GHC.Generics.Generic (T10604_deriving.Wrap a) where
+    GHC.Generics.from (T10604_deriving.Wrap g1)
+      = GHC.Generics.M1
+          (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)))
+    GHC.Generics.to
+      (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))))
+      = T10604_deriving.Wrap g1
+  
+  instance GHC.Generics.Generic1
+             (GHC.Types.* -> GHC.Types.*) T10604_deriving.Wrap where
+    GHC.Generics.from1 (T10604_deriving.Wrap g1)
+      = GHC.Generics.M1
+          (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.Rec1 g1)))
+    GHC.Generics.to1
+      (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.M1 g1)))
+      = T10604_deriving.Wrap (GHC.Generics.unRec1 g1)
+  
+  instance forall k (a :: k -> GHC.Types.*).
+           GHC.Generics.Generic (T10604_deriving.Wrap2 k a) where
+    GHC.Generics.from (T10604_deriving.Wrap2 g1)
+      = GHC.Generics.M1
+          (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)))
+    GHC.Generics.to
+      (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))))
+      = T10604_deriving.Wrap2 g1
+  
+  instance GHC.Generics.Generic1
+             (k -> GHC.Types.*) (T10604_deriving.Wrap2 k) where
+    GHC.Generics.from1 (T10604_deriving.Wrap2 g1)
+      = GHC.Generics.M1
+          (GHC.Generics.M1
+             (GHC.Generics.M1
+                ((GHC.Base..)
+                   GHC.Generics.Comp1 (GHC.Base.fmap GHC.Generics.Rec1) g1)))
+    GHC.Generics.to1
+      (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.M1 g1)))
+      = T10604_deriving.Wrap2
+          ((GHC.Base..)
+             (GHC.Base.fmap GHC.Generics.unRec1) GHC.Generics.unComp1 g1)
+  
+  instance forall k (a :: k).
+           GHC.Generics.Generic (T10604_deriving.SumOfProducts k a) where
+    GHC.Generics.from (T10604_deriving.Prod1 g1 g2)
+      = GHC.Generics.M1
+          (GHC.Generics.L1
+             (GHC.Generics.M1
+                ((GHC.Generics.:*:)
+                   (GHC.Generics.M1 (GHC.Generics.K1 g1))
+                   (GHC.Generics.M1 (GHC.Generics.K1 g2)))))
+    GHC.Generics.from (T10604_deriving.Prod2 g1 g2)
+      = GHC.Generics.M1
+          (GHC.Generics.R1
+             (GHC.Generics.M1
+                ((GHC.Generics.:*:)
+                   (GHC.Generics.M1 (GHC.Generics.K1 g1))
+                   (GHC.Generics.M1 (GHC.Generics.K1 g2)))))
+    GHC.Generics.to
+      (GHC.Generics.M1 (GHC.Generics.L1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1))
+                                                                             (GHC.Generics.M1 (GHC.Generics.K1 g2))))))
+      = T10604_deriving.Prod1 g1 g2
+    GHC.Generics.to
+      (GHC.Generics.M1 (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1))
+                                                                             (GHC.Generics.M1 (GHC.Generics.K1 g2))))))
+      = T10604_deriving.Prod2 g1 g2
+  
+  instance GHC.Generics.Generic1
+             k (T10604_deriving.SumOfProducts k) where
+    GHC.Generics.from1 (T10604_deriving.Prod1 g1 g2)
+      = GHC.Generics.M1
+          (GHC.Generics.L1
+             (GHC.Generics.M1
+                ((GHC.Generics.:*:)
+                   (GHC.Generics.M1 (GHC.Generics.Rec1 g1))
+                   (GHC.Generics.M1 (GHC.Generics.Rec1 g2)))))
+    GHC.Generics.from1 (T10604_deriving.Prod2 g1 g2)
+      = GHC.Generics.M1
+          (GHC.Generics.R1
+             (GHC.Generics.M1
+                ((GHC.Generics.:*:)
+                   (GHC.Generics.M1 (GHC.Generics.Rec1 g1))
+                   (GHC.Generics.M1 (GHC.Generics.Rec1 g2)))))
+    GHC.Generics.to1
+      (GHC.Generics.M1 (GHC.Generics.L1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1)
+                                                                             (GHC.Generics.M1 g2)))))
+      = T10604_deriving.Prod1
+          (GHC.Generics.unRec1 g1) (GHC.Generics.unRec1 g2)
+    GHC.Generics.to1
+      (GHC.Generics.M1 (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1)
+                                                                             (GHC.Generics.M1 g2)))))
+      = T10604_deriving.Prod2
+          (GHC.Generics.unRec1 g1) (GHC.Generics.unRec1 g2)
+  
+  instance GHC.Generics.Generic (T10604_deriving.Starify a) where
+    GHC.Generics.from (T10604_deriving.Starify1 g1)
+      = GHC.Generics.M1
+          (GHC.Generics.L1
+             (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))))
+    GHC.Generics.from (T10604_deriving.Starify2 g1)
+      = GHC.Generics.M1
+          (GHC.Generics.R1
+             (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))))
+    GHC.Generics.to
+      (GHC.Generics.M1 (GHC.Generics.L1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)))))
+      = T10604_deriving.Starify1 g1
+    GHC.Generics.to
+      (GHC.Generics.M1 (GHC.Generics.R1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)))))
+      = T10604_deriving.Starify2 g1
+  
+  instance GHC.Generics.Generic1 * T10604_deriving.Starify where
+    GHC.Generics.from1 (T10604_deriving.Starify1 g1)
+      = GHC.Generics.M1
+          (GHC.Generics.L1
+             (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.Par1 g1))))
+    GHC.Generics.from1 (T10604_deriving.Starify2 g1)
+      = GHC.Generics.M1
+          (GHC.Generics.R1
+             (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))))
+    GHC.Generics.to1
+      (GHC.Generics.M1 (GHC.Generics.L1 (GHC.Generics.M1 (GHC.Generics.M1 g1))))
+      = T10604_deriving.Starify1 (GHC.Generics.unPar1 g1)
+    GHC.Generics.to1
+      (GHC.Generics.M1 (GHC.Generics.R1 (GHC.Generics.M1 (GHC.Generics.M1 g1))))
+      = T10604_deriving.Starify2 (GHC.Generics.unK1 g1)
+  
+
+GHC.Generics representation types:
+  type GHC.Generics.Rep (T10604_deriving.Empty a) = GHC.Generics.D1
+                                                      *
+                                                      ('GHC.Generics.MetaData
+                                                         "Empty"
+                                                         "T10604_deriving"
+                                                         "main"
+                                                         'GHC.Types.False)
+                                                      (GHC.Generics.V1 *)
+  type GHC.Generics.Rep1
+         GHC.Types.Bool T10604_deriving.Empty = GHC.Generics.D1
+                                                  GHC.Types.Bool
+                                                  ('GHC.Generics.MetaData
+                                                     "Empty"
+                                                     "T10604_deriving"
+                                                     "main"
+                                                     'GHC.Types.False)
+                                                  (GHC.Generics.V1 GHC.Types.Bool)
+  type GHC.Generics.Rep (T10604_deriving.Proxy k a) = GHC.Generics.D1
+                                                        *
+                                                        ('GHC.Generics.MetaData
+                                                           "Proxy"
+                                                           "T10604_deriving"
+                                                           "main"
+                                                           'GHC.Types.False)
+                                                        (GHC.Generics.C1
+                                                           *
+                                                           ('GHC.Generics.MetaCons
+                                                              "Proxy"
+                                                              'GHC.Generics.PrefixI
+                                                              'GHC.Types.False)
+                                                           (GHC.Generics.U1 *))
+  type GHC.Generics.Rep1
+         k (T10604_deriving.Proxy k) = GHC.Generics.D1
+                                         k
+                                         ('GHC.Generics.MetaData
+                                            "Proxy" "T10604_deriving" "main" 'GHC.Types.False)
+                                         (GHC.Generics.C1
+                                            k
+                                            ('GHC.Generics.MetaCons
+                                               "Proxy" 'GHC.Generics.PrefixI 'GHC.Types.False)
+                                            (GHC.Generics.U1 k))
+  type GHC.Generics.Rep (T10604_deriving.Wrap a) = GHC.Generics.D1
+                                                     *
+                                                     ('GHC.Generics.MetaData
+                                                        "Wrap"
+                                                        "T10604_deriving"
+                                                        "main"
+                                                        'GHC.Types.False)
+                                                     (GHC.Generics.C1
+                                                        *
+                                                        ('GHC.Generics.MetaCons
+                                                           "Wrap"
+                                                           'GHC.Generics.PrefixI
+                                                           'GHC.Types.False)
+                                                        (GHC.Generics.S1
+                                                           *
+                                                           ('GHC.Generics.MetaSel
+                                                              ('GHC.Base.Nothing GHC.Types.Symbol)
+                                                              'GHC.Generics.NoSourceUnpackedness
+                                                              'GHC.Generics.NoSourceStrictness
+                                                              'GHC.Generics.DecidedLazy)
+                                                           (GHC.Generics.Rec0
+                                                              *
+                                                              (T10604_deriving.Proxy
+                                                                 (GHC.Types.* -> GHC.Types.*) a))))
+  type GHC.Generics.Rep1
+         (GHC.Types.* -> GHC.Types.*) T10604_deriving.Wrap = GHC.Generics.D1
+                                                               (GHC.Types.* -> GHC.Types.*)
+                                                               ('GHC.Generics.MetaData
+                                                                  "Wrap"
+                                                                  "T10604_deriving"
+                                                                  "main"
+                                                                  'GHC.Types.False)
+                                                               (GHC.Generics.C1
+                                                                  (GHC.Types.* -> GHC.Types.*)
+                                                                  ('GHC.Generics.MetaCons
+                                                                     "Wrap"
+                                                                     'GHC.Generics.PrefixI
+                                                                     'GHC.Types.False)
+                                                                  (GHC.Generics.S1
+                                                                     (GHC.Types.* -> GHC.Types.*)
+                                                                     ('GHC.Generics.MetaSel
+                                                                        ('GHC.Base.Nothing
+                                                                           GHC.Types.Symbol)
+                                                                        'GHC.Generics.NoSourceUnpackedness
+                                                                        'GHC.Generics.NoSourceStrictness
+                                                                        'GHC.Generics.DecidedLazy)
+                                                                     (GHC.Generics.Rec1
+                                                                        (GHC.Types.* -> GHC.Types.*)
+                                                                        (T10604_deriving.Proxy
+                                                                           (GHC.Types.*
+                                                                            -> GHC.Types.*)))))
+  type GHC.Generics.Rep (T10604_deriving.Wrap2 k a) = GHC.Generics.D1
+                                                        *
+                                                        ('GHC.Generics.MetaData
+                                                           "Wrap2"
+                                                           "T10604_deriving"
+                                                           "main"
+                                                           'GHC.Types.False)
+                                                        (GHC.Generics.C1
+                                                           *
+                                                           ('GHC.Generics.MetaCons
+                                                              "Wrap2"
+                                                              'GHC.Generics.PrefixI
+                                                              'GHC.Types.False)
+                                                           (GHC.Generics.S1
+                                                              *
+                                                              ('GHC.Generics.MetaSel
+                                                                 ('GHC.Base.Nothing
+                                                                    GHC.Types.Symbol)
+                                                                 'GHC.Generics.NoSourceUnpackedness
+                                                                 'GHC.Generics.NoSourceStrictness
+                                                                 'GHC.Generics.DecidedLazy)
+                                                              (GHC.Generics.Rec0
+                                                                 *
+                                                                 (T10604_deriving.Proxy
+                                                                    *
+                                                                    (T10604_deriving.Proxy
+                                                                       (k -> GHC.Types.*) a)))))
+  type GHC.Generics.Rep1
+         (k -> GHC.Types.*) (T10604_deriving.Wrap2 k) = GHC.Generics.D1
+                                                          (k -> GHC.Types.*)
+                                                          ('GHC.Generics.MetaData
+                                                             "Wrap2"
+                                                             "T10604_deriving"
+                                                             "main"
+                                                             'GHC.Types.False)
+                                                          (GHC.Generics.C1
+                                                             (k -> GHC.Types.*)
+                                                             ('GHC.Generics.MetaCons
+                                                                "Wrap2"
+                                                                'GHC.Generics.PrefixI
+                                                                'GHC.Types.False)
+                                                             (GHC.Generics.S1
+                                                                (k -> GHC.Types.*)
+                                                                ('GHC.Generics.MetaSel
+                                                                   ('GHC.Base.Nothing
+                                                                      GHC.Types.Symbol)
+                                                                   'GHC.Generics.NoSourceUnpackedness
+                                                                   'GHC.Generics.NoSourceStrictness
+                                                                   'GHC.Generics.DecidedLazy)
+                                                                ((GHC.Generics.:.:)
+                                                                   (k -> GHC.Types.*)
+                                                                   *
+                                                                   (T10604_deriving.Proxy *)
+                                                                   (GHC.Generics.Rec1
+                                                                      (k -> GHC.Types.*)
+                                                                      (T10604_deriving.Proxy
+                                                                         (k -> GHC.Types.*))))))
+  type GHC.Generics.Rep
+         (T10604_deriving.SumOfProducts k a) = GHC.Generics.D1
+                                                 *
+                                                 ('GHC.Generics.MetaData
+                                                    "SumOfProducts"
+                                                    "T10604_deriving"
+                                                    "main"
+                                                    'GHC.Types.False)
+                                                 ((GHC.Generics.:+:)
+                                                    *
+                                                    (GHC.Generics.C1
+                                                       *
+                                                       ('GHC.Generics.MetaCons
+                                                          "Prod1"
+                                                          'GHC.Generics.PrefixI
+                                                          'GHC.Types.False)
+                                                       ((GHC.Generics.:*:)
+                                                          *
+                                                          (GHC.Generics.S1
+                                                             *
+                                                             ('GHC.Generics.MetaSel
+                                                                ('GHC.Base.Nothing GHC.Types.Symbol)
+                                                                'GHC.Generics.NoSourceUnpackedness
+                                                                'GHC.Generics.NoSourceStrictness
+                                                                'GHC.Generics.DecidedLazy)
+                                                             (GHC.Generics.Rec0
+                                                                * (T10604_deriving.Proxy k a)))
+                                                          (GHC.Generics.S1
+                                                             *
+                                                             ('GHC.Generics.MetaSel
+                                                                ('GHC.Base.Nothing GHC.Types.Symbol)
+                                                                'GHC.Generics.NoSourceUnpackedness
+                                                                'GHC.Generics.NoSourceStrictness
+                                                                'GHC.Generics.DecidedLazy)
+                                                             (GHC.Generics.Rec0
+                                                                * (T10604_deriving.Proxy k a)))))
+                                                    (GHC.Generics.C1
+                                                       *
+                                                       ('GHC.Generics.MetaCons
+                                                          "Prod2"
+                                                          'GHC.Generics.PrefixI
+                                                          'GHC.Types.False)
+                                                       ((GHC.Generics.:*:)
+                                                          *
+                                                          (GHC.Generics.S1
+                                                             *
+                                                             ('GHC.Generics.MetaSel
+                                                                ('GHC.Base.Nothing GHC.Types.Symbol)
+                                                                'GHC.Generics.NoSourceUnpackedness
+                                                                'GHC.Generics.NoSourceStrictness
+                                                                'GHC.Generics.DecidedLazy)
+                                                             (GHC.Generics.Rec0
+                                                                * (T10604_deriving.Proxy k a)))
+                                                          (GHC.Generics.S1
+                                                             *
+                                                             ('GHC.Generics.MetaSel
+                                                                ('GHC.Base.Nothing GHC.Types.Symbol)
+                                                                'GHC.Generics.NoSourceUnpackedness
+                                                                'GHC.Generics.NoSourceStrictness
+                                                                'GHC.Generics.DecidedLazy)
+                                                             (GHC.Generics.Rec0
+                                                                * (T10604_deriving.Proxy k a))))))
+  type GHC.Generics.Rep1
+         k (T10604_deriving.SumOfProducts k) = GHC.Generics.D1
+                                                 k
+                                                 ('GHC.Generics.MetaData
+                                                    "SumOfProducts"
+                                                    "T10604_deriving"
+                                                    "main"
+                                                    'GHC.Types.False)
+                                                 ((GHC.Generics.:+:)
+                                                    k
+                                                    (GHC.Generics.C1
+                                                       k
+                                                       ('GHC.Generics.MetaCons
+                                                          "Prod1"
+                                                          'GHC.Generics.PrefixI
+                                                          'GHC.Types.False)
+                                                       ((GHC.Generics.:*:)
+                                                          k
+                                                          (GHC.Generics.S1
+                                                             k
+                                                             ('GHC.Generics.MetaSel
+                                                                ('GHC.Base.Nothing GHC.Types.Symbol)
+                                                                'GHC.Generics.NoSourceUnpackedness
+                                                                'GHC.Generics.NoSourceStrictness
+                                                                'GHC.Generics.DecidedLazy)
+                                                             (GHC.Generics.Rec1
+                                                                k (T10604_deriving.Proxy k)))
+                                                          (GHC.Generics.S1
+                                                             k
+                                                             ('GHC.Generics.MetaSel
+                                                                ('GHC.Base.Nothing GHC.Types.Symbol)
+                                                                'GHC.Generics.NoSourceUnpackedness
+                                                                'GHC.Generics.NoSourceStrictness
+                                                                'GHC.Generics.DecidedLazy)
+                                                             (GHC.Generics.Rec1
+                                                                k (T10604_deriving.Proxy k)))))
+                                                    (GHC.Generics.C1
+                                                       k
+                                                       ('GHC.Generics.MetaCons
+                                                          "Prod2"
+                                                          'GHC.Generics.PrefixI
+                                                          'GHC.Types.False)
+                                                       ((GHC.Generics.:*:)
+                                                          k
+                                                          (GHC.Generics.S1
+                                                             k
+                                                             ('GHC.Generics.MetaSel
+                                                                ('GHC.Base.Nothing GHC.Types.Symbol)
+                                                                'GHC.Generics.NoSourceUnpackedness
+                                                                'GHC.Generics.NoSourceStrictness
+                                                                'GHC.Generics.DecidedLazy)
+                                                             (GHC.Generics.Rec1
+                                                                k (T10604_deriving.Proxy k)))
+                                                          (GHC.Generics.S1
+                                                             k
+                                                             ('GHC.Generics.MetaSel
+                                                                ('GHC.Base.Nothing GHC.Types.Symbol)
+                                                                'GHC.Generics.NoSourceUnpackedness
+                                                                'GHC.Generics.NoSourceStrictness
+                                                                'GHC.Generics.DecidedLazy)
+                                                             (GHC.Generics.Rec1
+                                                                k (T10604_deriving.Proxy k))))))
+  type GHC.Generics.Rep (T10604_deriving.Starify a) = GHC.Generics.D1
+                                                        *
+                                                        ('GHC.Generics.MetaData
+                                                           "Starify"
+                                                           "T10604_deriving"
+                                                           "main"
+                                                           'GHC.Types.False)
+                                                        ((GHC.Generics.:+:)
+                                                           *
+                                                           (GHC.Generics.C1
+                                                              *
+                                                              ('GHC.Generics.MetaCons
+                                                                 "Starify1"
+                                                                 'GHC.Generics.PrefixI
+                                                                 'GHC.Types.False)
+                                                              (GHC.Generics.S1
+                                                                 *
+                                                                 ('GHC.Generics.MetaSel
+                                                                    ('GHC.Base.Nothing
+                                                                       GHC.Types.Symbol)
+                                                                    'GHC.Generics.NoSourceUnpackedness
+                                                                    'GHC.Generics.NoSourceStrictness
+                                                                    'GHC.Generics.DecidedLazy)
+                                                                 (GHC.Generics.Rec0 * a)))
+                                                           (GHC.Generics.C1
+                                                              *
+                                                              ('GHC.Generics.MetaCons
+                                                                 "Starify2"
+                                                                 'GHC.Generics.PrefixI
+                                                                 'GHC.Types.False)
+                                                              (GHC.Generics.S1
+                                                                 *
+                                                                 ('GHC.Generics.MetaSel
+                                                                    ('GHC.Base.Nothing
+                                                                       GHC.Types.Symbol)
+                                                                    'GHC.Generics.NoSourceUnpackedness
+                                                                    'GHC.Generics.NoSourceStrictness
+                                                                    'GHC.Generics.DecidedLazy)
+                                                                 (GHC.Generics.Rec0
+                                                                    * GHC.Types.Int))))
+  type GHC.Generics.Rep1 * T10604_deriving.Starify = GHC.Generics.D1
+                                                       *
+                                                       ('GHC.Generics.MetaData
+                                                          "Starify"
+                                                          "T10604_deriving"
+                                                          "main"
+                                                          'GHC.Types.False)
+                                                       ((GHC.Generics.:+:)
+                                                          *
+                                                          (GHC.Generics.C1
+                                                             *
+                                                             ('GHC.Generics.MetaCons
+                                                                "Starify1"
+                                                                'GHC.Generics.PrefixI
+                                                                'GHC.Types.False)
+                                                             (GHC.Generics.S1
+                                                                *
+                                                                ('GHC.Generics.MetaSel
+                                                                   ('GHC.Base.Nothing
+                                                                      GHC.Types.Symbol)
+                                                                   'GHC.Generics.NoSourceUnpackedness
+                                                                   'GHC.Generics.NoSourceStrictness
+                                                                   'GHC.Generics.DecidedLazy)
+                                                                GHC.Generics.Par1))
+                                                          (GHC.Generics.C1
+                                                             *
+                                                             ('GHC.Generics.MetaCons
+                                                                "Starify2"
+                                                                'GHC.Generics.PrefixI
+                                                                'GHC.Types.False)
+                                                             (GHC.Generics.S1
+                                                                *
+                                                                ('GHC.Generics.MetaSel
+                                                                   ('GHC.Base.Nothing
+                                                                      GHC.Types.Symbol)
+                                                                   'GHC.Generics.NoSourceUnpackedness
+                                                                   'GHC.Generics.NoSourceStrictness
+                                                                   'GHC.Generics.DecidedLazy)
+                                                                (GHC.Generics.Rec0
+                                                                   * GHC.Types.Int))))
+
+
diff --git a/testsuite/tests/generics/T10604/T10604_no_PolyKinds.hs b/testsuite/tests/generics/T10604/T10604_no_PolyKinds.hs
new file mode 100644 (file)
index 0000000..bdb98ca
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE KindSignatures #-}
+module T10604_no_PolyKinds where
+
+import GHC.Generics
+
+data F (f :: * -> *) = F deriving Generic1
diff --git a/testsuite/tests/generics/T10604/T10604_no_PolyKinds.stderr b/testsuite/tests/generics/T10604/T10604_no_PolyKinds.stderr
new file mode 100644 (file)
index 0000000..69bc591
--- /dev/null
@@ -0,0 +1,6 @@
+
+T10604_no_PolyKinds.hs:7:35: error:
+    • Cannot derive well-kinded instance of form ‘Generic1 (F ...)’
+        (Perhaps you intended to use PolyKinds)
+        Class ‘Generic1’ expects an argument of kind ‘* -> *’
+    • In the data declaration for ‘F’
diff --git a/testsuite/tests/generics/T10604/all.T b/testsuite/tests/generics/T10604/all.T
new file mode 100644 (file)
index 0000000..9f1dbc5
--- /dev/null
@@ -0,0 +1,4 @@
+test('T10604_Authenticated',           normal, compile,      [''])
+test('T10604_deriving',                normal, compile,      ['-dsuppress-uniques'])
+test('T10604_bad_variable_occurrence', normal, compile_fail, [''])
+test('T10604_no_PolyKinds',            normal, compile_fail, [''])
index 765c48b..e3c4b31 100644 (file)
@@ -545,7 +545,7 @@ test('T5642',
             # 2014-12-10:  641085256 Improvements in constraints solver
             # 2016-04-06:  462677300
 
-            (wordsize(64), 950004816, 10)])
+            (wordsize(64), 1300685592, 10)])
             # prev:        1300000000
             # 2014-07-17:  1358833928 (general round of updates)
             # 2014-08-07:  1402242360 (caused by 1fc60ea)
@@ -559,6 +559,7 @@ test('T5642',
             # 2015-10-28:  1412808976 Emit Typeable at definition site
             # 2015-11-22:  1071915072 Use TypeLits in the metadata encoding
             # 2016-02-08:  950004816  Pattern match checker re-rework
+            # 2016-05-12:  1300685592 Make Generic1 poly-kinded
       ],
       compile,['-O'])
 
index cf1ad4c..b4600d4 100644 (file)
@@ -5,7 +5,7 @@
 test('haddock.base',
      [unless(in_tree_compiler(), skip), req_haddock
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 30987348040, 5)
+          [(wordsize(64), 32855223200, 5)
             # 2012-08-14: 5920822352 (amd64/Linux)
             # 2012-09-20: 5829972376 (amd64/Linux)
             # 2012-10-08: 5902601224 (amd64/Linux)
@@ -29,6 +29,7 @@ test('haddock.base',
             # 2015-12-17: 26282821104 (x86_64/Linux) - Update Haddock to master
             # 2015-12-17: 27812188000 (x86_64/Linux) - Move Data.Functor.* into base
             # 2016-02-25: 30987348040 (x86_64/Linux) - RuntimeRep
+            # 2016-05-12: 32855223200 (x86_64/Linux) - Make Generic1 poly-kinded
 
           ,(platform('i386-unknown-mingw32'), 4434804940, 5)
             # 2013-02-10:                     3358693084 (x86/Windows)
@@ -51,7 +52,7 @@ test('haddock.base',
 test('haddock.Cabal',
      [unless(in_tree_compiler(), skip), req_haddock
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 10963514352, 5)
+          [(wordsize(64), 11805238152, 5)
             # 2012-08-14: 3255435248 (amd64/Linux)
             # 2012-08-29: 3324606664 (amd64/Linux, new codegen)
             # 2012-10-08: 3373401360 (amd64/Linux)
@@ -79,6 +80,7 @@ test('haddock.Cabal',
             # 2016-03-30: 10941742184 (amd64/Linux) - defer inlining of Int* Ord methods
             # 2016-04-06: 11542374816 (amd64/Linux) - CSE improvements and others
             # 2016-04-07: 10963514352 (amd64/Linux) - Revert to what phabricator claims
+            # 2016-05-22: 11805238152 (amd64/Linux) - Make Generic1 poly-kinded
 
           ,(platform('i386-unknown-mingw32'), 3293415576, 5)
             # 2012-10-30:                     1733638168 (x86/Windows)