X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdocs%2Fusers_guide%2Fglasgow_exts.sgml;h=1c42f5d1c6945dd331f8d1c1dacf2e72cfccd7fa;hb=2dfd507259664e6f28df4a9467a8de34d01d70a0;hp=db91ac0e6ca9706c4829651fe78488b30e6e836c;hpb=32c4b4b2e71ab2f44a567addefb40f3d4b0fecb8;p=ghc-hetmet.git diff --git a/ghc/docs/users_guide/glasgow_exts.sgml b/ghc/docs/users_guide/glasgow_exts.sgml index db91ac0..1c42f5d 100644 --- a/ghc/docs/users_guide/glasgow_exts.sgml +++ b/ghc/docs/users_guide/glasgow_exts.sgml @@ -2,17 +2,19 @@ language, GHC extensions, GHC As with all known Haskell systems, GHC implements some extensions to -the language. To use them, you'll need to give a --fglasgow-exts option option. +the language. They are all enabled by options; by default GHC +understands only plain Haskell 98. -Virtually all of the Glasgow extensions serve to give you access to -the underlying facilities with which we implement Haskell. Thus, you -can get at the Raw Iron, if you are willing to write some non-standard -code at a more primitive level. You need not be “stuck” on -performance because of the implementation costs of Haskell's -“high-level” features—you can always code “under” them. In an extreme case, you can write all your time-critical code in C, and then just glue it together with Haskell! +Some of the Glasgow extensions serve to give you access to the +underlying facilities with which we implement Haskell. Thus, you can +get at the Raw Iron, if you are willing to write some non-portable +code at a more primitive level. You need not be “stuck” +on performance because of the implementation costs of Haskell's +“high-level” features—you can always code +“under” them. In an extreme case, you can write all your +time-critical code in C, and then just glue it together with Haskell! @@ -20,8 +22,8 @@ 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 “Haskellised veneer” over the features you want. The -separate libraries documentation describes all the libraries that come -with GHC. +separate libraries +documentation describes all the libraries that come with GHC. @@ -35,10 +37,38 @@ with GHC. extensionsoptions controlling - These flags control what variation of the language are + These flags control what variation of the language are permitted. Leaving out all of them gives you standard Haskell 98. + NB. turning on an option that enables special syntax + might cause working Haskell 98 code to fail + to compile, perhaps because it uses a variable name which has + become a reserved word. So, together with each option below, we + list the special syntax which is enabled by this option. We use + notation and nonterminal names from the Haskell 98 lexical syntax + (see the Haskell 98 Report). There are two classes of special + syntax: + + + + New reserved words and symbols: character sequences + which are no longer available for use as identifiers in the + program. + + + Other special syntax: sequences of characters that have + a different meaning when this particular option is turned + on. + + + + We are only listing syntax changes here that might affect + existing working programs (i.e. "stolen" syntax). Many of these + extensions will also enable new context-free syntax, but in all + cases programs written to use the new syntax would not be + compilable without the option enabled. + @@ -47,8 +77,21 @@ with GHC. This simultaneously enables all of the extensions to Haskell 98 described in , except where otherwise + linkend="ghc-language-features"/>, except where otherwise noted. + + New reserved words: forall (only in + types), mdo. + + Other syntax stolen: + varid{#}, + char#, + string#, + integer#, + float#, + float##, + (#, #), + |), {|. @@ -61,6 +104,8 @@ with GHC. Haskell 98 Foreign Function Interface Addendum plus deprecated syntax of previous versions of the FFI for backwards compatibility. + + New reserved words: foreign. @@ -83,7 +128,7 @@ with GHC. - See . Only relevant + See . Only relevant if you also use . @@ -92,7 +137,7 @@ with GHC. - See . Only relevant if + See . Only relevant if you also use . @@ -101,8 +146,16 @@ with GHC. - See . Independent of + See . Independent of . + + New reserved words/symbols: rec, + proc, -<, + >-, -<<, + >>-. + + Other syntax stolen: (|, + |). @@ -110,7 +163,7 @@ with GHC. - See . Independent of + See . Independent of . @@ -139,7 +192,7 @@ with GHC. However, does change the handling of certain built-in syntax: see . + linkend="rebindable-syntax"/>. @@ -147,8 +200,14 @@ with GHC. Enables Template Haskell (see ). Currently also implied by + linkend="template-haskell"/>). Currently also implied by . + + Syntax stolen: [|, + [e|, [p|, + [d|, [t|, + $(, + $varid. @@ -156,8 +215,12 @@ with GHC. Enables implicit parameters (see ). Currently also implied by + linkend="implicit-parameters"/>). Currently also implied by . + + Syntax stolen: + ?varid, + %varid. @@ -422,7 +485,7 @@ import qualified Control.Monad.ST.Strict as ST For details on how GHC searches for source and interface files in the presence of hierarchical modules, see . + linkend="search-path"/>. GHC comes with a large collection of libraries arranged hierarchically; see the accompanying library documentation. @@ -442,7 +505,7 @@ import qualified Control.Monad.ST.Strict as ST 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.) +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.) @@ -454,11 +517,11 @@ 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: +where v is the value that the key maps to. Now consider the following definition: -clunky env var1 var2 | ok1 && ok2 = val1 + val2 +clunky env var1 var2 | ok1 && ok2 = val1 + val2 | otherwise = var1 + var2 where m1 = lookup env var1 @@ -484,12 +547,12 @@ expectJust Nothing = error "Unexpected Nothing" -What is clunky doing? The guard ok1 && +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 +returned values to val1 and val2 respectively. If either lookup fails, then clunky takes the otherwise case and returns the sum of its arguments. @@ -552,9 +615,9 @@ with among the pattern guards. For example: -f x | [y] <- x +f x | [y] <- x , y > 3 - , Just z <- h y + , Just z <- h y = ... @@ -588,7 +651,7 @@ Here is a simple (yet contrived) example: import Control.Monad.Fix -justOnes = mdo xs <- Just (1:xs) +justOnes = mdo xs <- Just (1:xs) return xs @@ -668,7 +731,7 @@ This name is not supported by GHC. example, the following zips together two lists: - [ (x, y) | x <- xs | y <- ys ] + [ (x, y) | x <- xs | y <- ys ] The behavior of parallel list comprehensions follows that of @@ -681,8 +744,8 @@ This name is not supported by GHC. Given a parallel comprehension of the form: - [ e | p1 <- e11, p2 <- e12, ... - | q1 <- e21, q2 <- e22, ... + [ e | p1 <- e11, p2 <- e12, ... + | q1 <- e21, q2 <- e22, ... ... ] @@ -690,8 +753,8 @@ This name is not supported by GHC. This will be translated to: - [ e | ((p1,p2), (q1,q2), ...) <- zipN [(p1,p2) | p1 <- e11, p2 <- e12, ...] - [(q1,q2) | q1 <- e21, q2 <- e22, ...] + [ e | ((p1,p2), (q1,q2), ...) <- zipN [(p1,p2) | p1 <- e11, p2 <- e12, ...] + [(q1,q2) | q1 <- e21, q2 <- e22, ...] ... ] @@ -797,7 +860,7 @@ a data type with no constructors. For example: Syntactically, the declaration lacks the "= constrs" part. The type can be parameterised over types of any kind, but if the kind is not * then an explicit kind annotation must be used -(see ). +(see ). Such data types have only one value, namely bottom. Nevertheless, they can be useful when defining "phantom types". @@ -957,7 +1020,7 @@ because GHC does not allow unboxed tuples on the left of a function arrow. The idea of using existential quantification in data type declarations was suggested by Laufer (I believe, thought doubtless someone will correct me), and implemented in Hope+. It's been in Lennart -Augustsson's hbc Haskell compiler for several years, and +Augustsson's hbc Haskell compiler for several years, and proved very useful. Here's the idea. Consider the declaration: @@ -1068,7 +1131,7 @@ adding a new existential quantification construct. Type classes -An easy extension (implemented in hbc) is to allow +An easy extension (implemented in hbc) is to allow arbitrary contexts before the constructor. For example: @@ -1266,7 +1329,7 @@ instance Eq T where (MkT a) == (MkT b) = ??? -But a and b have distinct types, and so can't be compared. +But a and b have distinct types, and so can't be compared. It's just about possible to imagine examples in which the derived instance would make sense, but it seems altogether simpler simply to prohibit such declarations. Define your own instances! @@ -1289,14 +1352,14 @@ declarations. Define your own instances! This section documents GHC's implementation of multi-parameter type -classes. There's lots of background in the paper Type -classes: exploring the design space (Simon Peyton Jones, Mark +classes: exploring the design space (Simon Peyton Jones, Mark Jones, Erik Meijer). There are the following constraints on class declarations: - + @@ -1360,7 +1423,7 @@ be acyclic. So these class declarations are OK: All of the class type variables must be reachable (in the sense -mentioned in ) +mentioned in ) from the free varibles of each method type . For example: @@ -1405,7 +1468,7 @@ class like this: - + @@ -1456,24 +1519,24 @@ Consider the type: language omits them; in Haskell 98, all the free type variables of an explicit source-language type signature are universally quantified, except for the class type variables in a class declaration. However, -in GHC, you can give the foralls if you want. See ). +in GHC, you can give the foralls if you want. See ). - + Each universally quantified type variable tvi must be reachable from type. -A type variable is "reachable" if it it is functionally dependent -(see ) -on the type variables free in type. -The reason for this is that a value with a type that does not obey -this restriction could not be used without introducing -ambiguity. +A type variable a is "reachable" if it it appears +in the same constraint as either a type variable free in in +type, or another reachable type variable. +A value with a type that does not obey +this reachability restriction cannot be used without introducing +ambiguity; that is why the type is rejected. Here, for example, is an illegal type: @@ -1488,7 +1551,23 @@ would be introduced where tv is a fresh type variable, and applied to a dictionary for Eq tv. The difficulty is that we can never know which instance of Eq to use because we never get any more information about tv. - + + +Note +that the reachability condition is weaker than saying that a is +functionally dependendent on a type variable free in +type (see ). The reason for this is there +might be a "hidden" dependency, in a superclass perhaps. So +"reachable" is a conservative approximation to "functionally dependent". +For example, consider: + + class C a b | a -> b where ... + class C a b => D a b where ... + f :: forall a b. D a b => a -> a + +This is fine, because in fact a does functionally determine b +but that is not immediately apparent from f's type. @@ -1525,7 +1604,7 @@ territory free in case we need it later. - + @@ -1533,7 +1612,7 @@ territory free in case we need it later. For-all hoisting -It is often convenient to use generalised type synonyms (see ) at the right hand +It is often convenient to use generalised type synonyms (see ) at the right hand end of an arrow, thus: type Discard a = forall b. a -> b -> a @@ -1598,7 +1677,7 @@ declarations "overlap" if type1 and type2 unify. - + However, if you give the command line option -fallow-overlapping-instances @@ -1765,7 +1844,7 @@ instance C Int b => Foo b where ... is not OK. - + These restrictions ensure that context reduction terminates: each reduction step removes one type constructor. For example, the following would make the type checker @@ -1950,7 +2029,7 @@ For example, we define the min function by binding cmp. min :: [a] -> a - min = let ?cmp = (<=) in least + min = let ?cmp = (<=) in least @@ -2199,10 +2278,10 @@ 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. @@ -2211,21 +2290,21 @@ GHC now instead allows you to specify the kind of a type variable directly, wher 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 - + @@ -2239,14 +2318,14 @@ 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. @@ -2307,12 +2386,12 @@ 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 ) + 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 above would be valid field type signatures. As the type of an implicit parameter - In a pattern type signature (see ) + 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 @@ -2478,7 +2557,7 @@ 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: +(), thus: \ f :: (forall a. a->a) -> (f True, f 'c') @@ -2580,23 +2659,23 @@ f (xs::[a]) = ys ++ ys -The pattern (xs::[a]) includes a type signature for xs. +The pattern (xs::[a]) includes a type signature for xs. This brings the type variable a into scope; it scopes over all the patterns and right hand sides for this equation for f. -In particular, it is in scope at the type signature for y. +In particular, it is in scope at the type signature for y. Pattern type signatures are completely orthogonal to ordinary, separate type signatures. The two can be used independently or together. -At ordinary type signatures, such as that for ys, any type variables +At ordinary type signatures, such as that for ys, any type variables mentioned in the type signature that are not in scope are implicitly universally quantified. (If there are no type variables in scope, all type variables mentioned in the signature are universally -quantified, which is just as in Haskell 98.) In this case, since a -is in scope, it is not universally quantified, so the type of ys is -the same as that of xs. In Haskell 98 it is not possible to declare -a type for ys; a major benefit of scoped type variables is that +quantified, which is just as in Haskell 98.) In this case, since a +is in scope, it is not universally quantified, so the type of ys is +the same as that of xs. In Haskell 98 it is not possible to declare +a type for ys; a major benefit of scoped type variables is that it becomes possible to do so. @@ -2683,9 +2762,9 @@ The type variable(s) bound by the pattern have the same scope as the term variable(s) bound by the pattern. For example: let - f (x::a) = <...rhs of f...> + f (x::a) = <...rhs of f...> (p::b, q::b) = (1,2) - in <...body of let...> + in <...body of let...> Here, the type variable a scopes over the right hand side of f, just like x does; while the type variable b scopes over the @@ -2725,7 +2804,7 @@ into scope (except in the type signature itself!). So this is illegal: f x = x::a -It's illegal because a is not in scope in the body of f, +It's illegal because a is not in scope in the body of f, so the ordinary signature x::a is equivalent to x::forall a.a; and that is an incorrect typing. @@ -3184,6 +3263,12 @@ the background to the main technical innovations is discussed in " Template Meta-programming for Haskell" (Proc Haskell Workshop 2002). +The details of the Template Haskell design are still in flux. Make sure you +consult the online library reference material +(search for the type ExpQ). +[Temporary: many changes to the original design are described in + "http://research.microsoft.com/~simonpj/tmp/notes2.ps". +Not all of these changes are in GHC 6.2.] The first example from that paper is set out below as a worked example to help get you started. @@ -3289,6 +3374,7 @@ Tim Sheard is going to expand it.) First cut and paste the two modules below into "Main.hs" and "Printf.hs": + {- Main.hs -} module Main where @@ -3299,9 +3385,8 @@ import Printf ( pr ) -- generated at compile time by "pr" and splices it into -- the argument of "putStrLn". main = putStrLn ( $(pr "Hello") ) - - + {- Printf.hs -} module Printf where @@ -3310,7 +3395,7 @@ module Printf where -- you intend to use it. -- Import some Template Haskell syntax -import Language.Haskell.THSyntax +import Language.Haskell.TH.Syntax -- Describe a format string data Format = D | S | L String @@ -3324,14 +3409,14 @@ parse s = [ L s ] -- Generate Haskell source code from a parsed representation -- of the format string. This code will be spliced into -- the module which calls "pr", at compile time. -gen :: [Format] -> Expr +gen :: [Format] -> ExpQ gen [D] = [| \n -> show n |] gen [S] = [| \s -> s |] -gen [L s] = string s +gen [L s] = stringE s -- Here we generate the Haskell code for the splice -- from an input format string. -pr :: String -> Expr +pr :: String -> ExpQ pr s = gen (parse s) @@ -3394,35 +3479,50 @@ What follows is a brief introduction to the notation; it won't make much sense unless you've read Hughes's paper. This notation is translated to ordinary Haskell, using combinators from the -Control.Arrow +Control.Arrow module. -The extension adds a new kind of expression for defining arrows, -of the form proc pat -> cmd, +The extension adds a new kind of expression for defining arrows: + +exp10 ::= ... + | proc apat -> cmd + where proc is a new keyword. The variables of the pattern are bound in the body of the proc-expression, which is a new sort of thing called a command. The syntax of commands is as follows: -cmd ::= exp1 -< exp2 - | exp1 -<< exp2 - | do { cstmt1 .. cstmtn ; cmd } - | let decls in cmd - | if exp then cmd1 else cmd2 - | case exp of { calts } - | cmd1 qop cmd2 - | (| aexp cmd1 .. cmdn |) - | \ pat1 .. patn -> cmd - | cmd aexp - | ( cmd ) - -cstmt ::= let decls - | pat <- cmd - | rec { cstmt1 .. cstmtn } - | cmd +cmd ::= exp10 -< exp + | exp10 -<< exp + | cmd0 + +with cmd0 up to +cmd9 defined using +infix operators as for expressions, and + +cmd10 ::= \ apat ... apat -> cmd + | let decls in cmd + | if exp then cmd else cmd + | case exp of { calts } + | do { cstmt ; ... cstmt ; cmd } + | fcmd + +fcmd ::= fcmd aexp + | ( cmd ) + | (| aexp cmd ... cmd |) + +cstmt ::= let decls + | pat <- cmd + | rec { cstmt ; ... cstmt [;] } + | cmd +where calts are like alts +except that the bodies are commands instead of expressions. + + + Commands produce values, but (like monadic computations) may yield more than one value, or none, and may do other things as well. @@ -3507,7 +3607,7 @@ arr (\ x -> (x, x)) >>> returnA Note that variables not used later in the composition are projected out. -After simplification using rewrite rules (see ) +After simplification using rewrite rules (see ) defined in the Control.Arrow module, this reduces to @@ -3607,7 +3707,7 @@ ArrowChoice a => (<+>) :: a e c -> a e c -> a e c so we can use it to build commands: -expr' = proc x -> +expr' = proc x -> do returnA -< x <+> do symbol Plus -< () @@ -3618,6 +3718,9 @@ expr' = proc x -> y <- term -< () expr' -< x - y +(The do on the first line is needed to prevent the first +<+> ... from being interpreted as part of the +expression on the previous line.) This is equivalent to expr' = (proc x -> returnA -< x) @@ -3744,7 +3847,7 @@ though the results would be somewhat clumsy. For example, we could simulate do-notation by defining bind :: Arrow a => a e b -> a (e,b) c -> a e c -u `bind` f = returnA &&& u >>> f +u `bind` f = returnA &&& u >>> f bind_ :: Arrow a => a e b -> a e c -> a e c u `bind_` f = u `bind` (arr fst >>> f) @@ -3943,7 +4046,7 @@ Assertion failures can be caught, see the documentation for the The DEPRECATED pragma lets you specify that a particular function, class, or type, is deprecated. There are two - forms. + forms. @@ -3968,7 +4071,15 @@ Assertion failures can be caught, see the documentation for the message. - + Any use of the deprecated item, or of anything from a deprecated + module, will be flagged with an appropriate message. However, + deprecations are not reported for + (a) uses of a deprecated function within its defining module, and + (b) uses of a deprecated function in an export list. + The latter reduces spurious complaints within a library + in which one module gathers together and re-exports + the exports of several others. + You can suppress the warnings with the flag . @@ -4031,7 +4142,7 @@ key_function :: Int -> String -> (Bool, Double) See also the NOINLINE pragma (). + linkend="noinline-pragma"/>). @@ -4120,7 +4231,7 @@ key_function :: Int -> String -> (Bool, Double) The same phase-numbering control is available for RULES - (). + (). @@ -4154,7 +4265,7 @@ key_function :: Int -> String -> (Bool, Double) The OPTIONS pragma is used to specify additional options that are given to the compiler when compiling - this source file. See for + this source file. See for details. @@ -4162,7 +4273,7 @@ key_function :: Int -> String -> (Bool, Double) RULES pragma The RULES pragma lets you specify rewrite rules. It is - described in . + described in . @@ -4192,40 +4303,20 @@ hammeredLookup :: Ord key => [(key, value)] -> key -> value A SPECIALIZE pragma for a function can be put anywhere its type signature could be put. -A SPECIALIZE has the effect of generating (a) a specialised -version of the function and (b) a rewrite rule (see ) that -rewrites a call to the un-specialised function into a call to the specialised -one. You can, instead, provide your own specialised function and your own rewrite rule. -For example, suppose that: - - genericLookup :: Ord a => Table a b -> a -> b - intLookup :: Table Int b -> Int -> b - -where intLookup is an implementation of genericLookup -that works very fast for keys of type Int. Then you can write the rule - - {-# RULES "intLookup" genericLookup = intLookup #-} - -(see ). It is Your - Responsibility to make sure that - intLookup really behaves as a specialised - version of genericLookup!!! + A SPECIALIZE has the effect of generating + (a) a specialised version of the function and (b) a rewrite rule + (see ) that rewrites a call to the + un-specialised function into a call to the specialised one. - An example in which using RULES for - specialisation will Win Big: + In earlier versions of GHC, it was possible to provide your own + specialised function for a given type: - toDouble :: Real a => a -> Double - toDouble = fromRational . toRational - - {-# RULES "toDouble/Int" toDouble = i2d #-} - i2d (I# i) = D# (int2Double# i) -- uses Glasgow prim-op directly +{-# SPECIALIZE hammeredLookup :: [(Int, value)] -> Int -> value = intLookup #-} - The i2d function is virtually one machine - instruction; the default conversion—via an intermediate - Rational—is obscenely expensive by - comparison. + This feature has been removed, as it is now subsumed by the + RULES pragma (see ). @@ -4264,14 +4355,14 @@ of the pragma. the constructor itself, removing a level of indirection. For example: - + data T = T {-# UNPACK #-} !Float {-# UNPACK #-} !Float - + will create a constructor T containing two unboxed floats. This may not always be an optimisation: if - the T constructor is scrutinised and the + the T constructor is scrutinised and the floats passed to a non-strict function for example, they will have to be reboxed (this is done automatically by the compiler). @@ -4281,33 +4372,33 @@ data T = T {-# UNPACK #-} !Float unfoldings to the compiler so the reboxing can be removed as often as possible. For example: - + f :: T -> Float f (T f1 f2) = f1 + f2 - + - The compiler will avoid reboxing f1 - and f2 by inlining + + The compiler will avoid reboxing f1 + and f2 by inlining + on floats, but only when is on. Any single-constructor data is eligible for unpacking; for example - + data T = T {-# UNPACK #-} !(Int,Int) - + will store the two Ints directly in the - T constructor, by flattening the pair. + T constructor, by flattening the pair. Multi-level unpacking is also supported: - + data T = T {-# UNPACK #-} !S data S = S {-# UNPACK #-} !Int {-# UNPACK #-} !Int - + will store two unboxed Int#s - directly in the T constructor. The + directly in the T constructor. The unpacker can see through newtypes, too. If a field cannot be unpacked, you will not get a warning, @@ -4334,9 +4425,9 @@ data S = S {-# UNPACK #-} !Int {-# UNPACK #-} !Int The programmer can specify rewrite rules as part of the source program (in a pragma). GHC applies these rewrite rules wherever it can, provided (a) -the flag () is on, +the flag () is on, and (b) the flag -() is not specified. +() is not specified. @@ -4374,7 +4465,7 @@ no significance at all. It is only used when reporting how many times the rule -A rule may optionally have a phase-control number (see ), +A rule may optionally have a phase-control number (see ), immediately after the name of the rule. Thus: {-# RULES @@ -4532,7 +4623,7 @@ But not beta conversion (that's called higher-order matching). Matching is carried out on GHC's intermediate language, which includes type abstractions and applications. So a rule only matches if the -types match too. See below. +types match too. See below. @@ -4549,8 +4640,8 @@ For example, consider: The expression s (t xs) does not match the rule "map/map", but GHC -will substitute for s and t, giving an expression which does match. -If s or t was (a) used more than once, and (b) large or a redex, then it would +will substitute for s and t, giving an expression which does match. +If s or t was (a) used more than once, and (b) large or a redex, then it would not be substituted, and the rule would not fire. @@ -4811,43 +4902,62 @@ Prelude definitions of the above functions to see how to do so. Rewrite rules can be used to get the same effect as a feature -present in earlier version of GHC: +present in earlier versions of GHC. +For example, suppose that: - {-# SPECIALIZE fromIntegral :: Int8 -> Int16 = int8ToInt16 #-} +genericLookup :: Ord a => Table a b -> a -> b +intLookup :: Table Int b -> Int -> b -This told GHC to use int8ToInt16 instead of fromIntegral whenever -the latter was called with type Int8 -> Int16. That is, rather than -specialising the original definition of fromIntegral the programmer is -promising that it is safe to use int8ToInt16 instead. - - - -This feature is no longer in GHC. But rewrite rules let you do the -same thing: +where intLookup is an implementation of +genericLookup that works very fast for +keys of type Int. You might wish +to tell GHC to use intLookup instead of +genericLookup whenever the latter was called with +type Table Int b -> Int -> b. +It used to be possible to write -{-# RULES - "fromIntegral/Int8/Int16" fromIntegral = int8ToInt16 -#-} +{-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} -This slightly odd-looking rule instructs GHC to replace fromIntegral -by int8ToInt16 whenever the types match. Speaking more operationally, -GHC adds the type and dictionary applications to get the typed rule +This feature is no longer in GHC, but rewrite rules let you do the same thing: -forall (d1::Integral Int8) (d2::Num Int16) . - fromIntegral Int8 Int16 d1 d2 = int8ToInt16 +{-# RULES "genericLookup/Int" genericLookup = intLookup #-} -What is more, -this rule does not need to be in the same file as fromIntegral, -unlike the SPECIALISE pragmas which currently do (so that they +This slightly odd-looking rule instructs GHC to replace +genericLookup by intLookup +whenever the types match. +What is more, this rule does not need to be in the same +file as genericLookup, unlike the +SPECIALIZE pragmas which currently do (so that they have an original definition available to specialise). +It is Your Responsibility to make sure that +intLookup really behaves as a specialised version +of genericLookup!!! + +An example in which using RULES for +specialisation will Win Big: + + +toDouble :: Real a => a -> Double +toDouble = fromRational . toRational + +{-# RULES "toDouble/Int" toDouble = i2d #-} +i2d (I# i) = D# (int2Double# i) -- uses Glasgow prim-op directly + + +The i2d function is virtually one machine +instruction; the default conversion—via an intermediate +Rational—is obscenely expensive by +comparison. + + @@ -4872,7 +4982,7 @@ If you add you get a more detailed listing. - The defintion of (say) build in GHC/Base.lhs looks llike this: + The defintion of (say) build in GHC/Base.lhs looks llike this: build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] @@ -4931,7 +5041,7 @@ g x = show x However, when external for is generated (via ), there will be Notes attached to the - expressions show and x. + expressions show and x. The core function declaration for f is: @@ -4959,8 +5069,8 @@ r) -> Here, we can see that the function show (which has been expanded out to a case expression over the Show dictionary) has a %note attached to it, as does the - expression eta (which used to be called - x). + expression eta (which used to be called + x).