diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 1bee37dd5d58..3407de5d1d0f 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -844,10 +844,10 @@ To disable it, you can use the flag The do-notation of Haskell 98 does not allow recursive bindings, that is, the variables bound in a do-expression are visible only in the textually following code block. Compare this to a let-expression, where bound variables are visible in the entire binding - group. - + group. + - + It turns out that such recursive bindings do indeed make sense for a variety of monads, but not all. In particular, recursion in this sense requires a fixed-point operator for the underlying monad, captured by the mfix method of the MonadFix class, defined in Control.Monad.Fix as follows: @@ -888,7 +888,7 @@ justOnes = do { rec { xs <- Just (1:xs) } As you can guess justOnes will evaluate to Just [-1,-1,-1,.... - + GHC's implementation the mdo-notation closely follows the original translation as described in the paper A recursive do for Haskell, which in turn is based on the work Value Recursion @@ -1677,8 +1677,8 @@ Note that \case starts a layout, so you can write Empty case alternatives -The flag enables -case expressions, or lambda-case expressions, that have no alternatives, +The flag enables +case expressions, or lambda-case expressions, that have no alternatives, thus: case e of { } -- No alternatives @@ -1692,7 +1692,7 @@ has no non-bottom values. For example: f :: Void -> Int f x = case x of { } -With dependently-typed features it is more useful +With dependently-typed features it is more useful (see Trac). For example, consider these two candidate definitions of absurd: @@ -1704,7 +1704,7 @@ absurd x = error "absurd" -- (A) absurd x = case x of {} -- (B) We much prefer (B). Why? Because GHC can figure out that (True :~: False) -is an empty type. So (B) has no partiality and GHC should be able to compile with +is an empty type. So (B) has no partiality and GHC should be able to compile with . (Though the pattern match checking is not yet clever enough to do that. On the other hand (A) looks dangerous, and GHC doesn't check to make @@ -2289,21 +2289,6 @@ to be written infix, very much like expressions. More specifically: f :: (a :=: b) => a -> b - - A type variable can be an (unqualified) operator e.g. +. - The lexical syntax is the same as that for variable operators, excluding "(.)", - "(!)", and "(*)". In a binding position, the operator must be - parenthesised. For example: - - type T (+) = Int + Int - f :: T Either - f = Left 3 - - liftA2 :: Arrow (~>) - => (a -> b -> c) -> (e ~> a) -> (e ~> b) -> (e ~> c) - liftA2 = ... - - Back-quotes work as for expressions, both for type constructors and type variables; e.g. Int `Either` Bool, or @@ -3105,7 +3090,7 @@ So GHC implements the following design: a data constructor declared in a GADT-st declaration is displayed infix by Show iff (a) it is an operator symbol, (b) it has two arguments, (c) it has a programmer-supplied fixity declaration. For example - infix 6 (:--:) + infix 6 (:--:) data T a where (:--:) :: Int -> Bool -> T Int @@ -3389,7 +3374,7 @@ modules Data.Typeable and Data.Generics re Since GHC 7.8.1, Typeable is kind-polymorphic (see ) and can be derived for any datatype and -type class. Instances for datatypes can be derived by attaching a +type class. Instances for datatypes can be derived by attaching a deriving Typeable clause to the datatype declaration, or by using standalone deriving (see ). Instances for type classes can only be derived using standalone deriving. @@ -3809,7 +3794,7 @@ globally configurable settings in a program. For example, assumeRH :: a -> a -- Deterministic version of the Miller test - -- correctness depends on the generalized Riemann hypothesis + -- correctness depends on the generalized Riemann hypothesis isPrime :: RiemannHypothesis => Integer -> Bool isPrime n = assumeRH (...) @@ -4186,7 +4171,7 @@ including both declarations (A) and (B), say); an error is only reported if a particular constraint matches more than one. -See also for flags that loosen the +See also for flags that loosen the instance resolution rules. @@ -4416,7 +4401,7 @@ with N. Overlapping instances -In general, as discussed in , +In general, as discussed in , GHC requires that it be unambiguous which instance declaration should be used to resolve a type-class constraint. This behaviour @@ -4431,7 +4416,7 @@ an OPTIONS_GHC pragma if desired (, by -allowing more than one instance to match, provided there is a most specific one. +allowing more than one instance to match, provided there is a most specific one. For example, consider instance context1 => C Int a where ... -- (A) @@ -4444,9 +4429,9 @@ The constraint C Int [Int] matches instances (A), most-specific match, the program is rejected. -An instance declaration is more specific than another iff +An instance declaration is more specific than another iff the head of former is a substitution instance of the latter. For example -(D) is "more specific" than (C) because you can get from (C) to (D) by +(D) is "more specific" than (C) because you can get from (C) to (D) by substituting a:=Int. @@ -4609,7 +4594,7 @@ instance C a => C (T a) where xs :: [b] xs = [x,x,x] -Provided that you also specify +Provided that you also specify (), the forall b scopes over the definition of foo, and in particular over the type signature for xs. @@ -4703,7 +4688,7 @@ constructing lists. In Haskell, the list notation can be be used in the following seven ways: -[] -- Empty list +[] -- Empty list [x] -- x : [] [x,y,z] -- x : y : z : [] [x .. ] -- enumFrom x @@ -4738,7 +4723,7 @@ listing gives a few examples: ['a' .. 'z'] :: Text -List patterns are also overloaded. When the +List patterns are also overloaded. When the extension is turned on, these definitions are desugared as follows f [] = ... -- f (toList -> []) = ... @@ -4752,7 +4737,7 @@ g [x,y,z] = ... -- g (toList -> [x,y,z]) = ... In the above desugarings, the functions toList, fromList and fromListN are all -methods of +methods of the IsList class, which is itself exported from the GHC.Exts module. The type class is defined as follows: @@ -4769,18 +4754,18 @@ class IsList l where The FromList class and its methods are intended to be -used in conjunction with the extension. +used in conjunction with the extension. The type function Item returns the type of items of the structure l. - -The function fromList + +The function fromList constructs the structure l from the given list of -Item l. +Item l. - + The function fromListN takes the input list's length as a hint. Its behaviour should be equivalent to fromList. The hint can be used for more efficient @@ -4789,8 +4774,8 @@ construction of the structure l compared to list's length the behaviour of fromListN is not specified. - -The function toList should be + +The function toList should be the inverse of fromList. @@ -4812,12 +4797,12 @@ instance (Ord a) => FromList (Set a) where instance (Ord k) => FromList (Map k v) where type Item (Map k v) = (k,v) - fromList = Map.fromList + fromList = Map.fromList toList = Map.toList instance FromList (IntMap v) where type Item (IntMap v) = (Int,v) - fromList = IntMap.fromList + fromList = IntMap.fromList toList = IntMap.toList instance FromList Text where @@ -4841,7 +4826,7 @@ instance FromList (Vector a) where GHC uses the fromList (etc) methods from module GHC.Exts. You do not need to import GHC.Exts for this to happen. - However if you use , then + However if you use , then GHC instead uses whatever is in scope with the names of toList, fromList and fromListN. That is, these functions are rebindable; @@ -5633,7 +5618,7 @@ instance Show v => Show (GMap () v) where ... Kind polymorphism This section describes kind polymorphism, and extension -enabled by . +enabled by . It is described in more detail in the paper Giving Haskell a Promotion, which appeared at TLDI 2012. @@ -5684,14 +5669,14 @@ kind for un-decorated declarations, whenever possible. For example: data T m a = MkT (m a) -- GHC infers kind T :: forall k. (k -> *) -> k -> * -Just as in the world of terms, you can restrict polymorphism using a +Just as in the world of terms, you can restrict polymorphism using a kind signature (sometimes called a kind annotation) ( implies ): data T m (a :: *) = MkT (m a) -- GHC now infers kind T :: (* -> *) -> * -> * -There is no "forall" for kind variables. Instead, when binding a type variable, +There is no "forall" for kind variables. Instead, when binding a type variable, you can simply mention a kind variable in a kind annotation for that type-variable binding, thus: @@ -5702,19 +5687,19 @@ The kind "forall" is placed just outside the outermost type-variable binding whose kind annotation mentions the kind variable. For example -f1 :: (forall a m. m a -> Int) -> Int - -- f1 :: forall (k:BOX). - -- (forall (a:k) (m:k->*). m a -> Int) +f1 :: (forall a m. m a -> Int) -> Int + -- f1 :: forall (k:BOX). + -- (forall (a:k) (m:k->*). m a -> Int) -- -> Int -f2 :: (forall (a::k) m. m a -> Int) -> Int - -- f2 :: (forall (k:BOX) (a:k) (m:k->*). m a -> Int) +f2 :: (forall (a::k) m. m a -> Int) -> Int + -- f2 :: (forall (k:BOX) (a:k) (m:k->*). m a -> Int) -- -> Int -Here in f1 there is no kind annotation mentioning the polymorphic -kind variable, so k is generalised at the top +Here in f1 there is no kind annotation mentioning the polymorphic +kind variable, so k is generalised at the top level of the signature for f1, -making the signature for f1 is as polymorphic as possible. +making the signature for f1 is as polymorphic as possible. But in the case of of f2 we give a kind annotation in the forall (a:k) binding, and GHC therefore puts the kind forall right there too. @@ -5735,7 +5720,7 @@ data T m a = MkT (m a) (T Maybe (m a)) -- GHC infers kind T :: (* -> *) -> * -> * The recursive use of T forced the second argument to have kind *. -However, just as in type inference, you can achieve polymorphic recursion by giving a +However, just as in type inference, you can achieve polymorphic recursion by giving a complete kind signature for T. The way to give a complete kind signature for a data type is to use a GADT-style declaration with an explicit kind signature thus: @@ -5770,7 +5755,7 @@ you must use GADT syntax. -A type or data family declaration always have a +A type or data family declaration always have a complete user-specified kind signature; no "::" is required: data family D1 a -- D1 :: * -> * @@ -5851,7 +5836,7 @@ data Nat = Ze | Su Nat data List a = Nil | Cons a (List a) data Pair a b = Pair a b - + data Sum a b = L a | R b give rise to the following kinds and type constructors: @@ -5916,7 +5901,7 @@ type T1 = P -- 1 type T2 = 'P -- promoted 2 Note that promoted datatypes give rise to named kinds. Since these can never be -ambiguous, we do not allow quotes in kind names. +ambiguous, we do not allow quotes in kind names. Just as in the case of Template Haskell (), there is no way to quote a data constructor or type constructor whose second character @@ -5994,7 +5979,7 @@ data Ex :: * where MkEx :: forall a. a -> Ex Both the type Ex and the data constructor MkEx -get promoted, with the polymorphic kind 'MkEx :: forall k. k -> Ex. +get promoted, with the polymorphic kind 'MkEx :: forall k. k -> Ex. Somewhat surprisingly, you can write a type family to extract the member of a type-level existential: @@ -6003,7 +5988,7 @@ type instance UnEx (MkEx x) = x At first blush, UnEx seems poorly-kinded. The return kind k is not mentioned in the arguments, and thus it would seem -that an instance would have to return a member of k +that an instance would have to return a member of k for any k. However, this is not the case. The type family UnEx is a kind-indexed type family. The return kind k is an implicit parameter to UnEx. @@ -6649,7 +6634,7 @@ field type signatures. As the type of an implicit parameter In a pattern type signature (see ) -The option is also required for any +The option is also required for any type with a forall or context to the right of an arrow (e.g. f :: Int -> forall a. a->a, or g :: Int -> Ord a => a -> a). Such types are technically rank 1, but @@ -6659,7 +6644,7 @@ are clearly not Haskell-98, and an extra flag did not seem worth the bother. The obselete language options and are synonyms for . They used to specify finer distinctions that -GHC no longer makes. (They should really elicit a deprecation warning, but they don't, purely +GHC no longer makes. (They should really elicit a deprecation warning, but they don't, purely to avoid the need to library authors to change their old flags specifciations.) @@ -7292,7 +7277,7 @@ pattern binding must have the same context. For example, this is fine: An ML-style language usually generalises the type of any let-bound or where-bound variable, so that it is as polymorphic as possible. -With the flag GHC implements a slightly more conservative policy: +With the flag GHC implements a slightly more conservative policy: it generalises only "closed" bindings. A binding is considered "closed" if either @@ -7312,11 +7297,11 @@ But k is not closed because it mentions x Another way to think of it is this: all closed bindings could be defined at top level. (In the example, we could move h to top level.) -All of this applies only to bindings that lack an explicit type signature, so that GHC has to +All of this applies only to bindings that lack an explicit type signature, so that GHC has to infer its type. If you supply a type signature, then that fixes type of the binding, end of story. -The rationale for this more conservative strategy is given in -the papers "Let should not be generalised" and "Modular type inference with local assumptions", and +The rationale for this more conservative strategy is given in +the papers "Let should not be generalised" and "Modular type inference with local assumptions", and a related blog post. The flag is implied by and . You can switch it off again @@ -7342,7 +7327,7 @@ the term you're about to write. -This extension allows special placeholders, written with a leading underscore (e.g. "_", +This extension allows special placeholders, written with a leading underscore (e.g. "_", "_foo", "_bar"), to be used as an expression. During compilation these holes will generate an error message describing what type is expected there, information about the origin of any free type variables, and a list of local bindings @@ -7500,7 +7485,7 @@ Prelude> fst (True, 1 == 'a') In the expression: 1 == 'a' In the first argument of `fst', namely `(True, 1 == 'a')' -Otherwise, in the common case of a simple type error such as +Otherwise, in the common case of a simple type error such as typing reverse True at the prompt, you would get a warning and then an immediately-following type error when the expression is evaluated. @@ -7620,7 +7605,7 @@ Wiki page. 'f has type Name, and names the function f. Similarly 'C has type Name and names the data constructor C. - In general 'thing + In general 'thing interprets thing in an expression context. A name whose second character is a single quote (sadly) cannot be quoted in this way,