Commit 2c5c2972 authored by RyanGlScott's avatar RyanGlScott Committed by Ben Gamari
Browse files

DeriveFoldable for data types with existential constraints (#10447)

Reviewers: dolio, shachaf, ekmett, austin, #core_libraries_committee,
simonpj, bgamari

Reviewed By: simonpj, bgamari

Subscribers: thomie, bgamari

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

GHC Trac Issues: #10447
parent 415351a9
......@@ -1219,13 +1219,15 @@ sideConditions mtheta cls
cond_args cls)
| cls_key == functorClassKey = Just (checkFlag Opt_DeriveFunctor `andCond`
cond_vanilla `andCond`
cond_functorOK True)
cond_functorOK True False)
| cls_key == foldableClassKey = Just (checkFlag Opt_DeriveFoldable `andCond`
cond_vanilla `andCond`
cond_functorOK False) -- Functor/Fold/Trav works ok for rank-n types
cond_functorOK False True)
-- Functor/Fold/Trav works ok
-- for rank-n types
| cls_key == traversableClassKey = Just (checkFlag Opt_DeriveTraversable `andCond`
cond_vanilla `andCond`
cond_functorOK False)
cond_functorOK False False)
| cls_key == genClassKey = Just (checkFlag Opt_DeriveGeneric `andCond`
cond_vanilla `andCond`
cond_RepresentableOk)
......@@ -1346,14 +1348,14 @@ cond_isProduct (_, rep_tc, _)
functorLikeClassKeys :: [Unique]
functorLikeClassKeys = [functorClassKey, foldableClassKey, traversableClassKey]
cond_functorOK :: Bool -> Condition
cond_functorOK :: Bool -> Bool -> Condition
-- OK for Functor/Foldable/Traversable class
-- Currently: (a) at least one argument
-- (b) don't use argument contravariantly
-- (c) don't use argument in the wrong place, e.g. data T a = T (X a a)
-- (d) optionally: don't use function types
-- (e) no "stupid context" on data type
cond_functorOK allowFunctions (_, rep_tc, _)
cond_functorOK allowFunctions allowExQuantifiedLastTyVar (_, rep_tc, _)
| null tc_tvs
= NotValid (ptext (sLit "Data type") <+> quotes (ppr rep_tc)
<+> ptext (sLit "must have some type parameters"))
......@@ -1375,6 +1377,9 @@ cond_functorOK allowFunctions (_, rep_tc, _)
check_universal :: DataCon -> Validity
check_universal con
| allowExQuantifiedLastTyVar
= IsValid -- See Note [DeriveFoldable with ExistentialQuantification]
-- in TcGenDeriv
| Just tv <- getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con)))
, tv `elem` dataConUnivTyVars con
, not (tv `elemVarSet` tyVarsOfTypes (dataConTheta con))
......@@ -1442,7 +1447,7 @@ badCon con msg = ptext (sLit "Constructor") <+> quotes (ppr con) <+> msg
{-
Note [Check that the type variable is truly universal]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For Functor, Foldable, Traversable, we must check that the *last argument*
For Functor and Traversable instances, we must check that the *last argument*
of the type constructor is used truly universally quantified. Example
data T a b where
......@@ -1461,6 +1466,20 @@ Eg. for T1-T3 we can write
fmap f (T2 b c) = T2 (f b) c
fmap f (T3 x) = T3 (f x)
We need not perform these checks for Foldable instances, however, since
functions in Foldable can only consume existentially quantified type variables,
rather than produce them (as is the case in Functor and Traversable functions.)
As a result, T can have a derived Foldable instance:
foldr f z (T1 a b) = f b z
foldr f z (T2 b c) = f b z
foldr f z (T3 x) = f x z
foldr f z (T4 x) = f x z
foldr f z (T5 x) = f x z
foldr _ z T6 = z
See Note [DeriveFoldable with ExistentialQuantification] in TcGenDeriv.
Note [Superclasses of derived instance]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -1673,12 +1673,20 @@ deepSubtypesContaining tv
foldDataConArgs :: FFoldType a -> DataCon -> [a]
-- Fold over the arguments of the datacon
foldDataConArgs ft con
= map (functorLikeTraverse tv ft) (dataConOrigArgTys con)
= map foldArg (dataConOrigArgTys con)
where
Just tv = getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con)))
-- Argument to derive for, 'a in the above description
-- The validity and kind checks have ensured that
-- the Just will match and a::*
foldArg
= case getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con))) of
Just tv -> functorLikeTraverse tv ft
Nothing -> const (ft_triv ft)
-- If we are deriving Foldable for a GADT, there is a chance that the last
-- type variable in the data type isn't actually a type variable at all.
-- (for example, this can happen if the last type variable is refined to
-- be a concrete type such as Int). If the last type variable is refined
-- to be a specific type, then getTyVar_maybe will return Nothing.
-- See Note [DeriveFoldable with ExistentialQuantification]
--
-- The kind checks have ensured the last type parameter is of kind *.
-- Make a HsLam using a fresh variable from a State monad
mkSimpleLam :: (LHsExpr RdrName -> State [RdrName] (LHsExpr RdrName))
......@@ -1747,6 +1755,24 @@ The cases are:
Note that the arguments to the real foldr function are the wrong way around,
since (f :: a -> b -> b), while (foldr f :: b -> t a -> b).
Foldable instances differ from Functor and Traversable instances in that
Foldable instances can be derived for data types in which the last type
variable is existentially quantified. In particular, if the last type variable
is refined to a more specific type in a GADT:
data GADT a where
G :: a ~ Int => a -> G Int
then the deriving machinery does not attempt to check that the type a contains
Int, since it is not syntactically equal to a type variable. That is, the
derived Foldable instance for GADT is:
instance Foldable GADT where
foldr _ z (GADT _) = z
See Note [DeriveFoldable with ExistentialQuantification].
-}
gen_Foldable_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
......@@ -2305,4 +2331,80 @@ OccName we generate for the new binding.
In the past we used mkDerivedRdrName name occ_fun, which made an original name
But: (a) that does not work well for standalone-deriving either
(b) an unqualified name is just fine, provided it can't clash with user code
Note [DeriveFoldable with ExistentialQuantification]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Functor and Traversable instances can only be derived for data types whose
last type parameter is truly universally polymorphic. For example:
data T a b where
T1 :: b -> T a b -- YES, b is unconstrained
T2 :: Ord b => b -> T a b -- NO, b is constrained by (Ord b)
T3 :: b ~ Int => b -> T a b -- NO, b is constrained by (b ~ Int)
T4 :: Int -> T a Int -- NO, this is just like T3
T5 :: Ord a => a -> b -> T a b -- YES, b is unconstrained, even
-- though a is existential
T6 :: Int -> T Int b -- YES, b is unconstrained
For Foldable instances, however, we can completely lift the constraint that
the last type parameter be truly universally polymorphic. This means that T
(as defined above) can have a derived Foldable instance:
instance Foldable (T a) where
foldr f z (T1 b) = f b z
foldr f z (T2 b) = f b z
foldr f z (T3 b) = f b z
foldr f z (T4 b) = z
foldr f z (T5 a b) = f b z
foldr f z (T6 a) = z
foldMap f (T1 b) = f b
foldMap f (T2 b) = f b
foldMap f (T3 b) = f b
foldMap f (T4 b) = mempty
foldMap f (T5 a b) = f b
foldMap f (T6 a) = mempty
In a Foldable instance, it is safe to fold over an occurrence of the last type
parameter that is not truly universally polymorphic. However, there is a bit
of subtlety in determining what is actually an occurrence of a type parameter.
T3 and T4, as defined above, provide one example:
data T a b where
...
T3 :: b ~ Int => b -> T a b
T4 :: Int -> T a Int
...
instance Foldable (T a) where
...
foldr f z (T3 b) = f b z
foldr f z (T4 b) = z
...
foldMap f (T3 b) = f b
foldMap f (T4 b) = mempty
...
Notice that the argument of T3 is folded over, whereas the argument of T4 is
not. This is because we only fold over constructor arguments that
syntactically mention the universally quantified type parameter of that
particular data constructor. See foldDataConArgs for how this is implemented.
As another example, consider the following data type. The argument of each
constructor has the same type as the last type parameter:
data E a where
E1 :: (a ~ Int) => a -> E a
E2 :: Int -> E Int
E3 :: (a ~ Int) => a -> E Int
E4 :: (a ~ Int) => Int -> E a
Only E1's argument is an occurrence of a universally quantified type variable
that is syntactically equivalent to the last type parameter, so only E1's
argument will be be folded over in a derived Foldable instance.
See Trac #10447 for the original discussion on this feature. Also see
https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFunctor
for a more in-depth explanation.
-}
......@@ -4019,7 +4019,7 @@ as described in <xref linkend="generic-programming"/>.
<listitem><para> With <option>-XDeriveFunctor</option>, you can derive instances of
the class <literal>Functor</literal>,
defined in <literal>GHC.Base</literal>.
defined in <literal>GHC.Base</literal>. See <xref linkend="deriving-functor"/>.
</para></listitem>
<listitem><para> With <option>-XDeriveDataTypeable</option>, you can derive instances of
......@@ -4030,7 +4030,7 @@ deriving <literal>Typeable</literal>.
<listitem><para> With <option>-XDeriveFoldable</option>, you can derive instances of
the class <literal>Foldable</literal>,
defined in <literal>Data.Foldable</literal>.
defined in <literal>Data.Foldable</literal>. See <xref linkend="deriving-foldable"/>.
</para></listitem>
<listitem><para> With <option>-XDeriveTraversable</option>, you can derive instances of
......@@ -4040,6 +4040,7 @@ 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>.
See <xref linkend="deriving-traversable"/>.
</para></listitem>
</itemizedlist>
You can also use a standalone deriving declaration instead
......@@ -4051,6 +4052,260 @@ can be mentioned in the <literal>deriving</literal> clause.
</para>
</sect2>
<sect2 id="deriving-functor">
<title>Deriving <literal>Functor</literal> instances</title>
<para>With <option>-XDeriveFunctor</option>, one can derive
<literal>Functor</literal> instances for data types of kind
<literal>* -> *</literal>. For example, this declaration:
<programlisting>
data Example a = Ex a Char (Example a) (Example Char)
deriving Functor
</programlisting>
would generate the following instance:
<programlisting>
instance Functor Example where
fmap f (Ex a1 a2 a3 a4) = Ex (f a1) a2 (fmap f a3) a4
</programlisting>
</para>
<para>The basic algorithm for <option>-XDeriveFunctor</option> walks the
arguments of each constructor of a data type, applying a mapping function
depending on the type of each argument. Suppose we are deriving
<literal>Functor</literal> for a data type whose last type parameter is
<literal>a</literal>. Then we write the derivation of <literal>fmap</literal>
code over the type variable <literal>a</literal> for type
<literal>b</literal> as <literal>$(fmap 'a 'b)</literal>.
<itemizedlist>
<listitem><para>If the argument's type is <literal>a</literal>, then
map over it.
<programlisting>
$(fmap 'a 'a) = f
</programlisting>
</para></listitem>
<listitem><para>If the argument's type does not mention <literal>a</literal>,
then do nothing to it.
<programlisting>
$(fmap 'a 'b) = \x -> x -- when b does not contain a
</programlisting>
</para></listitem>
<listitem><para>If the argument has a tuple type, generate map code for each
of its arguments.
<programlisting>
$(fmap 'a '(b1,b2)) = \x -> case x of (x1,x2) -> ($(fmap 'a 'b1) x1, $(fmap 'a 'b2) x2)
</programlisting>
</para></listitem>
<listitem><para>If the argument's type is a data type that mentions
<literal>a</literal>, apply <literal>fmap</literal> to it with the generated
map code for the data type's last type parameter.
<programlisting>
$(fmap 'a '(T b1 b2)) = fmap $(fmap 'a 'b2) -- when a only occurs in the last parameter, b2
</programlisting>
</para></listitem>
<listitem><para>If the argument has a function type, apply generated
<literal>$(fmap)</literal> code to the result type, and apply generated
<literal>$(cofmap)</literal> code to the argument type.
<programlisting>
$(fmap 'a '(b -> c)) = \x b -> $(fmap 'a' 'c) (x ($(cofmap 'a 'b) b))
</programlisting>
<literal>$(cofmap)</literal> is needed because the type parameter
<literal>a</literal> can occur in a contravariant position, which means we
need to derive a function like:
<programlisting>
cofmap :: (a -> b) -> f b -> f a
</programlisting>
This is pretty much the same as <literal>$(fmap)</literal>, only without the
<literal>$(cofmap 'a 'a)</literal> case:
<programlisting>
$(cofmap 'a 'b) = \x -> x -- when b does not contain a
$(cofmap 'a 'a) = error "type variable in contravariant position"
$(cofmap 'a '(b1,b2)) = \x -> case x of (x1,x2) -> ($(cofmap 'a 'b1) x1, $(cofmap 'a 'b2) x2)
$(cofmap 'a '[b]) = map $(cofmap 'a 'b)
$(cofmap 'a '(T b1 b2)) = fmap $(cofmap 'a 'b2) -- when a only occurs in the last parameter, b2
$(cofmap 'a '(b -> c)) = \x b -> $(cofmap 'a' 'c) (x ($(fmap 'a 'c) b))
</programlisting>
For more information on contravariance, see
<ulink url="https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFunctor#Covariantandcontravariantpositions">
this wiki page</ulink>.
</para></listitem>
</itemizedlist>
</para>
<para>A data type can have a derived <literal>Functor</literal> instance if:
<itemizedlist>
<listitem><para>It has at least one type parameter.
</para></listitem>
<listitem><para>It does not use the last type parameter contravariantly.
</para></listitem>
<listitem><para>It does not use the last type parameter in the "wrong place"
in any of the argument data types. For example, in:
<programlisting>
data Right a = Right [a] (Either Int a)
</programlisting>
the type parameter <literal>a</literal> is only ever used as the last type
argument in <literal>[]</literal> and <literal>Either</literal>, so both
<literal>[a]</literal> and <literal>Either Int a</literal> can be
<literal>fmap</literal>ped. However, in:
<programlisting>
data Wrong a = Wrong (Either a a)
</programlisting>
the type variable <literal>a</literal> appears in a position other than the
last, so trying to <literal>fmap</literal> an <literal>Either a a</literal>
value would not typecheck in a <literal>Functor</literal> instance.
Note that there are two exceptions to this rule: tuple and function types, as
described above.
</para></listitem>
<listitem><para>Its last type variable cannot be used in a
<option>-XDatatypeContexts</option> constraint.
</para></listitem>
<listitem><para>Its last type variable cannot be used in an
<option>-XExistentialQuantification</option> or <option>-XGADTs</option>
constraint.
</para></listitem>
</itemizedlist>
</para>
</sect2>
<sect2 id="deriving-foldable">
<title>Deriving <literal>Foldable</literal> instances</title>
<para>With <option>-XDeriveFoldable</option>, one can derive
<literal>Foldable</literal> instances for data types of kind
<literal>* -> *</literal>. For example, this declaration:
<programlisting>
data Example a = Ex a Char (Example a) (Example Char)
deriving Functor
</programlisting>
would generate the following instance:
<programlisting>
instance Foldable Example where
foldr f z (Ex a1 a2 a3 a4) = f a1 (foldr f z a3)
foldMap f (Ex a1 a2 a3 a4) = mappend (f a1)
(mappend mempty
(mappend (foldMap f a3)
mempty))
</programlisting>
The algorithm for <option>-XDeriveFoldable</option> is very similar to that of
<option>-XDeriveFunctor</option>, except that <literal>Foldable</literal>
instances are not possible for function types. The cases are:
<programlisting>
$(foldr 'a 'b) = \x z -> z -- when b does not contain a
$(foldr 'a 'a) = f
$(foldr 'a '(b1,b2)) = \x z -> case x of (x1,x2) -> $(foldr 'a 'b1) x1 ( $(foldr 'a 'b2) x2 z )
$(foldr 'a '(T b1 b2)) = \x z -> foldr $(foldr 'a 'b2) z x -- when a only occurs in the last parameter, b2
</programlisting>
Another difference between <option>-XDeriveFoldable</option> and
<option>-XDeriveFunctor</option> is that <option>-XDeriveFoldable</option>
instances can be derived for data types with existential constraints. For
example, the following data type:
<programlisting>
data E a where
E1 :: (a ~ Int) =&gt; a -> E a
E2 :: Int -> E Int
E3 :: (a ~ Int) =&gt; a -> E Int
E4 :: (a ~ Int) =&gt; Int -> E a
deriving instance Foldable E
</programlisting>
would have the following <literal>Foldable</literal> instance:
<programlisting>
instance Foldable E where
foldr f z (E1 e) = f e z
foldr f z (E2 e) = z
foldr f z (E3 e) = z
foldr f z (E4 e) = z
foldMap f (E1 e) = f e
foldMap f (E2 e) = mempty
foldMap f (E3 e) = mempty
foldMap f (E4 e) = mempty
</programlisting>
Notice that only the argument in <literal>E1</literal> is folded over. This is
because we only fold over constructor arguments (1) whose types are
syntactically equivalent to the last type parameter and (2) when the last type
parameter is not refined to a specific type. Only <literal>E1</literal>
satisfies both of these criteria. For more information, see
<ulink url="https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFunctor">
this wiki page</ulink>.
</para>
</sect2>
<sect2 id="deriving-traversable">
<title>Deriving <literal>Traversable</literal> instances</title>
<para>With <option>-XDeriveTraversable</option>, one can derive
<literal>Traversable</literal> instances for data types of kind
<literal>* -> *</literal>. For example, this declaration:
<programlisting>
data Example a = Ex a Char (Example a) (Example Char)
deriving Functor
</programlisting>
would generate the following instance:
<programlisting>
instance Foldable Example where
traverse f (Ex a1 a2 a3 a4)
= fmap Ex (f a)
&lt;*&gt; pure a2
&lt;*&gt; traverse f a3
&lt;*&gt; pure a4
</programlisting>
The algorithm for <option>-XDeriveTraversable</option> is very similar to that
of <option>-XDeriveTraversable</option>, except that
<literal>Traversable</literal> instances are not possible for function types.
The cases are:
<programlisting>
1812 $(traverse 'a 'b) = pure -- when b does not contain a
1813 $(traverse 'a 'a) = f
1814 $(traverse 'a '(b1,b2)) = \x -> case x of (x1,x2) -> fmap (,) $(traverse 'a 'b1) x1 &lt;*&gt; $(traverse 'a 'b2) x2
1815 $(traverse 'a '(T b1 b2)) = traverse $(traverse 'a 'b2) -- when a only occurs in the last parameter, b2
</programlisting>
</para>
</sect2>
<sect2 id="deriving-typeable">
<title>Deriving <literal>Typeable</literal> instances</title>
......
{-# LANGUAGE DeriveFoldable, GADTs, StandaloneDeriving #-}
module Main where
class (a ~ Int) => Foo a
instance Foo Int
data A a where
A1 :: Ord a => a -> A a
A2 :: Int -> A Int
A3 :: b ~ Int => b -> A Int
A4 :: a ~ Int => Int -> A a
A5 :: a ~ Int => a -> A a
A6 :: (a ~ b, b ~ Int) => Int -> b -> A a
A7 :: Foo a => Int -> a -> A a
deriving instance Foldable A
data HK f a where
HK1 :: f a -> HK f (f a)
HK2 :: f a -> HK f a
deriving instance Foldable f => Foldable (HK f)
one :: Int
one = 1
main :: IO ()
main = do
mapM_ (print . foldr (+) one)
[ A1 one
, A2 one
, A3 one
, A4 one
, A5 one
, A6 one one
, A7 one one
]
mapM_ (print . foldr mappend Nothing)
[ HK1 (Just "Hello")
, HK2 (Just (Just "World"))
]
2
1
1
1
2
1
2
Nothing
Just "World"
......@@ -39,3 +39,4 @@ test('T7931', normal, compile_and_run, [''])
test('T9576', exit_code(1), compile_and_run, [''])
test('T9830', extra_clean(['T9830a.hi', 'T9830a.o']), multimod_compile_and_run, ['T9830','-v0'])
test('T10104', normal, compile_and_run, [''])
test('T10447', normal, compile_and_run, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment