diff options
author | RyanGlScott <ryan.gl.scott@ku.edu> | 2015-07-17 00:04:24 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2015-07-17 00:08:10 +0200 |
commit | 2c5c29722c78e089eda0baa7ff89154b58f23165 (patch) | |
tree | 384abe9bb8703dacd310ab4006274ec1b9d78107 | |
parent | 415351a938e86c4def60228552f121d91bbe7e59 (diff) | |
download | haskell-2c5c29722c78e089eda0baa7ff89154b58f23165.tar.gz |
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
-rw-r--r-- | compiler/typecheck/TcDeriv.hs | 31 | ||||
-rw-r--r-- | compiler/typecheck/TcGenDeriv.hs | 112 | ||||
-rw-r--r-- | docs/users_guide/glasgow_exts.xml | 259 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_run/T10447.hs | 41 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_run/T10447.stdout | 9 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_run/all.T | 1 |
6 files changed, 440 insertions, 13 deletions
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 7e5e75ccb4..8da2229067 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index d30c1ca3b1..4a1ce4f815 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -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. + -} diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 51448d545b..22934fa94c 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -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) => a -> E a + E2 :: Int -> E Int + E3 :: (a ~ Int) => a -> E Int + E4 :: (a ~ Int) => 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) + <*> pure a2 + <*> traverse f a3 + <*> 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 <*> $(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> diff --git a/testsuite/tests/deriving/should_run/T10447.hs b/testsuite/tests/deriving/should_run/T10447.hs new file mode 100644 index 0000000000..e91ce98f64 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T10447.hs @@ -0,0 +1,41 @@ +{-# 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")) + ] diff --git a/testsuite/tests/deriving/should_run/T10447.stdout b/testsuite/tests/deriving/should_run/T10447.stdout new file mode 100644 index 0000000000..079b327601 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T10447.stdout @@ -0,0 +1,9 @@ +2 +1 +1 +1 +2 +1 +2 +Nothing +Just "World" diff --git a/testsuite/tests/deriving/should_run/all.T b/testsuite/tests/deriving/should_run/all.T index 1ccbdd77f8..d47e5c1312 100644 --- a/testsuite/tests/deriving/should_run/all.T +++ b/testsuite/tests/deriving/should_run/all.T @@ -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, ['']) |