[[project @ 2002-10-11 16:42:44 by simonpj] simonpj**20021011164244 Docs for Template Haskell ] { hunk ./ghc/docs/users_guide/glasgow_exts.sgml 157 + + + +Syntactic extensions + + + + + Hierarchical Modules + + GHC supports a small extension to the syntax of module + names: a module name is allowed to contain a dot + ‘.’. This is also known as the + “hierarchical module namespace” extension, because + it extends the normally flat Haskell module namespace into a + more flexible hierarchy of modules. + + This extension has very little impact on the language + itself; modules names are always fully + qualified, so you can just think of the fully qualified module + name as the module name. In particular, this + means that the full module name must be given after the + module keyword at the beginning of the + module; for example, the module A.B.C must + begin + +module A.B.C + + + It is a common strategy to use the as + keyword to save some typing when using qualified names with + hierarchical modules. For example: + + +import qualified Control.Monad.ST.Strict as ST + + + Hierarchical modules have an impact on the way that GHC + searches for files. For a description, see . + + GHC comes with a large collection of libraries arranged + hierarchically; see the accompanying library documentation. + There is an ongoing project to create and maintain a stable set + of core libraries used by several Haskell + compilers, and the libraries that GHC comes with represent the + current status of that project. For more details, see Haskell + Libraries. + + + + + + +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. + + + +Here is how I would write clunky: + + + +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 + = ... + + + +Haskell's current guards therefore emerge as a special case, in which the +qualifier list has just one element, a boolean expression. + + + + + + +The recursive do-notation + + + The recursive do-notation (also known as mdo-notation) is implemented as described in +"A recursive do for Haskell", +Levent Erkok, John Launchbury", +Haskell Workshop 2002, pages: 29-37. Pittsburgh, Pennsylvania. + + +The do-notation of Haskell 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. It turns out that several applications can benefit from recursive bindings in +the do-notation, and this extension provides the necessary syntactic support. + + +Here is a simple (yet contrived) example: + + +justOnes = mdo xs <- Just (1:xs) + return xs + + +As you can guess justOnes will evaluate to Just [1,1,1,.... + + + +The Control.Monad.Fix library introduces the MonadFix class. It's definition is: + + +class Monad m => MonadFix m where + mfix :: (a -> m a) -> m a + + +The function mfix +dictates how the required recursion operation should be performed. If recursive bindings are required for a monad, +then that monad must be declared an instance of the MonadFix class. +For details, see the above mentioned reference. + + +The following instances of MonadFix are automatically provided: List, Maybe, IO, and +state monads (both lazy and strict). + + +There are three important points in using the recursive-do notation: + + +The recursive version of the do-notation uses the keyword mdo (rather +than do). + + + +If you want to declare an instance of the MonadFix class for one of +your own monads, or you need to refer to the class name MonadFix in any other way (for +instance when writing a type constraint), then your program should +import Control.Monad.MonadFix. +Otherwise, you don't need to import any special libraries to use the mdo-notation. That is, +as long as you only use the predefined instances mentioned above, the mdo-notation will +be automatically available. +To be on the safe side, of course, you can simply import it in all cases. + + + +As with other extensions, ghc should be given the flag -fglasgow-exts + + + + + +Historical note: The old implementation of the mdo-notation (and most +of the existing documents) used the name +MonadRec for the class and the corresponding library. +This name is no longer supported. + + + +The web page: http://www.cse.ogi.edu/PacSoft/projects/rmb +contains up to date information on recursive monadic bindings. + + + + + + + + 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. + + + + +Rebindable syntax + + + GHC allows most kinds of built-in syntax to be rebound by + the user, to facilitate replacing the Prelude + with a home-grown version, for example. + + You may want to define your own numeric class + hierarchy. It completely defeats that purpose if the + literal "1" means "Prelude.fromInteger + 1", which is what the Haskell Report specifies. + So the flag causes + the following pieces of built-in syntax to refer to + whatever is in scope, not the Prelude + versions: + + + + Integer and fractional literals mean + "fromInteger 1" and + "fromRational 3.2", not the + Prelude-qualified versions; both in expressions and in + patterns. + However, the standard Prelude Eq class + is still used for the equality test necessary for literal patterns. + + + + Negation (e.g. "- (f x)") + means "negate (f x)" (not + Prelude.negate). + + + + In an n+k pattern, the standard Prelude + Ord class is still used for comparison, + but the necessary subtraction uses whatever + "(-)" is in scope (not + "Prelude.(-)"). + + + + "Do" notation is translated using whatever + functions (>>=), + (>>), fail, and + return, are in scope (not the Prelude + versions). List comprehensions, and parallel array + comprehensions, are unaffected. + + + Be warned: this is an experimental facility, with fewer checks than + usual. In particular, it is essential that the functions GHC finds in scope + must have the appropriate types, namely: + + fromInteger :: forall a. (...) => Integer -> a + fromRational :: forall a. (...) => Rational -> a + negate :: forall a. (...) => a -> a + (-) :: forall a. (...) => a -> a -> a + (>>=) :: forall m a. (...) => m a -> (a -> m b) -> m b + (>>) :: forall m a. (...) => m a -> m b -> m b + return :: forall m a. (...) => a -> m a + fail :: forall m a. (...) => String -> m a + + (The (...) part can be any context including the empty context; that part + is up to you.) + If the functions don't have the right type, very peculiar things may + happen. Use -dcore-lint to + typecheck the desugared program. If Core Lint is happy you should be all right. + + + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2757 + +Generalised derived instances for newtypes hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2760 - - - + +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 hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2768 - + + newtype Dollars = Dollars Int + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2772 - -Assertions -<indexterm><primary>Assertions</primary></indexterm> - +and you want to use arithmetic on Dollars, you have to +explicitly define an instance of Num: hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2775 - -If you want to make use of assertions in your standard Haskell code, you -could define a function like the following: + + 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! hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2787 + + Generalising the deriving clause hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2790 +GHC now permits such instances to be derived instead, so one can write + + newtype Dollars = Dollars Int deriving (Eq,Show,Num) + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2795 - -assert :: Bool -> a -> a -assert False x = error "assertion failed!" -assert _ x = x - +and the implementation uses the same Num dictionary +for Dollars as for Int. Notionally, the compiler +derives an instance declaration of the form hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2799 - + + instance Num Int => Num Dollars + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2803 - -which works, but gives you back a less than useful error message -- -an assertion failed, but which and where? +which just adds or removes the newtype constructor according to the type. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2805 - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2806 -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. - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2807 - -Ghc offers a helping hand here, doing all of this for you. For every -use of assert in the user's source: - +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 hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2811 - + + 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 + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2820 - -kelvinToC :: Double -> Double -kelvinToC k = assert (k >= 0.0) (k+273.15) +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 hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2828 +In this case the derived instance declaration is of the form + + instance Monad (State [tok] (Failure m)) => Monad (Parser tok m) + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2833 +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. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2839 - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2840 -Ghc will rewrite this to also include the source location where the -assertion was made, - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2841 - +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 hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2846 - -assert pred val ==> assertError "Main.hs|15" pred val + + 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]) hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2856 - +The derived instance is obtained by completing the application of the +class to the new type: hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2859 - -The rewrite is only performed by the compiler when it spots -applications of Control.Exception.assert, so you -can still define and use your own versions of -assert, should you so wish. If not, import -Control.Exception to make use -assert in your code. + + instance StateMonad [tok] (State [tok] (Failure m)) => + StateMonad [tok] (Parser tok m) + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2864 - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2865 -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. + +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. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2872 + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2874 + A more precise specification hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2876 -Assertion failures can be caught, see the documentation for the -Control.Exception library for the details. +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. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2896 + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2898 - +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) + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2907 +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. + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2915 - -Syntactic extensions +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 hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2919 - + + class StateMonad m s | m -> s where ... + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2923 - - Hierarchical Modules +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. + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2930 - GHC supports a small extension to the syntax of module - names: a module name is allowed to contain a dot - ‘.’. This is also known as the - “hierarchical module namespace” extension, because - it extends the normally flat Haskell module namespace into a - more flexible hierarchy of modules. + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2932 - This extension has very little impact on the language - itself; modules names are always fully - qualified, so you can just think of the fully qualified module - name as the module name. In particular, this - means that the full module name must be given after the - module keyword at the beginning of the - module; for example, the module A.B.C must - begin hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2933 -module A.B.C + + + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2938 + +Template Haskell hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2941 - It is a common strategy to use the as - keyword to save some typing when using qualified names with - hierarchical modules. For example: +Template Haskell allows you to do compile-time meta-programming in Haskell. The background +the main technical innovations are discussed in " +Template Meta-programming for Haskell", in +Proc Haskell Workshop 2002. + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2948 - -import qualified Control.Monad.ST.Strict as ST - + +The documentation here describes the realisation in GHC. (It's rather sketchy just now; +Tim Sheard is going to expand it.) + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2953 - Hierarchical modules have an impact on the way that GHC - searches for files. For a description, see . + Using Template Haskell + + Template Haskell has the following new syntactic constructions. You need to use the flag + -fglasgow-exts to switch these syntactic extensions on. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2958 - GHC comes with a large collection of libraries arranged - hierarchically; see the accompanying library documentation. - There is an ongoing project to create and maintain a stable set - of core libraries used by several Haskell - compilers, and the libraries that GHC comes with represent the - current status of that project. For more details, see Haskell - Libraries. + + + A splice is written $x, where x is an + identifier, or $(...), where the "..." is an arbitrary expression. + There must be no space between the "$" and the identifier or parenthesis. This use + of "$" overrides its meaning as an infix operator, just as "M.x" overrides the meaning + of "." as an infix operator. If you want the infix operator, put spaces around it. + + A splice can occur in place of + + an expression; + a list of top-level declarations; + a pattern; + a type; + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2975 - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2976 - + + A expression quotation is written in Oxford brackets, thus: + + [| ... |], where the "..." is an expression; + [d| ... |], where the "..." is a list of top-level declarations; + [p| ... |], where the "..." is a pattern; + [t| ... |], where the "..." is a type; + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2985 - -Pattern guards + + Reification is written thus: + + reifyDecl T, where T is a type constructor; this expression + has type Dec. + reifyDecl C, where C is a class; has type Dec. + reifyType f, where f is an identifier; has type Typ. + Still to come: fixities + + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 2997 - -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.) + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3000 + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3002 + Using Template Haskell hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3004 -Suppose we have an abstract data type of finite maps, with a -lookup operation: - - -lookup :: FiniteMap -> Int -> Maybe Int - + + + The data types and monadic constructor functions for Template Haskell are in the library + Language.Haskell.THSyntax. + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3010 -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: - + + If the module contains any top-level splices that must be run, you must use GHC with + --make or --interactive flags. (Reason: that + means it walks the dependency tree and knows what modules must be linked etc.) + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3016 - -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 - + + You can only run a function at compile time if it is imported from another module. That is, + you can't define a function in a module, and call it from within a splice in the same module. + (It would make sense to do so, but it's hard to implement.) + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3022 - -The auxiliary functions are + + The flag -ddump-splices shows the expansion of all top-level splices as they happen. + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3027 + + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3031 - -maybeToBool :: Maybe a -> Bool -maybeToBool (Just x) = True -maybeToBool Nothing = False + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3033 -expectJust :: Maybe a -> a -expectJust (Just x) = x -expectJust Nothing = error "Unexpected Nothing" - + +Assertions +<indexterm><primary>Assertions</primary></indexterm> + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3039 -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. +If you want to make use of assertions in your standard Haskell code, you +could define a function like the following: hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3044 -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: - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3046 -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 +assert :: Bool -> a -> a +assert False x = error "assertion failed!" +assert _ x = x hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3051 - -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. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3054 -Here is how I would write clunky: +which works, but gives you back a less than useful error message -- +an assertion failed, but which and where? hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3058 - -clunky env var1 var1 - | Just val1 <- lookup env var1 - , Just val2 <- lookup env var2 - = val1 + val2 -...other equations for clunky... - - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3059 -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. +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. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3066 -Just as with list comprehensions, boolean expressions can be freely mixed -with among the pattern guards. For example: +Ghc offers a helping hand here, doing all of this for you. For every +use of assert in the user's source: hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3070 + + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3073 -f x | [y] <- x - , y > 3 - , Just z <- h y - = ... +kelvinToC :: Double -> Double +kelvinToC k = assert (k >= 0.0) (k+273.15) hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3077 - -Haskell's current guards therefore emerge as a special case, in which the -qualifier list has just one element, a boolean expression. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3078 - - - - - -The recursive do-notation - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3079 - The recursive do-notation (also known as mdo-notation) is implemented as described in -"A recursive do for Haskell", -Levent Erkok, John Launchbury", -Haskell Workshop 2002, pages: 29-37. Pittsburgh, Pennsylvania. - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3080 -The do-notation of Haskell 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. It turns out that several applications can benefit from recursive bindings in -the do-notation, and this extension provides the necessary syntactic support. - - -Here is a simple (yet contrived) example: - - -justOnes = mdo xs <- Just (1:xs) - return xs - - -As you can guess justOnes will evaluate to Just [1,1,1,.... +Ghc will rewrite this to also include the source location where the +assertion was made, hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3085 -The Control.Monad.Fix library introduces the MonadFix class. It's definition is: - + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3087 -class Monad m => MonadFix m where - mfix :: (a -> m a) -> m a +assert pred val ==> assertError "Main.hs|15" pred val hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3089 - -The function mfix -dictates how the required recursion operation should be performed. If recursive bindings are required for a monad, -then that monad must be declared an instance of the MonadFix class. -For details, see the above mentioned reference. - - -The following instances of MonadFix are automatically provided: List, Maybe, IO, and -state monads (both lazy and strict). - - -There are three important points in using the recursive-do notation: - - -The recursive version of the do-notation uses the keyword mdo (rather -than do). - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3090 - -If you want to declare an instance of the MonadFix class for one of -your own monads, or you need to refer to the class name MonadFix in any other way (for -instance when writing a type constraint), then your program should -import Control.Monad.MonadFix. -Otherwise, you don't need to import any special libraries to use the mdo-notation. That is, -as long as you only use the predefined instances mentioned above, the mdo-notation will -be automatically available. -To be on the safe side, of course, you can simply import it in all cases. - - - -As with other extensions, ghc should be given the flag -fglasgow-exts - - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3093 -Historical note: The old implementation of the mdo-notation (and most -of the existing documents) used the name -MonadRec for the class and the corresponding library. -This name is no longer supported. +The rewrite is only performed by the compiler when it spots +applications of Control.Exception.assert, so you +can still define and use your own versions of +assert, should you so wish. If not, import +Control.Exception to make use +assert in your code. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3102 -The web page: http://www.cse.ogi.edu/PacSoft/projects/rmb -contains up to date information on recursive monadic bindings. +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. hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3109 - - - - - - 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. - - - - -Rebindable syntax - - - GHC allows most kinds of built-in syntax to be rebound by - the user, to facilitate replacing the Prelude - with a home-grown version, for example. - - You may want to define your own numeric class - hierarchy. It completely defeats that purpose if the - literal "1" means "Prelude.fromInteger - 1", which is what the Haskell Report specifies. - So the flag causes - the following pieces of built-in syntax to refer to - whatever is in scope, not the Prelude - versions: - - - - Integer and fractional literals mean - "fromInteger 1" and - "fromRational 3.2", not the - Prelude-qualified versions; both in expressions and in - patterns. - However, the standard Prelude Eq class - is still used for the equality test necessary for literal patterns. - - - - Negation (e.g. "- (f x)") - means "negate (f x)" (not - Prelude.negate). - - - - In an n+k pattern, the standard Prelude - Ord class is still used for comparison, - but the necessary subtraction uses whatever - "(-)" is in scope (not - "Prelude.(-)"). - - - - "Do" notation is translated using whatever - functions (>>=), - (>>), fail, and - return, are in scope (not the Prelude - versions). List comprehensions, and parallel array - comprehensions, are unaffected. - - - Be warned: this is an experimental facility, with fewer checks than - usual. In particular, it is essential that the functions GHC finds in scope - must have the appropriate types, namely: - - fromInteger :: forall a. (...) => Integer -> a - fromRational :: forall a. (...) => Rational -> a - negate :: forall a. (...) => a -> a - (-) :: forall a. (...) => a -> a -> a - (>>=) :: forall m a. (...) => m a -> (a -> m b) -> m b - (>>) :: forall m a. (...) => m a -> m b -> m b - return :: forall m a. (...) => a -> m a - fail :: forall m a. (...) => String -> m a - - (The (...) part can be any context including the empty context; that part - is up to you.) - If the functions don't have the right type, very peculiar things may - happen. Use -dcore-lint to - typecheck the desugared program. If Core Lint is happy you should be all right. + +Assertion failures can be caught, see the documentation for the +Control.Exception library for the details. + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3114 - hunk ./ghc/docs/users_guide/glasgow_exts.sgml 3116 + hunk ./ghc/docs/users_guide/glasgow_exts.sgml 4215 - - - -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. - - - }