X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdocs%2Fusers_guide%2Fglasgow_exts.sgml;h=282df1157f17fb3a8966ffdbea755ae42bbccba9;hb=005090b5ba68a69d5bddd58a222a3d4853b4db53;hp=da5c497866f9e828ccaaf440323c14340552d425;hpb=6d5ff8c3d0d012881203da08cc37a4fdb7dc90dc;p=ghc-hetmet.git diff --git a/ghc/docs/users_guide/glasgow_exts.sgml b/ghc/docs/users_guide/glasgow_exts.sgml index da5c497..282df11 100644 --- a/ghc/docs/users_guide/glasgow_exts.sgml +++ b/ghc/docs/users_guide/glasgow_exts.sgml @@ -16,146 +16,6 @@ performance because of the implementation costs of Haskell's -Executive summary of our extensions: - - - - - - Unboxed types and primitive operations: - - You can get right down to the raw machine types and - operations; included in this are “primitive - arrays” (direct access to Big Wads of Bytes). Please - see and following. - - - - - Type system extensions: - - GHC supports a large number of extensions to Haskell's - type system. Specifically: - - - - Multi-parameter type classes: - - - - - - - Functional dependencies: - - - - - - - Implicit parameters: - - - - - - - Local universal quantification: - - - - - - - Extistentially quantification in data types: - - - - - - - Scoped type variables: - - Scoped type variables enable the programmer to - supply type signatures for some nested declarations, - where this would not be legal in Haskell 98. Details in - . - - - - - - - - Pattern guards - - Instead of being a boolean expression, a guard is a list - of qualifiers, exactly as in a list comprehension. See . - - - - - Data types with no constructors - - See . - - - - - Parallel list comprehensions - - An extension to the list comprehension syntax to support - zipWith-like functionality. See . - - - - - Foreign calling: - - Just what it sounds like. We provide - lots of rope that you can dangle around - your neck. Please see . - - - - - Pragmas - - Pragmas are special instructions to the compiler placed - in the source file. The pragmas GHC supports are described in - . - - - - - Rewrite rules: - - The programmer can specify rewrite rules as part of the - source program (in a pragma). GHC applies these rewrite rules - wherever it can. Details in . - - - - - Generic classes: - - (Note: support for generic classes is currently broken - in GHC 5.02). - - Generic class declarations allow you to define a class - whose methods say how to work over an arbitrary data type. - Then it's really easy to make any new type into an instance of - the class. This generalises the rather ad-hoc "deriving" - feature of Haskell 98. Details in . - - - - - Before you get too carried away working at the lowest level (e.g., sloshing MutableByteArray#s around your program), you may wish to check if there are libraries that provide a @@ -163,6 +23,7 @@ program), you may wish to check if there are libraries that provide a . + Language options @@ -203,6 +64,7 @@ program), you may wish to check if there are libraries that provide a + @@ -306,126 +168,15 @@ program), you may wish to check if there are libraries that provide a + &primitives; - -Primitive state-transformer monad - - -state transformers (Glasgow extensions) -ST monad (Glasgow extension) - - - -This monad underlies our implementation of arrays, mutable and -immutable, and our implementation of I/O, including “C calls”. - - - -The ST library, which provides access to the -ST monad, is described in . - - - - - -Primitive arrays, mutable and otherwise - - - -primitive arrays (Glasgow extension) -arrays, primitive (Glasgow extension) - - - -GHC knows about quite a few flavours of Large Swathes of Bytes. - - - -First, GHC distinguishes between primitive arrays of (boxed) Haskell -objects (type Array# obj) and primitive arrays of bytes (type -ByteArray#). - - - -Second, it distinguishes between… - - - -Immutable: - - -Arrays that do not change (as with “standard” Haskell arrays); you -can only read from them. Obviously, they do not need the care and -attention of the state-transformer monad. - - - - -Mutable: - - -Arrays that may be changed or “mutated.” All the operations on them -live within the state-transformer monad and the updates happen -in-place. - - - - -“Static” (in C land): - - -A C routine may pass an Addr# pointer back into Haskell land. There -are then primitive operations with which you may merrily grab values -over in C land, by indexing off the “static” pointer. - - - - -“Stable” pointers: - - -If, for some reason, you wish to hand a Haskell pointer (i.e., -not an unboxed value) to a C routine, you first make the -pointer “stable,” so that the garbage collector won't forget that it -exists. That is, GHC provides a safe way to pass Haskell pointers to -C. - - - -Please see for more details. - - - - -“Foreign objects”: - - -A “foreign object” is a safe way to pass an external object (a -C-allocated pointer, say) to Haskell and have Haskell do the Right -Thing when it no longer references the object. So, for example, C -could pass a large bitmap over to Haskell and say “please free this -memory when you're done with it.” - - - -Please see for more details. - - - - - - - -The libraries documentatation gives more details on all these -“primitive array” types and the operations on them. - - - + + +Type system extensions - + Data types with no constructors With the flag, GHC lets you declare @@ -441,186 +192,30 @@ types. Such data types have only one value, namely bottom. Nevertheless, they can be useful when defining "phantom types". - - - -Pattern guards - - -Pattern guards (Glasgow extension) -The discussion that follows is an abbreviated version of Simon Peyton Jones's original proposal. (Note that the proposal was written before pattern guards were implemented, so refers to them as unimplemented.) - - - -Suppose we have an abstract data type of finite maps, with a -lookup operation: - - -lookup :: FiniteMap -> Int -> Maybe Int - - -The lookup returns Nothing if the supplied key is not in the domain of the mapping, and (Just v) otherwise, -where v is the value that the key maps to. Now consider the following definition: - - - -clunky env var1 var2 | ok1 && ok2 = val1 + val2 -| otherwise = var1 + var2 -where - m1 = lookup env var1 - m2 = lookup env var2 - ok1 = maybeToBool m1 - ok2 = maybeToBool m2 - val1 = expectJust m1 - val2 = expectJust m2 - - - -The auxiliary functions are - - - -maybeToBool :: Maybe a -> Bool -maybeToBool (Just x) = True -maybeToBool Nothing = False - -expectJust :: Maybe a -> a -expectJust (Just x) = x -expectJust Nothing = error "Unexpected Nothing" - - - -What is clunky doing? The guard ok1 && -ok2 checks that both lookups succeed, using -maybeToBool to convert the Maybe -types to booleans. The (lazily evaluated) expectJust -calls extract the values from the results of the lookups, and binds the -returned values to val1 and val2 -respectively. If either lookup fails, then clunky takes the -otherwise case and returns the sum of its arguments. - - - -This is certainly legal Haskell, but it is a tremendously verbose and -un-obvious way to achieve the desired effect. Arguably, a more direct way -to write clunky would be to use case expressions: - - - -clunky env var1 var1 = case lookup env var1 of - Nothing -> fail - Just val1 -> case lookup env var2 of - Nothing -> fail - Just val2 -> val1 + val2 -where - fail = val1 + val2 - - - -This is a bit shorter, but hardly better. Of course, we can rewrite any set -of pattern-matching, guarded equations as case expressions; that is -precisely what the compiler does when compiling equations! The reason that -Haskell provides guarded equations is because they allow us to write down -the cases we want to consider, one at a time, independently of each other. -This structure is hidden in the case version. Two of the right-hand sides -are really the same (fail), and the whole expression -tends to become more and more indented. - + + +Class method types + -Here is how I would write clunky: - - +Haskell 98 prohibits class method types to mention constraints on the +class type variable, thus: -clunky env var1 var1 - | Just val1 <- lookup env var1 - , Just val2 <- lookup env var2 - = val1 + val2 -...other equations for clunky... + class Seq s a where + fromList :: [a] -> s a + elem :: Eq a => a -> s a -> Bool - - -The semantics should be clear enough. The qualifers are matched in order. -For a <- qualifier, which I call a pattern guard, the -right hand side is evaluated and matched against the pattern on the left. -If the match fails then the whole guard fails and the next equation is -tried. If it succeeds, then the appropriate binding takes place, and the -next qualifier is matched, in the augmented environment. Unlike list -comprehensions, however, the type of the expression to the right of the -<- is the same as the type of the pattern to its -left. The bindings introduced by pattern guards scope over all the -remaining guard qualifiers, and over the right hand side of the equation. - - - -Just as with list comprehensions, boolean expressions can be freely mixed -with among the pattern guards. For example: +The type of elem is illegal in Haskell 98, because it +contains the constraint Eq a, constrains only the +class type variable (in this case a). - - -f x | [y] <- x - , y > 3 - , Just z <- h y - = ... - - -Haskell's current guards therefore emerge as a special case, in which the -qualifier list has just one element, a boolean expression. +With the GHC lifts this restriction. - - - - Parallel List Comprehensions - list comprehensionsparallel - - parallel list comprehensions - - - Parallel list comprehensions are a natural extension to list - comprehensions. List comprehensions can be thought of as a nice - syntax for writing maps and filters. Parallel comprehensions - extend this to include the zipWith family. - - A parallel list comprehension has multiple independent - branches of qualifier lists, each separated by a `|' symbol. For - example, the following zips together two lists: - - - [ (x, y) | x <- xs | y <- ys ] - - - The behavior of parallel list comprehensions follows that of - zip, in that the resulting list will have the same length as the - shortest branch. - - We can define parallel list comprehensions by translation to - regular comprehensions. Here's the basic idea: - - Given a parallel comprehension of the form: - - - [ e | p1 <- e11, p2 <- e12, ... - | q1 <- e21, q2 <- e22, ... - ... - ] - - - This will be translated to: - - - [ e | ((p1,p2), (q1,q2), ...) <- zipN [(p1,p2) | p1 <- e11, p2 <- e12, ...] - [(q1,q2) | q1 <- e21, q2 <- e22, ...] - ... - ] - - - where `zipN' is the appropriate zip for the given number of - branches. - + - + Multi-parameter type classes @@ -647,7 +242,7 @@ Thanks to him, and to many others who have offered very useful feedback. - + Types @@ -761,9 +356,9 @@ are perfectly OK This choice recovers principal types, a property that Haskell 1.4 does not have. - + - + Class declarations @@ -923,9 +518,9 @@ class like this: - + - + Instance declarations @@ -948,9 +543,9 @@ declarations However, if you give the command line option -fallow-overlapping-instances -option then two overlapping instance declarations are permitted -iff - +option then overlapping instance declarations are permitted. +However, GHC arranges never to commit to using an instance declaration +if another instance declaration also applies, either now or later. @@ -963,22 +558,11 @@ iff OR type2 is a substitution instance of type1 -(but not identical to type1) - - - - - - OR vice versa +(but not identical to type1), or vice versa. - - - Notice that these rules - - @@ -998,15 +582,41 @@ Reason: you can pick which instance decl - - -Regrettably, GHC doesn't guarantee to detect overlapping instance -declarations if they appear in different modules. GHC can "see" the -instance declarations in the transitive closure of all the modules -imported by the one being compiled, so it can "see" all instance decls -when it is compiling Main. However, it currently chooses not -to look at ones that can't possibly be of use in the module currently -being compiled, in the interests of efficiency. (Perhaps we should +However the rules are over-conservative. Two instance declarations can overlap, +but it can still be clear in particular situations which to use. For example: + + instance C (Int,a) where ... + instance C (a,Bool) where ... + +These are rejected by GHC's rules, but it is clear what to do when trying +to solve the constraint C (Int,Int) because the second instance +cannot apply. Yell if this restriction bites you. + + +GHC is also conservative about committing to an overlapping instance. For example: + + class C a where { op :: a -> a } + instance C [Int] where ... + instance C a => C [a] where ... + + f :: C b => [b] -> [b] + f x = op x + +From the RHS of f we get the constraint C [b]. But +GHC does not commit to the second instance declaration, because in a paricular +call of f, b might be instantiate to Int, so the first instance declaration +would be appropriate. So GHC rejects the program. If you add +GHC will instead silently pick the second instance, without complaining about +the problem of subsequent instantiations. + + +Regrettably, GHC doesn't guarantee to detect overlapping instance +declarations if they appear in different modules. GHC can "see" the +instance declarations in the transitive closure of all the modules +imported by the one being compiled, so it can "see" all instance decls +when it is compiling Main. However, it currently chooses not +to look at ones that can't possibly be of use in the module currently +being compiled, in the interests of efficiency. (Perhaps we should change that decision, at least for Main.) @@ -1173,11 +783,11 @@ with N. - + - + - + Implicit parameters @@ -1187,10 +797,85 @@ J Lewis, MB Shields, E Meijer, J Launchbury, 27th ACM Symposium on Principles of Programming Languages (POPL'00), Boston, Jan 2000. +(Most of the following, stil rather incomplete, documentation is due to Jeff Lewis.) + +A variable is called dynamically bound when it is bound by the calling +context of a function and statically bound when bound by the callee's +context. In Haskell, all variables are statically bound. Dynamic +binding of variables is a notion that goes back to Lisp, but was later +discarded in more modern incarnations, such as Scheme. Dynamic binding +can be very confusing in an untyped language, and unfortunately, typed +languages, in particular Hindley-Milner typed languages like Haskell, +only support static scoping of variables. + + +However, by a simple extension to the type class system of Haskell, we +can support dynamic binding. Basically, we express the use of a +dynamically bound variable as a constraint on the type. These +constraints lead to types of the form (?x::t') => t, which says "this +function uses a dynamically-bound variable ?x +of type t'". For +example, the following expresses the type of a sort function, +implicitly parameterized by a comparison function named cmp. + + sort :: (?cmp :: a -> a -> Bool) => [a] -> [a] + +The dynamic binding constraints are just a new form of predicate in the type class system. + + +An implicit parameter is introduced by the special form ?x, +where x is +any valid identifier. Use if this construct also introduces new +dynamic binding constraints. For example, the following definition +shows how we can define an implicitly parameterized sort function in +terms of an explicitly parameterized sortBy function: + + sortBy :: (a -> a -> Bool) -> [a] -> [a] + sort :: (?cmp :: a -> a -> Bool) => [a] -> [a] + sort = sortBy ?cmp + +Dynamic binding constraints behave just like other type class +constraints in that they are automatically propagated. Thus, when a +function is used, its implicit parameters are inherited by the +function that called it. For example, our sort function might be used +to pick out the least value in a list: + + least :: (?cmp :: a -> a -> Bool) => [a] -> a + least xs = fst (sort xs) + +Without lifting a finger, the ?cmp parameter is +propagated to become a parameter of least as well. With explicit +parameters, the default is that parameters must always be explicit +propagated. With implicit parameters, the default is to always +propagate them. + -There should be more documentation, but there isn't (yet). Yell if you need it. +An implicit parameter differs from other type class constraints in the +following way: All uses of a particular implicit parameter must have +the same type. This means that the type of (?x, ?x) +is (?x::a) => (a,a), and not +(?x::a, ?x::b) => (a, b), as would be the case for type +class constraints. + +An implicit parameter is bound using an expression of the form +expr with binds, +where with is a new keyword. This form binds the implicit +parameters arising in the body, not the free variables as a let or +where would do. For example, we define the min function by binding +cmp. + + min :: [a] -> a + min = least with ?cmp = (<=) + +Syntactically, the binds part of a with construct must be a +collection of simple bindings to variables (no function-style +bindings, and no type signatures); these bindings are neither +polymorphic or recursive. + + +Note the following additional constraints: You can't have an implicit parameter in the context of a class or instance @@ -1204,13 +889,142 @@ you invoke a function. But the ``invocation'' of instance declarations is done behind the scenes by the compiler, so it's hard to figure out exactly where it is done. Easiest thing is to outlaw the offending types. + + + + + +Linear implicit parameters + + +Linear implicit parameters are an idea developed by Koen Claessen, +Mark Shields, and Simon PJ. They address the long-standing +problem that monads seem over-kill for certain sorts of problem, notably: + + + distributing a supply of unique names + distributing a suppply of random numbers + distributing an oracle (as in QuickCheck) - + +Linear implicit parameters are just like ordinary implicit parameters, +except that they are "linear" -- that is, they cannot be copied, and +must be explicitly "split" instead. Linear implicit parameters are +written '%x' instead of '?x'. +(The '/' in the '%' suggests the split!) + + +For example: + + import GHC.Exts( Splittable ) + + data NameSupply = ... + + splitNS :: NameSupply -> (NameSupply, NameSupply) + newName :: NameSupply -> Name + + instance Splittable NameSupply where + split = splitNS + + + f :: (%ns :: NameSupply) => Env -> Expr -> Expr + f env (Lam x e) = Lam x' (f env e) + where + x' = newName %ns + env' = extend env x x' + ...more equations for f... + +Notice that the implicit parameter %ns is consumed + + once by the call to newName + once by the recursive call to f + + + +So the translation done by the type checker makes +the parameter explicit: + + f :: NameSupply -> Env -> Expr -> Expr + f ns env (Lam x e) = Lam x' (f ns1 env e) + where + (ns1,ns2) = splitNS ns + x' = newName ns2 + env = extend env x x' + +Notice the call to 'split' introduced by the type checker. +How did it know to use 'splitNS'? Because what it really did +was to introduce a call to the overloaded function 'split', +defined by the class Splittable: + + class Splittable a where + split :: a -> (a,a) + +The instance for Splittable NameSupply tells GHC how to implement +split for name supplies. But we can simply write + + g x = (x, %ns, %ns) + +and GHC will infer + + g :: (Splittable a, %ns :: a) => b -> (b,a,a) + +The Splittable class is built into GHC. It's exported by module +GHC.Exts. + + +Other points: + + '?x' and '%x' +are entirely distinct implicit parameters: you + can use them together and they won't intefere with each other. + + + You can bind linear implicit parameters in 'with' clauses. + + You cannot have implicit parameters (whether linear or not) + in the context of a class or instance declaration. + + + +Warnings + + +The monomorphism restriction is even more important than usual. +Consider the example above: + + f :: (%ns :: NameSupply) => Env -> Expr -> Expr + f env (Lam x e) = Lam x' (f env e) + where + x' = newName %ns + env' = extend env x x' + +If we replaced the two occurrences of x' by (newName %ns), which is +usually a harmless thing to do, we get: + + f :: (%ns :: NameSupply) => Env -> Expr -> Expr + f env (Lam x e) = Lam (newName %ns) (f env e) + where + env' = extend env x (newName %ns) + +But now the name supply is consumed in three places +(the two calls to newName,and the recursive call to f), so +the result is utterly different. Urk! We don't even have +the beta rule. + + +Well, this is an experimental change. With implicit +parameters we have already lost beta reduction anyway, and +(as John Launchbury puts it) we can't sensibly reason about +Haskell programs without knowing their typing. + + + + - + Functional dependencies @@ -1223,64 +1037,86 @@ ESOP 2000, Berlin, Germany, March 2000, Springer-Verlag LNCS 1782. There should be more documentation, but there isn't (yet). Yell if you need it. - + - -Explicit universal quantification +<sect2 id="universal-quantification"> +<title>Arbitrary-rank polymorphism -GHC's type system supports explicit universal quantification in -constructor fields and function arguments. This is useful for things -like defining runST from the state-thread world. -GHC's syntax for this now agrees with Hugs's, namely: +Haskell type signatures are implicitly quantified. The new keyword forall +allows us to say exactly what this means. For example: - - - forall a b. (Ord a, Eq b) => a -> b -> a + g :: b -> b - - - - -The context is, of course, optional. You can't use forall as -a type variable any more! +means this: + + g :: forall b. (b -> b) + +The two are treated identically. -Haskell type signatures are implicitly quantified. The forall -allows us to say exactly what this means. For example: - +However, GHC's type system supports arbitrary-rank +explicit universal quantification in +types. +For example, all the following types are legal: + + f1 :: forall a b. a -> b -> a + g1 :: forall a b. (Ord a, Eq b) => a -> b -> a - + f2 :: (forall a. a->a) -> Int -> Int + g2 :: (forall a. Eq a => [a] -> a -> Bool) -> Int -> Int - - g :: b -> b + f3 :: ((forall a. a->a) -> Int) -> Bool -> Bool - +Here, f1 and g1 are rank-1 types, and +can be written in standard Haskell (e.g. f1 :: a->b->a). +The forall makes explicit the universal quantification that +is implicitly added by Haskell. - -means this: +The functions f2 and g2 have rank-2 types; +the forall is on the left of a function arrrow. As g2 +shows, the polymorphic type on the left of the function arrow can be overloaded. - - +The functions f3 and g3 have rank-3 types; +they have rank-2 types on the left of a function arrow. + + +GHC allows types of arbitrary rank; you can nest foralls +arbitrarily deep in function arrows. (GHC used to be restricted to rank 2, but +that restriction has now been lifted.) +In particular, a forall-type (also called a "type scheme"), +including an operational type class context, is legal: + + On the left of a function arrow + On the right of a function arrow (see ) + As the argument of a constructor, or type of a field, in a data type declaration. For +example, any of the f1,f2,f3,g1,g2,g3 above would be valid +field type signatures. + As the type of an implicit parameter + In a pattern type signature (see ) + +There is one place you cannot put a forall: +you cannot instantiate a type variable with a forall-type. So you cannot +make a forall-type the argument of a type constructor. So these types are illegal: - g :: forall b. (b -> b) + x1 :: [forall a. a->a] + x2 :: (forall a. a->a, Int) + x3 :: Maybe (forall a. a->a) - +Of course forall becomes a keyword; you can't use forall as +a type variable any more! - -The two are treated identically. - - -Universally-quantified data type fields +<sect3 id="univ"> +<title>Examples @@ -1303,8 +1139,7 @@ newtype Swizzle = MkSwizzle (Ord a => [a] -> [a]) -The constructors now have so-called rank 2 polymorphic -types, in which there is a for-all in the argument types.: +The constructors have rank-2 types: @@ -1348,11 +1183,6 @@ to require explicit quantification on constructor arguments where that is what is wanted. Feedback welcomed.) - - - -Construction - You construct values of types T1, MonadT, Swizzle by applying the constructor to suitable values, just as usual. For example, @@ -1361,17 +1191,23 @@ the constructor to suitable values, just as usual. For example, -(T1 (\xy->x) 3) :: T Int - -(MkSwizzle sort) :: Swizzle -(MkSwizzle reverse) :: Swizzle + a1 :: T Int + a1 = T1 (\xy->x) 3 + + a2, a3 :: Swizzle + a2 = MkSwizzle sort + a3 = MkSwizzle reverse + + a4 :: MonadT Maybe + a4 = let r x = Just x + b m k = case m of + Just y -> k y + Nothing -> Nothing + in + MkMonad r b -(let r x = Just x - b m k = case m of - Just y -> k y - Nothing -> Nothing - in - MkMonad r b) :: MonadT Maybe + mkTs :: (forall b. b -> b -> b) -> a -> [T a] + mkTs f x y = [T1 f x, T1 f y] @@ -1382,11 +1218,6 @@ required, as (MkSwizzle reverse) shows. (reverseOrd constraint.) - - - -Pattern matching - When you use pattern matching, the bound variables may now have polymorphic types. For example: @@ -1395,17 +1226,17 @@ polymorphic types. For example: - f :: T a -> a -> (a, Char) - f (T1 f k) x = (f k x, f 'c' 'd') + f :: T a -> a -> (a, Char) + f (T1 w k) x = (w k x, w 'c' 'd') - g :: (Ord a, Ord b) => Swizzle -> [a] -> (a -> b) -> [b] - g (MkSwizzle s) xs f = s (map f (s xs)) + g :: (Ord a, Ord b) => Swizzle -> [a] -> (a -> b) -> [b] + g (MkSwizzle s) xs f = s (map f (s xs)) - h :: MonadT m -> [m a] -> m [a] - h m [] = return m [] - h m (x:xs) = bind m x $ \y -> - bind m (h m xs) $ \ys -> - return m (y:ys) + h :: MonadT m -> [m a] -> m [a] + h m [] = return m [] + h m (x:xs) = bind m x $ \y -> + bind m (h m xs) $ \ys -> + return m (y:ys) @@ -1416,205 +1247,200 @@ and bind to extract the polymorphic bind and return functions from the MonadT data structure, rather than using pattern matching. + - -You cannot pattern-match against an argument that is polymorphic. -For example: - - - newtype TIM s a = TIM (ST s (Maybe a)) - - runTIM :: (forall s. TIM s a) -> Maybe a - runTIM (TIM m) = runST m - - - + +Type inference -Here the pattern-match fails, because you can't pattern-match against -an argument of type (forall s. TIM s a). Instead you -must bind the variable and pattern match in the right hand side: - - - runTIM :: (forall s. TIM s a) -> Maybe a - runTIM tm = case tm of { TIM m -> runST m } - - -The tm on the right hand side is (invisibly) instantiated, like -any polymorphic value at its occurrence site, and now you can pattern-match -against it. +In general, type inference for arbitrary-rank types is undecideable. +GHC uses an algorithm proposed by Odersky and Laufer ("Putting type annotations to work", POPL'96) +to get a decidable algorithm by requiring some help from the programmer. +We do not yet have a formal specification of "some help" but the rule is this: - - - - -The partial-application restriction - -There is really only one way in which data structures with polymorphic -components might surprise you: you must not partially apply them. -For example, this is illegal: +For a lambda-bound or case-bound variable, x, either the programmer +provides an explicit polymorphic type for x, or GHC's type inference will assume +that x's type has no foralls in it. - - +What does it mean to "provide" an explicit type for x? You can do that by +giving a type signature for x directly, using a pattern type signature +(), thus: - map MkSwizzle [sort, reverse] + \ f :: (forall a. a->a) -> (f True, f 'c') - - - - -The restriction is this: every subexpression of the program must -have a type that has no for-alls, except that in a function -application (f e1…en) the partial applications are not subject to -this rule. The restriction makes type inference feasible. - - - -In the illegal example, the sub-expression MkSwizzle has the -polymorphic type (Ord b => [b] -> [b]) -> Swizzle and is not -a sub-expression of an enclosing application. On the other hand, this -expression is OK: - - - - +Alternatively, you can give a type signature to the enclosing +context, which GHC can "push down" to find the type for the variable: - map (T1 (\a b -> a)) [1,2,3] + (\ f -> (f True, f 'c')) :: (forall a. a->a) -> (Bool,Char) - - - - -even though it involves a partial application of T1, because -the sub-expression T1 (\a b -> a) has type Int -> T -Int. +Here the type signature on the expression can be pushed inwards +to give a type signature for f. Similarly, and more commonly, +one can give a type signature for the function itself: + + h :: (forall a. a->a) -> (Bool,Char) + h f = (f True, f 'c') + +You don't need to give a type signature if the lambda bound variable +is a constructor argument. Here is an example we saw earlier: + + f :: T a -> a -> (a, Char) + f (T1 w k) x = (w k x, w 'c' 'd') + +Here we do not need to give a type signature to w, because +it is an argument of constructor T1 and that tells GHC all +it needs to know. - + - -Type signatures - - -Once you have data constructors with universally-quantified fields, or -constants such as runST that have rank-2 types, it isn't long -before you discover that you need more! Consider: - + +Implicit quantification - +GHC performs implicit quantification as follows. At the top level (only) of +user-written types, if and only if there is no explicit forall, +GHC finds all the type variables mentioned in the type that are not already +in scope, and universally quantifies them. For example, the following pairs are +equivalent: - mkTs f x y = [T1 f x, T1 f y] - - - - - -mkTs is a fuction that constructs some values of type -T, using some pieces passed to it. The trouble is that since -f is a function argument, Haskell assumes that it is -monomorphic, so we'll get a type error when applying T1 to -it. This is a rather silly example, but the problem really bites in -practice. Lots of people trip over the fact that you can't make -"wrappers functions" for runST for exactly the same reason. -In short, it is impossible to build abstractions around functions with -rank-2 types. - + f :: a -> a + f :: forall a. a -> a - -The solution is fairly clear. We provide the ability to give a rank-2 -type signature for ordinary functions (not only data -constructors), thus: + g (x::a) = let + h :: a -> b -> b + h x y = y + in ... + g (x::a) = let + h :: forall b. a -> b -> b + h x y = y + in ... + - - +Notice that GHC does not find the innermost possible quantification +point. For example: - mkTs :: (forall b. b -> b -> b) -> a -> [T a] - mkTs f x y = [T1 f x, T1 f y] - + f :: (a -> a) -> Int + -- MEANS + f :: forall a. (a -> a) -> Int + -- NOT + f :: (forall a. a -> a) -> Int - - -This type signature tells the compiler to attribute f with -the polymorphic type (forall b. b -> b -> b) when type -checking the body of mkTs, so now the application of -T1 is fine. + g :: (Ord a => a -> a) -> Int + -- MEANS the illegal type + g :: forall a. (Ord a => a -> a) -> Int + -- NOT + g :: (forall a. Ord a => a -> a) -> Int + +The latter produces an illegal type, which you might think is silly, +but at least the rule is simple. If you want the latter type, you +can write your for-alls explicitly. Indeed, doing so is strongly advised +for rank-2 types. + + - -There are two restrictions: - + +Liberalised type synonyms + - +Type synonmys are like macros at the type level, and +GHC does validity checking on types only after expanding type synonyms. +That means that GHC can be very much more liberal about type synonyms than Haskell 98: - - - - You can only define a rank 2 type, specified by the following -grammar: - - + You can write a forall (including overloading) +in a type synonym, thus: -rank2type ::= [forall tyvars .] [context =>] funty -funty ::= ([forall tyvars .] [context =>] ty) -> funty - | ty -ty ::= ...current Haskell monotype syntax... - - + type Discard a = forall b. Show b => a -> b -> (a, String) -Informally, the universal quantification must all be right at the beginning, -or at the top level of a function argument. + f :: Discard a + f x y = (x, show y) + g :: Discard Int -> (Int,Bool) -- A rank-2 type + g f = f Int True + - - - There is a restriction on the definition of a function whose -type signature is a rank-2 type: the polymorphic arguments must be -matched on the left hand side of the "=" sign. You can't -define mkTs like this: + +You can write an unboxed tuple in a type synonym: + + type Pr = (# Int, Int #) + h :: Int -> Pr + h x = (# x, x #) + + + +You can apply a type synonym to a forall type: -mkTs :: (forall b. b -> b -> b) -> a -> [T a] -mkTs = \ f x y -> [T1 f x, T1 f y] + type Foo a = a -> a -> Bool + + f :: Foo (forall b. b->b) +After epxanding the synonym, f has the legal (in GHC) type: + + f :: (forall b. b->b) -> (forall b. b->b) -> Bool + + + +You can apply a type synonym to a partially applied type synonym: + + type Generic i o = forall x. i x -> o x + type Id x = x + + foo :: Generic Id [] + +After epxanding the synonym, foo has the legal (in GHC) type: + + foo :: forall x. x -> [x] + + - -The same partial-application rule applies to ordinary functions with -rank-2 types as applied to data constructors. - + - + +GHC currently does kind checking before expanding synonyms (though even that +could be changed.) + + +After expanding type synonyms, GHC does validity checking on types, looking for +the following mal-formedness which isn't detected simply by kind checking: + + +Type constructor applied to a type involving for-alls. + + +Unboxed tuple on left of an arrow. + + +Partially-applied type synonym. + +So, for example, +this will be rejected: + + type Pr = (# Int, Int #) + h :: Pr -> Int + h x = ... + +because GHC does not allow unboxed tuples on the left of a function arrow. - - -Type synonyms and hoisting - - +For-all hoisting -GHC also allows you to write a forall in a type synonym, thus: - - type Discard a = forall b. a -> b -> a - - f :: Discard a - f x y = x - -However, it is often convenient to use these sort of synonyms at the right hand +It is often convenient to use generalised type synonyms at the right hand end of an arrow, thus: type Discard a = forall b. a -> b -> a @@ -1634,9 +1460,9 @@ In general, the rule is this: to determine the type specified by any e user-written type (e.g. in a type signature), GHC expands type synonyms and then repeatedly performs the transformation: - type1 -> forall a. type2 + type1 -> forall a1..an. context2 => type2 ==> - forall a. type1 -> type2 + forall a1..an. context2 => type1 -> type2 (In fact, GHC tries to retain as much synonym information as possible for use in error messages, but that is a usability issue.) This rule applies, of course, whether @@ -1648,9 +1474,8 @@ valid way to write g's type signature: - - + Existentially quantified data constructors @@ -1740,7 +1565,7 @@ that collection of packages in a uniform manner. You can express quite a bit of object-oriented-like programming this way. - + Why existential? @@ -1763,9 +1588,9 @@ But Haskell programmers can safely think of the ordinary adding a new existential quantification construct. - + - + Type classes @@ -1808,7 +1633,7 @@ So this program is legal: f :: Baz -> String f (Baz1 p q) | p == q = "Yes" | otherwise = "No" - f (Baz1 v fn) = show (fn v) + f (Baz2 v fn) = show (fn v) @@ -1825,9 +1650,9 @@ Notice the way that the syntax fits smoothly with that used for universal quantification earlier. - + - + Restrictions @@ -1971,92 +1796,12 @@ declarations. Define your own instances! - + - + - -Assertions -<indexterm><primary>Assertions</primary></indexterm> - - - -If you want to make use of assertions in your standard Haskell code, you -could define a function like the following: - - - - - -assert :: Bool -> a -> a -assert False x = error "assertion failed!" -assert _ x = x - - - - - -which works, but gives you back a less than useful error message -- -an assertion failed, but which and where? - - - -One way out is to define an extended assert function which also -takes a descriptive string to include in the error message and -perhaps combine this with the use of a pre-processor which inserts -the source location where assert was used. - - - -Ghc offers a helping hand here, doing all of this for you. For every -use of assert in the user's source: - - - - - -kelvinToC :: Double -> Double -kelvinToC k = assert (k >= 0.0) (k+273.15) - - - - - -Ghc will rewrite this to also include the source location where the -assertion was made, - - - - - -assert pred val ==> assertError "Main.hs|15" pred val - - - - - -The rewrite is only performed by the compiler when it spots -applications of Exception.assert, so you can still define and -use your own versions of assert, should you so wish. If not, -import Exception to make use assert in your code. - - - -To have the compiler ignore uses of assert, use the compiler option -. -fignore-asserts option That is, -expressions of the form assert pred e will be rewritten to e. - - - -Assertion failures can be caught, see the documentation for the -Exception library () -for the details. - - - - - -Scoped Type Variables +<sect2 id="scoped-type-variables"> +<title>Scoped Type Variables @@ -2106,7 +1851,7 @@ are noted. So much for the basic idea. Here are the details. - + What a pattern type signature means A type variable brought into scope by a pattern type signature is simply @@ -2144,9 +1889,9 @@ For example, all of these are legal: w (x::a) = x -- a unifies with [b] - + - + Scope and implicit quantification @@ -2278,9 +2023,9 @@ scope over the methods defined in the where part. For exampl - + - + Result type signatures @@ -2321,124 +2066,452 @@ you want: Result type signatures are not yet implemented in Hugs. - + + + +Where a pattern type signature can occur + + +A pattern type signature can occur in any pattern. For example: + + + + +A pattern type signature can be on an arbitrary sub-pattern, not +ust on a variable: + + + + f ((x,y)::(a,b)) = (y,x) :: (b,a) + + + + + + + + + Pattern type signatures, including the result part, can be used +in lambda abstractions: + + + (\ (x::a, y) :: a -> x) + + + + + + + Pattern type signatures, including the result part, can be used +in case expressions: + + + + case e of { (x::a, y) :: a -> x } + + + + + + + +To avoid ambiguity, the type after the “::” in a result +pattern signature on a lambda or case must be atomic (i.e. a single +token or a parenthesised type of some sort). To see why, +consider how one would parse this: + + + + \ x :: a -> b -> x + + + + + + + + + + Pattern type signatures can bind existential type variables. +For example: + + + + data T = forall a. MkT [a] + + f :: T -> T + f (MkT [t::a]) = MkT t3 + where + t3::[a] = [t,t,t] + + + + + + + + + + +Pattern type signatures +can be used in pattern bindings: + + + f x = let (y, z::a) = x in ... + f1 x = let (y, z::Int) = x in ... + f2 (x::(Int,a)) = let (y, z::a) = x in ... + f3 :: (b->b) = \x -> x + + +In all such cases, the binding is not generalised over the pattern-bound +type variables. Thus f3 is monomorphic; f3 +has type b -> b for some type b, +and not forall b. b -> b. +In contrast, the binding + + f4 :: b->b + f4 = \x -> x + +makes a polymorphic function, but b is not in scope anywhere +in f4's scope. + + + + + + + + + + +Explicitly-kinded quantification + + +Haskell infers the kind of each type variable. Sometimes it is nice to be able +to give the kind explicitly as (machine-checked) documentation, +just as it is nice to give a type signature for a function. On some occasions, +it is essential to do so. For example, in his paper "Restricted Data Types in Haskell" (Haskell Workshop 1999) +John Hughes had to define the data type: + + data Set cxt a = Set [a] + | Unused (cxt a -> ()) + +The only use for the Unused constructor was to force the correct +kind for the type variable cxt. + + +GHC now instead allows you to specify the kind of a type variable directly, wherever +a type variable is explicitly bound. Namely: + +data declarations: + + data Set (cxt :: * -> *) a = Set [a] + +type declarations: + + type T (f :: * -> *) = f Int + +class declarations: + + class (Eq a) => C (f :: * -> *) a where ... + +forall's in type signatures: + + f :: forall (cxt :: * -> *). Set cxt Int + + + + + +The parentheses are required. Some of the spaces are required too, to +separate the lexemes. If you write (f::*->*) you +will get a parse error, because "::*->*" is a +single lexeme in Haskell. + + + +As part of the same extension, you can put kind annotations in types +as well. Thus: + + f :: (Int :: *) -> Int + g :: forall a. a -> (a :: *) + +The syntax is + + atype ::= '(' ctype '::' kind ') + +The parentheses are required. + + + + + + + + + + +Assertions +<indexterm><primary>Assertions</primary></indexterm> + + + +If you want to make use of assertions in your standard Haskell code, you +could define a function like the following: + + + + + +assert :: Bool -> a -> a +assert False x = error "assertion failed!" +assert _ x = x + + + + + +which works, but gives you back a less than useful error message -- +an assertion failed, but which and where? + + + +One way out is to define an extended assert function which also +takes a descriptive string to include in the error message and +perhaps combine this with the use of a pre-processor which inserts +the source location where assert was used. + + + +Ghc offers a helping hand here, doing all of this for you. For every +use of assert in the user's source: + + + + + +kelvinToC :: Double -> Double +kelvinToC k = assert (k >= 0.0) (k+273.15) + + + + + +Ghc will rewrite this to also include the source location where the +assertion was made, + + + + + +assert pred val ==> assertError "Main.hs|15" pred val + + + + + +The rewrite is only performed by the compiler when it spots +applications of Exception.assert, so you can still define and +use your own versions of assert, should you so wish. If not, +import Exception to make use assert in your code. + + + +To have the compiler ignore uses of assert, use the compiler option +. -fignore-asserts option That is, +expressions of the form assert pred e will be rewritten to e. + + + +Assertion failures can be caught, see the documentation for the +Exception library () +for the details. + + + + + - -Where a pattern type signature can occur + +Pattern guards -A pattern type signature can occur in any pattern. For example: - +Pattern guards (Glasgow extension) +The discussion that follows is an abbreviated version of Simon Peyton Jones's original proposal. (Note that the proposal was written before pattern guards were implemented, so refers to them as unimplemented.) + - -A pattern type signature can be on an arbitrary sub-pattern, not -ust on a variable: - +Suppose we have an abstract data type of finite maps, with a +lookup operation: - f ((x,y)::(a,b)) = (y,x) :: (b,a) +lookup :: FiniteMap -> Int -> Maybe Int - +The lookup returns Nothing if the supplied key is not in the domain of the mapping, and (Just v) otherwise, +where v is the value that the key maps to. Now consider the following definition: - - + + +clunky env var1 var2 | ok1 && ok2 = val1 + val2 +| otherwise = var1 + var2 +where + m1 = lookup env var1 + m2 = lookup env var2 + ok1 = maybeToBool m1 + ok2 = maybeToBool m2 + val1 = expectJust m1 + val2 = expectJust m2 + - Pattern type signatures, including the result part, can be used -in lambda abstractions: +The auxiliary functions are + - (\ (x::a, y) :: a -> x) +maybeToBool :: Maybe a -> Bool +maybeToBool (Just x) = True +maybeToBool Nothing = False + +expectJust :: Maybe a -> a +expectJust (Just x) = x +expectJust Nothing = error "Unexpected Nothing" - - - - Pattern type signatures, including the result part, can be used -in case expressions: +What is clunky doing? The guard ok1 && +ok2 checks that both lookups succeed, using +maybeToBool to convert the Maybe +types to booleans. The (lazily evaluated) expectJust +calls extract the values from the results of the lookups, and binds the +returned values to val1 and val2 +respectively. If either lookup fails, then clunky takes the +otherwise case and returns the sum of its arguments. + + +This is certainly legal Haskell, but it is a tremendously verbose and +un-obvious way to achieve the desired effect. Arguably, a more direct way +to write clunky would be to use case expressions: + - case e of { (x::a, y) :: a -> x } +clunky env var1 var1 = case lookup env var1 of + Nothing -> fail + Just val1 -> case lookup env var2 of + Nothing -> fail + Just val2 -> val1 + val2 +where + fail = val1 + val2 + +This is a bit shorter, but hardly better. Of course, we can rewrite any set +of pattern-matching, guarded equations as case expressions; that is +precisely what the compiler does when compiling equations! The reason that +Haskell provides guarded equations is because they allow us to write down +the cases we want to consider, one at a time, independently of each other. +This structure is hidden in the case version. Two of the right-hand sides +are really the same (fail), and the whole expression +tends to become more and more indented. - - -To avoid ambiguity, the type after the “::” in a result -pattern signature on a lambda or case must be atomic (i.e. a single -token or a parenthesised type of some sort). To see why, -consider how one would parse this: - +Here is how I would write clunky: + - \ x :: a -> b -> x +clunky env var1 var1 + | Just val1 <- lookup env var1 + , Just val2 <- lookup env var2 + = val1 + val2 +...other equations for clunky... + +The semantics should be clear enough. The qualifers are matched in order. +For a <- qualifier, which I call a pattern guard, the +right hand side is evaluated and matched against the pattern on the left. +If the match fails then the whole guard fails and the next equation is +tried. If it succeeds, then the appropriate binding takes place, and the +next qualifier is matched, in the augmented environment. Unlike list +comprehensions, however, the type of the expression to the right of the +<- is the same as the type of the pattern to its +left. The bindings introduced by pattern guards scope over all the +remaining guard qualifiers, and over the right hand side of the equation. + + +Just as with list comprehensions, boolean expressions can be freely mixed +with among the pattern guards. For example: - - + +f x | [y] <- x + , y > 3 + , Just z <- h y + = ... + - Pattern type signatures can bind existential type variables. -For example: +Haskell's current guards therefore emerge as a special case, in which the +qualifier list has just one element, a boolean expression. + + + - - data T = forall a. MkT [a] + + Parallel List Comprehensions + list comprehensionsparallel + + parallel list comprehensions + - f :: T -> T - f (MkT [t::a]) = MkT t3 - where - t3::[a] = [t,t,t] - + Parallel list comprehensions are a natural extension to list + comprehensions. List comprehensions can be thought of as a nice + syntax for writing maps and filters. Parallel comprehensions + extend this to include the zipWith family. + A parallel list comprehension has multiple independent + branches of qualifier lists, each separated by a `|' symbol. For + example, the following zips together two lists: - - + + [ (x, y) | x <- xs | y <- ys ] + + The behavior of parallel list comprehensions follows that of + zip, in that the resulting list will have the same length as the + shortest branch. - + We can define parallel list comprehensions by translation to + regular comprehensions. Here's the basic idea: - -Pattern type signatures -can be used in pattern bindings: + Given a parallel comprehension of the form: - f x = let (y, z::a) = x in ... - f1 x = let (y, z::Int) = x in ... - f2 (x::(Int,a)) = let (y, z::a) = x in ... - f3 :: (b->b) = \x -> x + [ e | p1 <- e11, p2 <- e12, ... + | q1 <- e21, q2 <- e22, ... + ... + ] -In all such cases, the binding is not generalised over the pattern-bound -type variables. Thus f3 is monomorphic; f3 -has type b -> b for some type b, -and not forall b. b -> b. -In contrast, the binding + This will be translated to: + - f4 :: b->b - f4 = \x -> x + [ e | ((p1,p2), (q1,q2), ...) <- zipN [(p1,p2) | p1 <- e11, p2 <- e12, ...] + [(q1,q2) | q1 <- e21, q2 <- e22, ...] + ... + ] -makes a polymorphic function, but b is not in scope anywhere -in f4's scope. - - - - - - + where `zipN' is the appropriate zip for the given number of + branches. + - + Pragmas @@ -2627,12 +2700,17 @@ i2d (I# i) = D# (int2Double# i) -- uses Glasgow prim-op directly Same idea, except for instance declarations. For example: -instance (Eq a) => Eq (Foo a) where { ... usual stuff ... } - -{-# SPECIALIZE instance Eq (Foo [(Int, Bar)] #-} +instance (Eq a) => Eq (Foo a) where { + {-# SPECIALIZE instance Eq (Foo [(Int, Bar)]) #-} + ... usual stuff ... + } - -Compatible with HBC, by the way. +The pragma must occur inside the where part +of the instance declaration. + + +Compatible with HBC, by the way, except perhaps in the placement +of the pragma. @@ -2717,6 +2795,8 @@ GHC will print the specified message. + + Rewrite rules @@ -3531,6 +3611,181 @@ Just to finish with, here's another example I rather like: </sect2> </sect1> +<sect1 id="newtype-deriving"> +<title>Generalised derived instances for newtypes + + +When you define an abstract type using newtype, you may want +the new type to inherit some instances from its representation. In +Haskell 98, you can inherit instances of Eq, Ord, +Enum and Bounded by deriving them, but for any +other classes you have to write an explicit instance declaration. For +example, if you define + + + newtype Dollars = Dollars Int + + +and you want to use arithmetic on Dollars, you have to +explicitly define an instance of Num: + + + instance Num Dollars where + Dollars a + Dollars b = Dollars (a+b) + ... + +All the instance does is apply and remove the newtype +constructor. It is particularly galling that, since the constructor +doesn't appear at run-time, this instance declaration defines a +dictionary which is wholly equivalent to the Int +dictionary, only slower! + + + Generalising the deriving clause + +GHC now permits such instances to be derived instead, so one can write + + newtype Dollars = Dollars Int deriving (Eq,Show,Num) + + +and the implementation uses the same Num dictionary +for Dollars as for Int. Notionally, the compiler +derives an instance declaration of the form + + + instance Num Int => Num Dollars + + +which just adds or removes the newtype constructor according to the type. + + + +We can also derive instances of constructor classes in a similar +way. For example, suppose we have implemented state and failure monad +transformers, such that + + + instance Monad m => Monad (State s m) + instance Monad m => Monad (Failure m) + +In Haskell 98, we can define a parsing monad by + + type Parser tok m a = State [tok] (Failure m) a + + +which is automatically a monad thanks to the instance declarations +above. With the extension, we can make the parser type abstract, +without needing to write an instance of class Monad, via + + + newtype Parser tok m a = Parser (State [tok] (Failure m) a) + deriving Monad + +In this case the derived instance declaration is of the form + + instance Monad (State [tok] (Failure m)) => Monad (Parser tok m) + + +Notice that, since Monad is a constructor class, the +instance is a partial application of the new type, not the +entire left hand side. We can imagine that the type declaration is +``eta-converted'' to generate the context of the instance +declaration. + + + +We can even derive instances of multi-parameter classes, provided the +newtype is the last class parameter. In this case, a ``partial +application'' of the class appears in the deriving +clause. For example, given the class + + + class StateMonad s m | m -> s where ... + instance Monad m => StateMonad s (State s m) where ... + +then we can derive an instance of StateMonad for Parsers by + + newtype Parser tok m a = Parser (State [tok] (Failure m) a) + deriving (Monad, StateMonad [tok]) + + +The derived instance is obtained by completing the application of the +class to the new type: + + + instance StateMonad [tok] (State [tok] (Failure m)) => + StateMonad [tok] (Parser tok m) + + + + +As a result of this extension, all derived instances in newtype +declarations are treated uniformly (and implemented just by reusing +the dictionary for the representation type), except +Show and Read, which really behave differently for +the newtype and its representation. + + + + A more precise specification + +Derived instance declarations are constructed as follows. Consider the +declaration (after expansion of any type synonyms) + + + newtype T v1...vn = T' (S t1...tk vk+1...vn) deriving (c1...cm) + + +where S is a type constructor, t1...tk are +types, +vk+1...vn are type variables which do not occur in any of +the ti, and the ci are partial applications of +classes of the form C t1'...tj'. The derived instance +declarations are, for each ci, + + + instance ci (S t1...tk vk+1...v) => ci (T v1...vp) + +where p is chosen so that T v1...vp is of the +right kind for the last parameter of class Ci. + + + +As an example which does not work, consider + + newtype NonMonad m s = NonMonad (State s m s) deriving Monad + +Here we cannot derive the instance + + instance Monad (State s m) => Monad (NonMonad m) + + +because the type variable s occurs in State s m, +and so cannot be "eta-converted" away. It is a good thing that this +deriving clause is rejected, because NonMonad m is +not, in fact, a monad --- for the same reason. Try defining +>>= with the correct type: you won't be able to. + + + +Notice also that the order of class parameters becomes +important, since we can only derive instances for the last one. If the +StateMonad class above were instead defined as + + + class StateMonad m s | m -> s where ... + + +then we would not have been able to derive an instance for the +Parser type above. We hypothesise that multi-parameter +classes usually have one "main" parameter for which deriving new +instances is most interesting. + + + + + +