From: Simon Peyton Jones Date: Thu, 26 May 2011 13:33:00 +0000 (+0100) Subject: Merge remote branch 'origin/master' into ghc-generics X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=97ce7b595418d629a57654b5af07133e6418b45e;hp=-c Merge remote branch 'origin/master' into ghc-generics --- 97ce7b595418d629a57654b5af07133e6418b45e diff --combined compiler/main/DynFlags.hs index d80d2a6,6804c03..d9f3246 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@@ -274,7 -274,6 +274,6 @@@ data DynFla -- misc opts | Opt_Pp | Opt_ForceRecomp - | Opt_DryRun | Opt_ExcessPrecision | Opt_EagerBlackHoling | Opt_ReadUserPackageConf @@@ -337,6 -336,7 +336,6 @@@ data ExtensionFla | Opt_TemplateHaskell | Opt_QuasiQuotes | Opt_ImplicitParams - | Opt_Generics -- "Derivable type classes" | Opt_ImplicitPrelude | Opt_ScopedTypeVariables | Opt_UnboxedTuples @@@ -358,9 -358,6 +357,9 @@@ | Opt_DeriveFunctor | Opt_DeriveTraversable | Opt_DeriveFoldable + | Opt_DeriveGeneric -- Allow deriving Generic/1 + | Opt_DefaultSignatures -- Allow extra signatures for defmeths + | Opt_Generics -- Old generic classes, now deprecated | Opt_TypeSynonymInstances | Opt_FlexibleContexts @@@ -765,9 -762,9 +764,9 @@@ defaultDynFlags mySettings maxSimplIterations = 4, shouldDumpSimplPhase = Nothing, ruleCheck = Nothing, - specConstrThreshold = Just 200, + specConstrThreshold = Just 2000, specConstrCount = Just 3, - liberateCaseThreshold = Just 200, + liberateCaseThreshold = Just 2000, floatLamArgs = Just 0, -- Default: float only if no fvs strictnessBefore = [], @@@ -876,7 -873,11 +875,11 @@@ languageExtensions Nothin -- But NB it's implied by GADTs etc -- SLPJ September 2010 : Opt_NondecreasingIndentation -- This has been on by default for some time - : languageExtensions (Just Haskell2010) + : delete Opt_DatatypeContexts -- The Haskell' committee decided to + -- remove datatype contexts from the + -- language: + -- http://www.haskell.org/pipermail/haskell-prime/2011-January/003335.html + (languageExtensions (Just Haskell2010)) languageExtensions (Just Haskell98) = [Opt_ImplicitPrelude, @@@ -1152,7 -1153,7 +1155,7 @@@ allFlags = map ('-':) --------------- The main flags themselves ------------------ dynamic_flags :: [Flag (CmdLineP DynFlags)] dynamic_flags = [ - Flag "n" (NoArg (setDynFlag Opt_DryRun)) + Flag "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect")) , Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp)) , Flag "F" (NoArg (setDynFlag Opt_Pp)) , Flag "#include" @@@ -1665,8 -1666,7 +1668,8 @@@ xFlags = ( "ParallelArrays", Opt_ParallelArrays, nop ), ( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ), ( "QuasiQuotes", Opt_QuasiQuotes, nop ), - ( "Generics", Opt_Generics, nop ), + ( "Generics", Opt_Generics, + \ _ -> deprecate "it does nothing; look into -XDefaultSignatures and -XDeriveGeneric for generic programming support." ), ( "ImplicitPrelude", Opt_ImplicitPrelude, nop ), ( "RecordWildCards", Opt_RecordWildCards, nop ), ( "NamedFieldPuns", Opt_RecordPuns, nop ), @@@ -1708,8 -1708,6 +1711,8 @@@ ( "DeriveFunctor", Opt_DeriveFunctor, nop ), ( "DeriveTraversable", Opt_DeriveTraversable, nop ), ( "DeriveFoldable", Opt_DeriveFoldable, nop ), + ( "DeriveGeneric", Opt_DeriveGeneric, nop ), + ( "DefaultSignatures", Opt_DefaultSignatures, nop ), ( "TypeSynonymInstances", Opt_TypeSynonymInstances, nop ), ( "FlexibleContexts", Opt_FlexibleContexts, nop ), ( "FlexibleInstances", Opt_FlexibleInstances, nop ), @@@ -1890,7 -1888,6 +1893,7 @@@ glasgowExtsFlags = , Opt_DeriveFunctor , Opt_DeriveFoldable , Opt_DeriveTraversable + , Opt_DeriveGeneric , Opt_FlexibleContexts , Opt_FlexibleInstances , Opt_ConstrainedClassMethods diff --combined docs/users_guide/flags.xml index 0faefbb,5b55fc6..bfc28d8 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@@ -35,13 -35,7 +35,7 @@@ mode - - - - do a dry run - dynamic - - - - + verbose mode (equivalent to ) dynamic @@@ -682,9 -676,7 +676,9 @@@ - Enable generic classes + Deprecated, does nothing. No longer enables generic classes. + See also GHC's support for + generic programming. dynamic @@@ -979,12 -971,6 +973,12 @@@ + + Enable deriving for the Generic class. + dynamic + + + Enable newtype deriving. dynamic @@@ -1016,12 -1002,6 +1010,12 @@@ + + Enable default signatures. + dynamic + + + Enable multi parameter type classes. dynamic diff --combined docs/users_guide/glasgow_exts.xml index 93f0d3c,a556953..0f37953 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@@ -3212,12 -3212,6 +3212,12 @@@ then writing the data type instance by + With , you can derive +instances of the class Generic, defined in +GHC.Generics. You can use these to define generic functions, +as described in . + + With , you can derive instances of the class Functor, defined in GHC.Base. @@@ -3539,47 -3533,6 +3539,47 @@@ GHC lifts this restriction (flag + + + +Default signatures + + +Haskell 98 allows you to define a default implementation when declaring a class: + + class Enum a where + enum :: [a] + enum = [] + +The type of the enum method is [a], and +this is also the type of the default method. You can lift this restriction +and give another type to the default method using the flag +. For instance, if you have written a +generic implementation of enumeration in a class GEnum +with method genum in terms of GHC.Generics, +you can specify a default method that uses that generic implementation: + + class Enum a where + enum :: [a] + default enum :: (Generic a, GEnum (Rep a)) => [a] + enum = map to genum + +We reuse the keyword default to signal that a signature +applies to the default method only; when defining instances of the +Enum class, the original type [a] of +enum still applies. When giving an empty instance, however, +the default implementation map to0 genum is filled-in, +and type-checked with the type +(Generic a, GEnum (Rep a)) => [a]. + + + +We use default signatures to simplify generic programming in GHC +(). + + + + @@@ -9174,7 -9127,7 +9174,7 @@@ allows control over inlining on a per-c restrains the strictness analyser. - lazy + unsafeCoerce# allows you to fool the type checker. @@@ -9186,185 -9139,257 +9186,185 @@@ Generic classes -The ideas behind this extension are described in detail in "Derivable type classes", -Ralf Hinze and Simon Peyton Jones, Haskell Workshop, Montreal Sept 2000, pp94-105. -An example will give the idea: +GHC used to have an implementation of generic classes as defined in the paper +"Derivable type classes", Ralf Hinze and Simon Peyton Jones, Haskell Workshop, +Montreal Sept 2000, pp94-105. These have been removed and replaced by the more +general support for generic programming. - - import Data.Generics - - class Bin a where - toBin :: a -> [Int] - fromBin :: [Int] -> (a, [Int]) - - toBin {| Unit |} Unit = [] - toBin {| a :+: b |} (Inl x) = 0 : toBin x - toBin {| a :+: b |} (Inr y) = 1 : toBin y - toBin {| a :*: b |} (x :*: y) = toBin x ++ toBin y - - fromBin {| Unit |} bs = (Unit, bs) - fromBin {| a :+: b |} (0:bs) = (Inl x, bs') where (x,bs') = fromBin bs - fromBin {| a :+: b |} (1:bs) = (Inr y, bs') where (y,bs') = fromBin bs - fromBin {| a :*: b |} bs = (x :*: y, bs'') where (x,bs' ) = fromBin bs - (y,bs'') = fromBin bs' - - -This class declaration explains how toBin and fromBin -work for arbitrary data types. They do so by giving cases for unit, product, and sum, -which are defined thus in the library module Data.Generics: - - - data Unit = Unit - data a :+: b = Inl a | Inr b - data a :*: b = a :*: b - - -Now you can make a data type into an instance of Bin like this: - - instance (Bin a, Bin b) => Bin (a,b) - instance Bin a => Bin [a] - -That is, just leave off the "where" clause. Of course, you can put in the -where clause and over-ride whichever methods you please. - + - - Using generics - To use generics you need to - - - - Use the flags (to enable the - extra syntax and generate extra per-data-type code), - and (to make the - Data.Generics module available. - - - - Import the module Data.Generics from the - syb package. This import brings into - scope the data types Unit, - :*:, and :+:. (You - don't need this import if you don't mention these types - explicitly; for example, if you are simply giving instance - declarations.) - - - - Changes wrt the paper - -Note that the type constructors :+: and :*: -can be written infix (indeed, you can now use -any operator starting in a colon as an infix type constructor). Also note that -the type constructors are not exactly as in the paper (Unit instead of 1, etc). -Finally, note that the syntax of the type patterns in the class declaration -uses "{|" and "|}" brackets; curly braces -alone would ambiguous when they appear on right hand sides (an extension we -anticipate wanting). - - + +Generic programming - Terminology and restrictions -Terminology. A "generic default method" in a class declaration -is one that is defined using type patterns as above. -A "polymorphic default method" is a default method defined as in Haskell 98. -A "generic class declaration" is a class declaration with at least one -generic default method. +Using a combination of +() and + (), +you can easily do datatype-generic +programming using the GHC.Generics framework. This section +gives a very brief overview of how to do it. For more detail please refer to the +HaskellWiki page +or the original paper: -Alas, we do not yet implement the stuff about constructor names and -field labels. +José Pedro Magalhães, Atze Dijkstra, Johan Jeuring, and Andres Löh. + + A generic deriving mechanism for Haskell. +Proceedings of the third ACM Haskell symposium on Haskell +(Haskell'2010), pp. 37-48, ACM, 2010. + - - -A generic class can have only one parameter; you can't have a generic -multi-parameter class. - - +Note: the current support for generic programming in GHC +is preliminary. In particular, we only allow deriving instances for the +Generic class. Support for deriving +Generic1 (and thus enabling generic functions of kind +* -> * such as fmap) will come at a +later stage. - - -A default method must be defined entirely using type patterns, or entirely -without. So this is illegal: - - class Foo a where - op :: a -> (a, Bool) - op {| Unit |} Unit = (Unit, True) - op x = (x, False) - -However it is perfectly OK for some methods of a generic class to have -generic default methods and others to have polymorphic default methods. - - - - -The type variable(s) in the type pattern for a generic method declaration -scope over the right hand side. So this is legal (note the use of the type variable ``p'' in a type signature on the right hand side: - - class Foo a where - op :: a -> Bool - op {| p :*: q |} (x :*: y) = op (x :: p) - ... - - - + +Deriving representations - -The type patterns in a generic default method must take one of the forms: - - a :+: b - a :*: b - Unit - -where "a" and "b" are type variables. Furthermore, all the type patterns for -a single type constructor (:*:, say) must be identical; they -must use the same type variables. So this is illegal: +The first thing we need is generic representations. The +GHC.Generics module defines a couple of primitive types +that can be used to represent most Haskell datatypes: + - class Foo a where - op :: a -> Bool - op {| a :+: b |} (Inl x) = True - op {| p :+: q |} (Inr y) = False +-- | Unit: used for constructors without arguments +data U1 p = U1 + +-- | Constants, additional parameters and recursion of kind * +newtype K1 i c p = K1 { unK1 :: c } + +-- | Meta-information (constructor names, etc.) +newtype M1 i c f p = M1 { unM1 :: f p } + +-- | Sums: encode choice between constructors +infixr 5 :+: +data (:+:) f g p = L1 (f p) | R1 (g p) + +-- | Products: encode multiple arguments to constructors +infixr 6 :*: +data (:*:) f g p = f p :*: g p + + +For example, a user-defined datatype of trees data UserTree a = Node a +(UserTree a) (UserTree a) | Leaf gets the following representation: + + +instance Generic (UserTree a) where + -- Representation type + type Rep (UserTree a) = + M1 D D1UserTree ( + M1 C C1_0UserTree ( + M1 S NoSelector (K1 P a) + :*: M1 S NoSelector (K1 R (UserTree a)) + :*: M1 S NoSelector (K1 R (UserTree a))) + :+: M1 C C1_1UserTree U1) + + -- Conversion functions + from (Node x l r) = M1 (L1 (M1 (M1 (K1 x) :*: M1 (K1 l) :*: M1 (K1 r)))) + from Leaf = M1 (R1 (M1 U1)) + to (M1 (L1 (M1 (M1 (K1 x) :*: M1 (K1 l) :*: M1 (K1 r))))) = Node x l r + to (M1 (R1 (M1 U1))) = Leaf + +-- Meta-information +data D1UserTree +data C1_0UserTree +data C1_1UserTree + +instance Datatype D1UserTree where + datatypeName _ = "UserTree" + moduleName _ = "Main" + +instance Constructor C1_0UserTree where + conName _ = "Node" + +instance Constructor C1_1UserTree where + conName _ = "Leaf" -The type patterns must be identical, even in equations for different methods of the class. -So this too is illegal: - - class Foo a where - op1 :: a -> Bool - op1 {| a :*: b |} (x :*: y) = True - op2 :: a -> Bool - op2 {| p :*: q |} (x :*: y) = False - -(The reason for this restriction is that we gather all the equations for a particular type constructor -into a single generic instance declaration.) +This representation is generated automatically if a +deriving Generic clause is attached to the datatype. +Standalone deriving can also be +used. - + - - -A generic method declaration must give a case for each of the three type constructors. - - + +Writing generic functions - -The type for a generic method can be built only from: - - Function arrows - Type variables - Tuples - Arbitrary types not involving type variables - -Here are some example type signatures for generic methods: +A generic function is defined by creating a class and giving instances for +each of the representation types of GHC.Generics. As an +example we show generic serialization: - op1 :: a -> Bool - op2 :: Bool -> (a,Bool) - op3 :: [Int] -> a -> a - op4 :: [a] -> Bool - -Here, op1, op2, op3 are OK, but op4 is rejected, because it has a type variable -inside a list. - - -This restriction is an implementation restriction: we just haven't got around to -implementing the necessary bidirectional maps over arbitrary type constructors. -It would be relatively easy to add specific type constructors, such as Maybe and list, -to the ones that are allowed. - +data Bin = O | I - - -In an instance declaration for a generic class, the idea is that the compiler -will fill in the methods for you, based on the generic templates. However it can only -do so if - - - - The instance type is simple (a type constructor applied to type variables, as in Haskell 98). - - - - - No constructor of the instance type has unboxed fields. - - - -(Of course, these things can only arise if you are already using GHC extensions.) -However, you can still give an instance declarations for types which break these rules, -provided you give explicit code to override any generic default methods. - - +class GSerialize f where + gput :: f a -> [Bin] - - +instance GSerialize U1 where + gput U1 = [] - -The option dumps incomprehensible stuff giving details of -what the compiler does with generic declarations. - +instance (GSerialize a, GSerialize b) => GSerialize (a :*: b) where + gput (a :*: b) = gput a ++ gput b + +instance (GSerialize a, GSerialize b) => GSerialize (a :+: b) where + gput (L1 x) = O : gput x + gput (R1 x) = I : gput x +instance (GSerialize a) => GSerialize (M1 i c a) where + gput (M1 x) = gput x + +instance (Serialize a) => GSerialize (K1 i c a) where + gput (K1 x) = put x + + +Typically this class will not be exported, as it only makes sense to have +instances for the representation types. + - Another example + +Generic defaults + -Just to finish with, here's another example I rather like: +The only thing left to do now is to define a "front-end" class, which is +exposed to the user: - class Tag a where - nCons :: a -> Int - nCons {| Unit |} _ = 1 - nCons {| a :*: b |} _ = 1 - nCons {| a :+: b |} _ = nCons (bot::a) + nCons (bot::b) +class Serialize a where + put :: a -> [Bin] - tag :: a -> Int - tag {| Unit |} _ = 1 - tag {| a :*: b |} _ = 1 - tag {| a :+: b |} (Inl x) = tag x - tag {| a :+: b |} (Inr y) = nCons (bot::a) + tag y + default put :: (Generic a, GSerialize (Rep a)) => a -> [Bit] + put = gput . from + +Here we use a default signature +to specify that the user does not have to provide an implementation for +put, as long as there is a Generic +instance for the type to instantiate. For the UserTree type, +for instance, the user can just write: + + +instance (Serialize a) => Serialize (UserTree a) + +The default method for put is then used, corresponding to the +generic implementation of serialization. + + Control over monomorphism