[More refactoring Bryan O'Sullivan **20080118235603] { addfile ./examples/ch04/BadPattern.hs addfile ./examples/ch04/Nullable.hs hunk ./examples/ch04/Wrapper.hs 1 -{-- snippet Wrapper --} -data Wrapper a = Wrapper a - deriving (Show) -{-- /snippet Wrapper --} - -{-- snippet wrappedTypes --} -wrappedInt :: Wrapper Int - -wrappedInt = Wrapper 42 - -wrappedString = Wrapper "foo" -{-- /snippet wrappedTypes --} - -{-- snippet parens --} -multiplyWrapped :: Wrapper (Wrapper Int) - -multiplyWrapped = Wrapper (Wrapper 7) -{-- /snippet parens --} - -{-- snippet unwrap --} -unwrap (Wrapper x) = x -{-- /snippet unwrap --} rmfile ./examples/ch04/Wrapper.hs addfile ./examples/ch04/badpattern.ghci addfile ./examples/ch04/nullable.ghci hunk ./en/ch04-defining-types.xml 194 - Because Vector2D and Polar2D are - distinct types, we can't accidentally mix up our - representations. + The Cartesian and polar forms represent equivalent + information using the same types for their two elements, but + using different ranges of values with distinct meanings. + Because Vector2D and Polar2D are + distinct types, Haskell will not let us accidentally mix up + these representations. hunk ./en/ch04-defining-types.xml 211 - Double) pairs, which is a valid expression. + Double) pairs, which is a valid thing to do. hunk ./en/ch04-defining-types.xml 217 - If you're building and mixing many compound values that - will have long lives and propagate widely throughout your - code, the added type safety will almost certainly pay off by - enlisting the compiler to prevent bugs. For smaller, - localised uses, such as returning multiple values from a - function and immediately consuming them, a tuple is - fine. + If you're using many similarly-structured compound values + that propagate widely throughout your code, adding type safety + will almost certainly pay off. For smaller, localised uses, + such as returning multiple values from a function and + immediately consuming them, a tuple is fine. hunk ./en/ch04-defining-types.xml 224 - bug, grows, then increasing type safety makes more sense. - Better yet, stronger typing can often add little or no cost in - either readability or performance. + bug, grows, then increasing type safety makes more sense. In + practice, Haskell's type system often imposes little or no + cost in either readability or performance. hunk ./en/ch04-defining-types.xml 242 - The struct + The structure hunk ./en/ch04-defining-types.xml 269 - The enum + The enumeration hunk ./en/ch04-defining-types.xml 310 - The union + The discriminated union hunk ./en/ch04-defining-types.xml 363 - need to be able to distinguish between cases, and to extract - values from a compound value. Haskell has a simple + need to be able to distinguish between alternatives, and to + extract elements from a compound value. Haskell has a simple hunk ./en/ch04-defining-types.xml 369 - bind variables to the values it contains. In fact, when we - define a function, the parameters that we define are already - patterns. We're just adding to our existing knowledge - here. - - Here's an example of pattern matching in action on - a list; we're going to add all elements of the list - together. + bind variables to the values it contains. Here's an example of + pattern matching in action on a list: we're going to add all + elements of the list together. hunk ./en/ch04-defining-types.xml 396 - define a function as a series of equations; so in fact these two - clauses are defining the behaviour of one function, over - different inputs. (By the way, there's already a standard - function, sum, that does this - adding-of-a-list for us. This sumList is - purely for illustration.) + define a function as a series of equations: + so in fact these two clauses are defining the behaviour of one + function, over different input values. The [] on + the left of the second equation is the constructor for an empty + list. hunk ./en/ch04-defining-types.xml 402 - The syntax for pattern matching on a tuple is similar to the - syntax for constructing a tuple. Here's a function that returns - the third element from a three-tuple. + + Ordering is important hunk ./en/ch04-defining-types.xml 405 - &Tuple.hs:third; + When applying a function, a Haskell + implementation checks patterns for matches in the order in + which we specify them in our equations. Matching proceeds from + top to bottom, and stops at the first success. + hunk ./en/ch04-defining-types.xml 411 - There's no limit on how deep within a value a - pattern can look. Here's a definition that looks both inside a - tuple and inside a list within that tuple. + As a final note, there already exists a standard function, + sum, that performs this adding-of-a-list + for us. Our sumList is purely for + illustration. hunk ./en/ch04-defining-types.xml 416 - &Tuple.hs:complicated; + + Construction and deconstruction hunk ./en/ch04-defining-types.xml 419 - We can try this out interactively. + Let's step back and take a look at the relationship + between constructing a value and pattern matching on + it. hunk ./en/ch04-defining-types.xml 423 - &tuple.ghci:complicated; + A value constructor builds a value. The expression + 'a':['b'] applies the (:) + constructor to the values 'a' and + ['b'] to produce a new compound value, the list + ['a', 'b']. hunk ./en/ch04-defining-types.xml 429 - Wherever a literal value is present in a pattern - (True and 5 in the tuple - pattern above), that value must match exactly for the pattern - match to succeed. If every pattern within a series of equations - fails to match, we get a runtime error. + When we pattern match against the (:) + constructor, we reverse the construction + process. First of all, we check to see if the value does in + fact contain that constructor. If it does, we inspect the + compound value to get the individual values that we originally + passed to the constructor when we created the value. hunk ./en/ch04-defining-types.xml 436 - &tuple.ghci:nomatch; + Let's consider what happens if we + match the pattern (x:xs) against our example + expression 'a': ['b']. hunk ./en/ch04-defining-types.xml 440 - We can pattern match on algebraic data types using their - constructors. Remember the Wrapper type we defined - earlier? Here's how we can extract a wrapped value from a - Wrapper. + + + The match will succeed, because the constructor in the + value matches the one in our pattern. + + + The variable x will be bound to + 'a'. + + + The variable xs will be bound to + ['b']. + + + + Because pattern matching acts as the inverse of + construction, it's sometimes referred to as + deconstruction. hunk ./en/ch04-defining-types.xml 459 - &Wrapper.hs:unwrap; + + Deconstruction doesn't destroy anything hunk ./en/ch04-defining-types.xml 462 - Let's see it in action. + If you're steeped in object oriented programming jargon, + don't confuse deconstruction with destruction! Matching a + pattern has no effect on the value we're examining: it just + lets us look inside it. + + hunk ./en/ch04-defining-types.xml 469 - &wrapper.ghci:unwrap; + + Further adventures hunk ./en/ch04-defining-types.xml 472 - Notice that Haskell infers the type of the - unwrap function based on the constructor - we're using in our pattern. If we're trying to match a value - whose constructor is Wrapper, then the type - of that parameter must be Wrapper a. - - And for good measure, here's how we can define functions to - access the fields of the BookSection type we defined in - . + The syntax for pattern matching on a tuple is + similar to the syntax for constructing a tuple. Here's a + function that returns the last element of a 3-tuple. hunk ./en/ch04-defining-types.xml 476 - &BookSection.hs:accessors; + &Tuple.hs:third; hunk ./en/ch04-defining-types.xml 478 - - The ordering of patterns is important + There's no limit on how deep + within a value a pattern can look. This definition looks both + inside a tuple and inside a list within that tuple. hunk ./en/ch04-defining-types.xml 482 - Haskell tests patterns for matches in the order in which - we list them in our code. It goes from top to bottom and - stops at the first match; it does not - check every pattern and use the best match. + &Tuple.hs:complicated; hunk ./en/ch04-defining-types.xml 484 - If you're familiar with pattern matching from a logic - programming language like Prolog, Haskell's facility is - simpler and less powerful. It doesn't provide backtracking or - unification. - + We can try this out interactively. + + &tuple.ghci:complicated; + + Wherever a literal value is present in a pattern + (True and 5 in the tuple + pattern above), that value must match exactly for the pattern + match to succeed. If every pattern within a series of + equations fails to match, we get a runtime error. + + &tuple.ghci:nomatch; + + For an explanation of this error message, skip forward a + little, to . + + We can pattern match on an algebraic data type + using its value constructors. Remember the + BookSection type we defined earlier? Here's how + we can extract the values from a + BookSection. + + &BookSection.hs:accessors; + + Let's see it in action. + + &booksection.ghci:unwrap; + + The compiler can infer the types of the accessor + functions based on the constructor we're using in our + pattern. hunk ./en/ch04-defining-types.xml 516 - Here are some rules of thumb to help with remembering how - pattern matching works. A constructor in a pattern - checks that the matched value has the right shape. A - literal value ensures that that portion of the value has exactly - the matching contents. And a variable makes no assertions about - either the shape or contents of the matched value; it matches anything, - and gives the variable that value. + &booksection.ghci:unwrap.types; hunk ./en/ch04-defining-types.xml 518 - So the pattern (3:xs) first of all is an - assertion that a matching value is a non-empty list, by matching - against the (:) constructor. It also - ensures that the head of the list is the literal value - 3. And whatever the tail of the list is, it - will be bound to the variable xs. + Here are some rules of thumb to help with + remembering how pattern matching works. A constructor in a + pattern checks that the matched value has the right + shape. A literal value ensures that that + portion of the value has exactly the matching contents. A + variable makes no assertions about either the shape or + contents of the matched value; it matches anything, and binds + the variable to that value. + + So the pattern (3:xs) first of all + is an assertion that a matching value is a non-empty list, by + matching against the (:) constructor. It + also ensures that the head of the list is the literal value + 3. If both of these conditions hold, the + tail of the list will be bound to the variable + xs. + + + + Variable naming in patterns + + As you read functions that match on lists, you'll + frequently find that the names of the variables inside a + pattern resemble (x:xs) or (d:ds). + This is a popular naming convention. The idea is that the name + xs is the plural of + x, because xs contains + the remainder of the list, and x its + head. + hunk ./en/ch04-defining-types.xml 552 - When we're writing a pattern, we can specify that we don't - care what value a particular value within a structure has, - without actually binding that value to a name. The notation - for this is _ (called a wild card or don't - care), and we use it as follows. This function - tells us whether the result of the roots + When we're writing a pattern, we can specify + that we don't care what value a particular value within a + structure has, without actually binding that value to a name. + The notation for this is _, and we call it a + wild card or a don't + care. We use it as follows. This function tells + us whether the result of the roots hunk ./en/ch04-defining-types.xml 592 + + + Non-exhaustive patterns + + When writing a series of patterns, it's important to cover + all of a type's constructors. For example, if we're + inspecting a list, we should have one equation that matches + the non-empty constructor (:), and one + that matches the empty-list constructor + []. + + Let's see what happens if we fail to cover all the cases. + Here, we're deliberately omitting a match against the + [] constructor. + + &BadPattern.hs:badExample; + + If we call this with a value that it can't match, we'll + get an error at runtime: our software has a bug! + + &badpattern.ghci:error; + + In this example, the initial application of + badExample succeeds, because + [1] is a more compact way of printing 1 : + []. The recursive application of badExample + xs is the source of the error, because then the value + that's being matched against is simply []. + + &GHC; provides a helpful compilation option, + , that will cause + it to print a warning at compile time if a sequence of + patterns don't match all of a type's constructors. + hunk ./en/ch04-defining-types.xml 634 - type variables into a type declaration. + type variables into a type declaration. Let's define a + Nullable type: we can use this to represent a + missing value, e.g. an empty field in a database row. hunk ./en/ch04-defining-types.xml 638 - &Wrapper.hs:Wrapper; + &Nullable.hs:Nullable; hunk ./en/ch04-defining-types.xml 642 - variable. It indicates that our Wrapper type takes - another type as its parameter. This lets us use - Wrapper on values of any type. + variable. It indicates that our Nullable type + takes another type as its parameter. This lets us use + Nullable on values of any type. + + &Nullable.hs:wrappedTypes; hunk ./en/ch04-defining-types.xml 648 - &Wrapper.hs:wrappedTypes; + As usual, we can load our source file into &ghci; + and experiment with it. hunk ./en/ch04-defining-types.xml 651 - As usual, we can load our source file into &ghci; and - experiment with it. + &nullable.ghci:experiment; hunk ./en/ch04-defining-types.xml 653 - &wrapper.ghci:experiment; + Nullable is a polymorphic, or + generic, type. When we create a type by giving the + Nullable type constructor a parameter, we can see + what the new type looks like by substituting that type for the + type variable a everywhere in the + definition of Nullable. The type Nullable + String has a value constructor, also named + Nullable, that takes a parameter of type + String. As we might expect, the type + Nullable Int is distinct from Nullable + Bool, and so on. hunk ./en/ch04-defining-types.xml 665 - Wrapper is a generic container - type (albeit a fairly useless one); we can construct a - Wrapper from a value of any type. It is also - strongly typed; the type of whatever it contains is represented in - its own type. + We can nest uses of parameterised types inside + each other, but when we do, we may need to use parentheses to + tell the Haskell compiler how to parse our expression. hunk ./en/ch04-defining-types.xml 669 - To once again extend an analogy to more familiar languages, - this gives us a facility that bears some resemblance to - templates in C++, and to generics in Java. (In fact, Java's - generics facility was inspired by several aspects of Haskell's - type system.) + &Nullable.hs:parens; hunk ./en/ch04-defining-types.xml 671 - We can nest uses of parameterised types inside each other, - but when we do, we may need to use parentheses to tell the - Haskell compiler what we mean. + If we omitted the parentheses, this would be parsed as + (Really Really) Int, which isn't valid. hunk ./en/ch04-defining-types.xml 674 - &Wrapper.hs:parens; + To once again extend an analogy to more familiar + languages, parameterised types give us a facility that bears + some resemblance to templates in C++, and to generics in Java. + Just be aware that this is a shallow analogy. Templates and + generics were added to their respective languages long after the + languages were initially defined, and have an awkward feel. + Haskell's parameterised types are simpler and easier to use, as + the language was designed with them from the beginning. hunk ./en/ch04-defining-types.xml 684 - - Back to writing functions: local variables + + Recursive types hunk ./en/ch04-defining-types.xml 687 - Let's take a break from writing about types for a few - moments. Within the body of a function, we can introduce new - local variables whenever we need them, using a let - expression. As an example, let's write a function that - calculates the real-valued roots of the quadratic equation - a * (x ** 2) + b * x + c == 0. + Here's a definition of a binary tree type. hunk ./en/ch04-defining-types.xml 689 - &Roots.hs:realRoots; + &Tree.hs:Tree; hunk ./en/ch04-defining-types.xml 691 - The keywords to look out for here are let, - which starts a block of variable declarations, and - in, which ends it. Each line introduces a new - variable. The name is on the left of the =, - and its value on the right. We can use these variables both - within our block of variable declarations and in the expression - that follows the in keyword. + We call this a recursive type because + Tree, the type we're defining, appears both on the + left hand side and the right hand side of the definition: we + define the type in terms of itself. + hunk ./en/ch04-defining-types.xml 697 - There's no problem with a variable earlier in a - let block referring to a later one, or even with - them referring to each other. (In some functional languages, - this sort of flexible let is named - letrec.) + + A little more about lists hunk ./en/ch04-defining-types.xml 700 - We can have multiple let blocks within an - expression. There's also another mechanism we can use to - introduce local variables, called a where block. - The definitions in a where block apply to the code - that precedes it. Let's illustrate what we - mean with another example. + Now that we're getting familiar with some of the jargon + around types, we can revisit lists. Haskell's list type is a + parameterised type, because we can make lists of any other type. + It is also an algebraic data type, with two constructors. One + is the empty list, written [] (sometimes pronounced + nil, which is borrowed from Lisp). hunk ./en/ch04-defining-types.xml 707 - &Roots.hs:roots; + &list.ghci:empty; hunk ./en/ch04-defining-types.xml 709 - Here, the roots function returns the - real roots when they're defined, and the complex roots - otherwise. (We left out the divide-by-zero case for simplicity.) - While a where clause initially looks very weird - to non-Haskell programmers, it's a great way to put the - important code early, followed by the auxiliary - definitions that support it. After a while, you'll find - yourself missing where clauses in languages that - lack them! + The other is the (:) operator, often + pronounced cons (this is short for + construct, and also borrowed from Lisp). The + (:) operator takes an element and a list, + and constructs a new list. hunk ./en/ch04-defining-types.xml 715 - The main difference between let and - where is one of scope. The scope of a - let only extends to the expression after the - in keyword, while the variables introduced by a - where clause are visible upwards to the beginning - of the block that it belongs to. Also, - let is always paired with an expression, but - where is paired with a block of equations. + &list.ghci:cons; hunk ./en/ch04-defining-types.xml 717 - We'll be talking more about how to write let - expressions and where clauses in . + We can use (:) repeatedly to add new + elements to the front of a list. hunk ./en/ch04-defining-types.xml 720 - - A few observations about complex numbers + &list.ghci:cons2; hunk ./en/ch04-defining-types.xml 722 - It's probably obvious from context above, but - (:+) is the constructor for a complex - number, taking the real part on the left and the imaginary - part on the right. + The right hand side of (:) must be a + list, and of the correct type. If it's not, we'll get an + error. hunk ./en/ch04-defining-types.xml 726 - Also, Complex is parameterised over the type - of complex number it should represent. In practice, it only - makes much sense to use Complex Double, since - &GHC; implements Double more efficiently than - Float. - + &list.ghci:cons.bad; hunk ./en/ch04-defining-types.xml 728 - - Local functions + Because (:) constructs a list from + another list, the list type is recursive. So here we have a + built-in type that's parameterised, recursive, and + algebraic. hunk ./en/ch04-defining-types.xml 733 - You'll have noticed that Haskell's syntax for defining a - variable looks very similar to its syntax for defining a - function. This symmetry is preserved in let and - where blocks; we can define local - functions just as easily as local - variables. All of the same syntax - applies as at the top level: we can use multiple equations, - patterns, and guards. + One consequence of lists being generic is that lists of + lists, for example, aren't special in any way. hunk ./en/ch04-defining-types.xml 736 - &LocalFunction.hs:pluralise; + &list.ghci:listlist; + + This has type [[String]], a list of lists of + strings. But since String is just a synonym for + [Char], it's really a list of + lists of lists of Char. Whew! + + We're not limited to building up lists one element at a + time. Haskell defines an inline function, + (++), that we can use to append one list + onto the end of another. + + &list.ghci:append; + + The concat function takes a list of + lists, and concatenates the whole lot into a single list. + + &list.ghci:concat; hunk ./en/ch04-defining-types.xml 755 - In this example, we define and use a local function - plural using several equations. Local - functions can freely use variables from the scopes that - enclose them; here, we use word from the - definition of the outer function - pluralise. In the definition of - pluralise, the map - function (which we'll be revisiting in the next chapter) - applies the local function plural to - every element of the counts list. - hunk ./en/ch04-defining-types.xml 764 - type signature looks peculiar; how can it produce a value of any + type signature looks peculiar: how can it produce a value of any hunk ./en/ch04-defining-types.xml 769 - It has that type so that we can call it anywhere - and it will always have the right type. However, instead of - returning a value like a normal function, it immediately - terminates evaluation, and prints the error message we give it. - Here's an example. The mySecond function - returns the second element of its input list, but fails if its - input list isn't long enough. + It has a result type of a so that we can call it anywhere and it + will always have the right type. However, instead of returning + a value like a normal function, it immediately aborts + evaluation, and prints the error message we give + it. + + Here's an example. The mySecond + function returns the second element of its input list, but fails + if its input list isn't long enough. hunk ./en/ch04-defining-types.xml 785 - &error.ghci:mySecond; + &error.ghci:mySecond; hunk ./en/ch04-defining-types.xml 791 - &ghci; prompt. This is both the strength and weakness calling - error: it doesn't let us distinguish - between recoverable errors and problems so severe that they - really should terminate a program. We'll see one way around - this problem in . - + &ghci; prompt. This is the major weakness of using + error: it doesn't let our caller + distinguish between a recoverable error and a problem so severe + that it really should terminate our program. hunk ./en/ch04-defining-types.xml 796 - - How to represent a complicated result + + A more controlled approach hunk ./en/ch04-defining-types.xml 799 - We sneaked two previously unseen standard types, - Maybe and Either, into our - root-finding examples. We use Maybe when it might - not make sense to return a normal result, for example because a - function's result is undefined for some inputs. We use - Just to say we have a - result, and the argument to Just - is that result. When we can't give a result, we use - Nothing, which takes no arguments. + Haskell defines a standard type, Maybe, that + we can use to represent the possibility of an error. It has + the same structure as the Nullable type that we + defined earlier. hunk ./en/ch04-defining-types.xml 804 - &realRoots.ghci:maybe; - - Why do we need Maybe here? The real-valued - roots of a quadratic equation are infinity when - a, the coefficient of x ** - 2, is zero. + &Maybe.hs:Maybe; hunk ./en/ch04-defining-types.xml 806 - &realRoots.ghci:a0; + If we want to represent fail, we use the + Nothing constructor. Otherwise, we wrap + our value with the Just + constructor. hunk ./en/ch04-defining-types.xml 811 - They're also not defined when b ** 2 - 4 * a * - c is negative, because we would need to use complex - numbers to represent a negative square root. + Let's see what our mySecond function + looks like if we return a Maybe value instead of + calling error. hunk ./en/ch04-defining-types.xml 815 - &realRoots.ghci:complex; + &MySecond.hs:safeSecond; hunk ./en/ch04-defining-types.xml 817 - Otherwise, we can return a normal result, wrapped in - Just. + If the list we're passed isn't long enough, instead of + crashing the program, we return Nothing to our + caller. This lets them decide what to do if the list isn't + long enough, where a call to error would + force a crash. hunk ./en/ch04-defining-types.xml 823 - &realRoots.ghci:just; + To return to an earlier topic, we can use pattern matching + to clarify this function. hunk ./en/ch04-defining-types.xml 826 - Compared to error, which we saw in - , Maybe has - the huge advantage that it's a normal value, which we return to - our caller to deal with. Calling error, by - contrast, is more akin to pulling on the program's ejector seat - handle as it disintegrates around us; something terrible has - happened, and we need to give up right now. + &MySecond.hs:tidySecond; hunk ./en/ch04-defining-types.xml 828 - The Either a b type gives us even more - flexibility than Maybe, as it's got two type - parameters. We can wrap a value of any type a with Left, or a value of - an unrelated type b with - Right. Our roots function - uses this to return a Double when the real roots - are defined, and a Complex Double when they're - not. + The first pattern only matches if the list is at least two + elements long (it contains two list constructors), and it + binds the variable x to the list's second + element. The second pattern is matched if the first + fails. + hunk ./en/ch04-defining-types.xml 836 - - The offside rule, and white space in a function - body - - In our definition of realRoots, the - left margin of our text wandered around quite a bit. This was - not an accident: in Haskell, white space has meaning. - - Haskell uses indentation as a cue to parse sections of code. - This use of layout to convey structure is sometimes called the - offside rule. At the top level, the first declaration or - definition can start in any column, and the Haskell compiler or - interpreter remembers that indentation level. Every subsequent - top-level declaration must have the same indentation. - - Here's an illustration of the top-level indentation rule. - Our first file, GoodIndent.hs, is well - behaved. - - &GoodIndent.hs:good; - - Our second, BadIndent.hs, doesn't play - by the rules. - - &BadIndent.hs:bad; - - Here's what happens when we try to load the two files into - &ghci;. - - &indent.ghci:load; - - An empty line is treated as a continuation of the current - item, as is a line indented to the right of the current current - item. + + Introducing local variables hunk ./en/ch04-defining-types.xml 839 - The rules for let expressions and - where clauses are similar. After a - let or where keyword, the Haskell - compiler or interpreter remembers the indentation of the next - token it sees. If the next line is empty, or its indentation is - further to the right than the previous line, this counts as - continuing the previous line. On the other hand, if the - indentation is the same as the previous line, this is treated as - beginning a new item in the same block. + Within the body of a function, we can introduce + new local variables whenever we need them, using a + let expression. As an example, let's write a + function that calculates the real-valued roots of the quadratic + equation a * (x ** 2) + b * x + c == + 0. hunk ./en/ch04-defining-types.xml 846 - Here are nested uses of let and - where. + To represent the result, we'll use the Maybe + type. The roots could potentially be infinite (if we divide by + zero) or complex numbers (if the square root term is negative), + in which cases we'll return Nothing. hunk ./en/ch04-defining-types.xml 851 - &letwhere.hs:let; + &realRoots.ghci:maybe; hunk ./en/ch04-defining-types.xml 853 - In the body of bar, the variable - a is only visible within the let - expression that defines it. It's not visible to the - let expression that defines b; - only the result of the inner - let expression is visible. + We'll use Just to contain the roots + when they're defined, and Nothing to + indicate that the result is undefined for the given + inputs. hunk ./en/ch04-defining-types.xml 858 - &letwhere.hs:where; + &Roots.hs:realRoots; hunk ./en/ch04-defining-types.xml 860 - Similarly, the scope of the first where clause - is the definition of foo, but the scope of - the second is just the first where clause. + The keywords to look out for here are + let, which starts a block of variable declarations, + and in, which ends it. Each line introduces a new + variable. The name is on the left of the =, + and the expression it's bound to is on the right. hunk ./en/ch04-defining-types.xml 866 - The indentation we use for the let and - where clauses makes our intentions easy to figure - out. + + Special notes hunk ./en/ch04-defining-types.xml 869 - - A note about tabs versus spaces + Let us re-emphasise our wording: a name in a &let; block + is bound to an expression, not to a + value. Because Haskell is a lazy + language, the expression associated with a name won't actually + be evaluated until it's needed. hunk ./en/ch04-defining-types.xml 875 - If you are using a Haskell-aware text editor (e.g. Emacs), - it is probably already configured to use space characters for - all white space within a line. If your editor is - not Haskell-aware, you should configure - it to only use space characters. + When we define a variable in a &let; block, we refer to it + as a &let;-bound variable. This simply + means what it says: we bound the variable in a &let; + block. hunk ./en/ch04-defining-types.xml 880 - The reason for this is simple portability. In an editor - that uses a fixed-width font, tab stops are by default placed - at different intervals on Unix-like systems (every eight - characters) than on Windows (every four characters). This - means that no matter what your personal beliefs are about - where tabs belong, you can't rely on someone else's editor - honouring your preferences. Any indentation that uses tabs is - going to look broken under someone's - configuration. In fact, this could lead to compilation - problems, as the Haskell language standard requires - implementations to use the Unix tab width convention. - Using space characters avoids these problem - entirely. - + Also, our use of white space here is important. We'll + talk about the layout rules in . + hunk ./en/ch04-defining-types.xml 885 - - The offside rule is not mandatory + We can use the names of a variable in a &let; block both + within the block itself and in the expression that follows the + in keyword. hunk ./en/ch04-defining-types.xml 889 - We can use explicit structuring instead of layout to - indicate what we mean. To do so, we start a block of - equations with an opening curly brace; separate each item with - a semicolon; and finish the block with a closing curly brace. - The following two uses of let have the same - meanings. + In general, we'll refer to the places within our code where + we can use a name as the name's scope. If + we can use a name, it's in scope, otherwise + it's out of scope. hunk ./en/ch04-defining-types.xml 894 - &Braces.hs:braces; + + Local variables and lazy evaluation hunk ./en/ch04-defining-types.xml 897 - When we use explicit structuring, the normal layout rules - don't apply, which is why we can get away with unusual - indentation in the second let expression. + In our definition of realRoots, we're + making use of laziness. Here's how to follow what's going + on. hunk ./en/ch04-defining-types.xml 901 - We can use explicit structuring anywhere that we'd - normally use layout. It's valid for where - clauses, and even top-level declarations. Just remember that - although the facility exists, explicit structuring is hardly - ever actually used in Haskell - programs. + + + To begin with, recall that the expressions in the + &let; block aren't evaluated, they're just bound. + + + The first value that is actually inspected is the &if; + expression's predicate, a /= 0 && n >= + 0. + + + If the value of a is zero, then the + left branch of the (&&) + expression is False, and so the whole + predicate is False. No further computation + is needed; we immediately return + Nothing. + + + To compare n with zero, we must + evaluate it. If the (>=) + comparison fails, we again do no further work, and return + Nothing. + + + Even when the predicate succeeds and we return the + Just branch, we're returning an + expression, not a value. We still + won't compute sqrt n until our caller + actually needs one or other of the roots. + + hunk ./en/ch04-defining-types.xml 934 - hunk ./en/ch04-defining-types.xml 935 - - Recursive types + + Shadowing hunk ./en/ch04-defining-types.xml 938 - Here's a definition of a binary tree type. + We can nest multiple + let blocks inside each other in an + expression. hunk ./en/ch04-defining-types.xml 942 - &Tree.hs:Tree; + &NestedLets.hs:foo; hunk ./en/ch04-defining-types.xml 944 - We call this a recursive type because - Tree, the type we're defining, appears both on the - left hand side and the right hand side of the definition: we - define the type in terms of itself. - + It's perfectly legal, but not exactly wise, to repeat a + variable name in a nested &let; expression. hunk ./en/ch04-defining-types.xml 947 - - A little more about lists + &NestedLets.hs:bar; hunk ./en/ch04-defining-types.xml 949 - Now that we're getting familiar with some of the jargon - around types, we can revisit lists. Haskell's list type is a - parameterised type, because we can make lists of any other type. - It is also an algebraic data type, with two constructors. One - is the empty list, written [] (sometimes pronounced - nil, which is borrowed from Lisp). + Here, the inner x is hiding, or + shadowing, the outer + x. hunk ./en/ch04-defining-types.xml 953 - &list.ghci:empty; + &nestedlets.ghci:bar; hunk ./en/ch04-defining-types.xml 955 - The other is the (:) operator, often - pronounced cons (this is short for - construct, and also borrowed from Lisp). The - (:) operator takes an element and a list, - and constructs a new list. + We can also shadow a function's parameters, leading to + even stranger results. What is the type of this + function? hunk ./en/ch04-defining-types.xml 959 - &list.ghci:cons; + &NestedLets.hs:quux; hunk ./en/ch04-defining-types.xml 961 - We can use (:) repeatedly to add new - elements to the front of a list. + Because the argument a is never used in + the body of the function, due to being shadowed by the + &let;-bound a, the argument can have any + type at all. hunk ./en/ch04-defining-types.xml 966 - &list.ghci:cons2; + &nestedlets.ghci:quux; hunk ./en/ch04-defining-types.xml 968 - The right hand side of (:) must be a - list, and of the correct type. If it's not, we'll get an - error. - - &list.ghci:cons.bad; - - Because (:) constructs a list from - another list, the list type is recursive. So here we have a - built-in type that's parameterised, recursive, and - algebraic. - - One consequence of lists being generic is that lists of - lists, for example, aren't special in any way. - - &list.ghci:listlist; - - This has type [[String]], a list of lists of - strings. But since String is just a synonym for - [Char], it's really a list of - lists of lists of Char. Whew! - - We're not limited to building up lists one element at a - time. Haskell defines an inline function, - (++), that we can use to append one list - onto the end of another. + Shadowing can obviously lead to nasty bugs, so &GHC; has a + helpful option that + will print a warning message if we accidentally shadow a + name. + hunk ./en/ch04-defining-types.xml 974 - &list.ghci:append; + + The where clause hunk ./en/ch04-defining-types.xml 977 - The concat function takes a list of - lists, and concatenates the whole lot into a single list. + There's another mechanism we can use to introduce local + variables, called a where clause. The definitions + in a where clause apply to the code that + precedes it. Let's illustrate what we + mean with another example. hunk ./en/ch04-defining-types.xml 983 - &list.ghci:concat; + For variety, we'll introduce complex numbers to represent + the complex roots, and an abstract data type for the result. + The (:+) operator below constructs a + complex number from its real and imaginary parts. hunk ./en/ch04-defining-types.xml 988 - + &Roots.hs:roots; hunk ./en/ch04-defining-types.xml 990 - - Unit, the zero-element tuple + Our roots function returns + the real-valued roots when they're defined, the complex roots + otherwise, and Undefined if the roots are + infinite due to a being zero. hunk ./en/ch04-defining-types.xml 995 - Haskell has a special tuple type with no elements, written - (), and pronounced unit. + A &where; clause can initially seem very weird to + non-Haskell programmers. It's a great way to put your + reader's focus on the important details of an expression, with + the supportings definitions following afterwards. After a + while, you'll find yourself missing where clauses + in languages that lack them! hunk ./en/ch04-defining-types.xml 1002 - &unit.ghci:unit; + As with &let; expressions, names are bound to + expressions in &where; clauses, and white space is + significant. We'll be talking more about the layout rules + shortly, in . + hunk ./en/ch04-defining-types.xml 1008 - This type is only really used with parameterised data types, - to indicate that one of the type parameters isn't being used. - Since it doesn't encode any information, it's a rough equivalent - to void in C. + + Local functions hunk ./en/ch04-defining-types.xml 1011 - Here's an example of () in use. We can - generalise our earlier Tree type a little, so that - internal nodes contain values of type a, while leaves contain values of type - b. + You'll have noticed that Haskell's syntax for + defining a variable looks very similar to its syntax for + defining a function. This symmetry is preserved in + let and where blocks; we can define + local functions just as easily as local + variables. All of the same syntax + applies as at the top level: we can use multiple equations, + patterns, and guards. hunk ./en/ch04-defining-types.xml 1020 - &Tree.hs:ComplexTree; + &LocalFunction.hs:pluralise; hunk ./en/ch04-defining-types.xml 1022 - If we wanted to create a ComplexTree where we - wanted to store Ints on the leaves, but don't care - about the internal nodes. We would write its type as - ComplexTree () Int. + In this example, we define and use a local + function plural using several equations. + Local functions can freely use variables from the scopes that + enclose them; here, we use word from the + definition of the outer function + pluralise. In the definition of + pluralise, the map + function (which we'll be revisiting in the next chapter) + applies the local function plural to + every element of the counts list. + hunk ./en/ch04-defining-types.xml 1263 + + + The offside rule, and white space in a function + body + + In our definition of realRoots, the + left margin of our text wandered around quite a bit. This was + not an accident: in Haskell, white space has meaning. + + Haskell uses indentation as a cue to parse sections of code. + This use of layout to convey structure is sometimes called the + offside rule. At the top level, the first declaration or + definition can start in any column, and the Haskell compiler or + interpreter remembers that indentation level. Every subsequent + top-level declaration must have the same indentation. + + Here's an illustration of the top-level indentation rule. + Our first file, GoodIndent.hs, is well + behaved. + + &GoodIndent.hs:good; + + Our second, BadIndent.hs, doesn't play + by the rules. + + &BadIndent.hs:bad; + + Here's what happens when we try to load the two files into + &ghci;. + + &indent.ghci:load; + + An empty line is treated as a continuation of the current + item, as is a line indented to the right of the current current + item. + + The rules for let expressions and + where clauses are similar. After a + let or where keyword, the Haskell + compiler or interpreter remembers the indentation of the next + token it sees. If the next line is empty, or its indentation is + further to the right than the previous line, this counts as + continuing the previous line. On the other hand, if the + indentation is the same as the previous line, this is treated as + beginning a new item in the same block. + + Here are nested uses of let and + where. + + &letwhere.hs:let; + + In the body of bar, the variable + a is only visible within the let + expression that defines it. It's not visible to the + let expression that defines b; + only the result of the inner + let expression is visible. + + &letwhere.hs:where; + + Similarly, the scope of the first where clause + is the definition of foo, but the scope of + the second is just the first where clause. + + The indentation we use for the let and + where clauses makes our intentions easy to figure + out. + + + A note about tabs versus spaces + + If you are using a Haskell-aware text editor (e.g. Emacs), + it is probably already configured to use space characters for + all white space within a line. If your editor is + not Haskell-aware, you should configure + it to only use space characters. + + The reason for this is simple portability. In an editor + that uses a fixed-width font, tab stops are by default placed + at different intervals on Unix-like systems (every eight + characters) than on Windows (every four characters). This + means that no matter what your personal beliefs are about + where tabs belong, you can't rely on someone else's editor + honouring your preferences. Any indentation that uses tabs is + going to look broken under someone's + configuration. In fact, this could lead to compilation + problems, as the Haskell language standard requires + implementations to use the Unix tab width convention. + Using space characters avoids these problem + entirely. + + + + The offside rule is not mandatory + + We can use explicit structuring instead of layout to + indicate what we mean. To do so, we start a block of + equations with an opening curly brace; separate each item with + a semicolon; and finish the block with a closing curly brace. + The following two uses of let have the same + meanings. + + &Braces.hs:braces; + + When we use explicit structuring, the normal layout rules + don't apply, which is why we can get away with unusual + indentation in the second let expression. + + We can use explicit structuring anywhere that we'd + normally use layout. It's valid for where + clauses, and even top-level declarations. Just remember that + although the facility exists, explicit structuring is hardly + ever actually used in Haskell + programs. + + hunk ./en/ch08-io.xml 90 - () is, essentially, an empty return value; there is - no return value to speak of from &putStrLn;. This is similar to - void in Java or C. Strictly speaking, - () is a 0-element tuple; see for details. + () is an empty tuple (pronounced unit), indicating that there is + no return value from &putStrLn;. This is similar to + void in Java or C.. hunk ./examples/ch04/BadPattern.hs 1 +module BadPattern where + +{-- snippet badExample --} +badExample (x:xs) = x + badExample xs +{-- /snippet badExample --} hunk ./examples/ch04/BookSection.hs 16 -sectionNumber (BookSection n t) = n -sectionTitle (BookSection n t) = t +sectionNumber (Section num title) = n +sectionTitle (Section num title) = t hunk ./examples/ch04/BookSection.hs 21 -nicerNumber (BookSection n _) = n -nicerTitle (BookSection _ t) = t +nicerNumber (Section num _) = num +nicerTitle (Section _ title) = title hunk ./examples/ch04/BookSection.hs 25 - hunk ./examples/ch04/MySecond.hs 9 +{-- snippet safeSecond --} +safeSecond :: [a] -> Maybe a + +safeSecond xs = if null (tail xs) + then Nothing + else Just (head (tail xs)) +{-- /snippet safeSecond --} + +{-- snippet tidySecond --} +tidySecond :: [a] -> Maybe a + +tidySecond (_:x:_) = Just x +tidySecond _ = Nothing +{-- /snippet tidySecond --} + hunk ./examples/ch04/Nullable.hs 1 +{-- snippet Nullable --} +data Nullable a = Really a + | Null +{-- /snippet Nullable --} + +{-- snippet wrappedTypes --} +nullableBool = Really True + +nullableString = Really String +{-- /snippet wrappedTypes --} + + +{-- snippet parens --} +Really (Really Int) +{-- /snippet parens --} hunk ./examples/ch04/Roots.hs 4 -roots :: Double -> Double -> Double - -> Either (Complex Double, Complex Double) (Double, Double) +data Roots = Undefined + | RealValued Double Double + | ComplexValued (Complex Double) (Complex Double) hunk ./examples/ch04/Roots.hs 8 -roots a b c = if n >= 0 - then Right ((-b + sqrt n) / a2, (-b - sqrt n) / a2) - else Left ((-b' + sqrt n') / a2', (-b' - sqrt n') / a2') - where n = b**2 - 4 * a * c - a2 = 2 * a - n' = n :+ 0 - b' = b :+ 0 - a2' = a2 :+ 0 +roots :: Double -> Double -> Double -> Roots + +roots a b c = + if a == 0 + then Undefined + else if n >= 0 + then RealValued ((-b + s) / a2) ((-b - s) / a2) + else ComplexValued ((-b' + s') / a2') ((-b' - s') / a2') + where n = b**2 - 4 * a * c + a2 = 2 * a + n' = n :+ 0 + b' = b :+ 0 + a2' = a2 :+ 0 + s = sqrt n + s' = sqrt n' hunk ./examples/ch04/Roots.hs 33 +-- (b^2 - 4ac) / 2a hunk ./examples/ch04/Roots.hs 36 -realRoots a b c = let n = b**2 - 4 * a * c +realRoots a b c = let n = b^2 - 4 * a * c hunk ./examples/ch04/Roots.hs 38 - r1 = (-b + sqrt n) / a2 - r2 = (-b - sqrt n) / a2 - in if n >= 0 && a /= 0 - then Just (r1, r2) + s = sqrt n + in if a /= 0 && n >= 0 + then Just ((-b + s) / a2, (-b - s) / a2) hunk ./examples/ch04/badpattern.ghci 1 +:load BadPattern + +--# error +badExample [1] hunk ./examples/ch04/booksection.ghci 2 -:load BookSection.hs +:load BookSection hunk ./examples/ch04/booksection.ghci 26 -BookSection 4 "Not being Mrs. Grundy, who *was* Mr. Bounderby?" +Section 4 "Not being Mrs. Grundy, who *was* Mr. Bounderby?" hunk ./examples/ch04/booksection.ghci 29 +--# unwrap + +sectionNumber (Section 3 "Foo") +sectionTitle (Section 3 "Foo") + +--# unwrap.types + +:type sectionNumber +:type sectionTitle + hunk ./examples/ch04/error.ghci 13 +--# safeSecond +safeSecond [] +safeSecond [1] +safeSecond [1,2] +safeSecond [1,2,3] + hunk ./examples/ch04/nullable.ghci 1 +:load Nullable + +--# experiment +Really 1.5 +Null +:type Really "Really" hunk ./examples/ch04/realRoots.ghci 7 -:load Roots.hs +:load Roots }