[Yet more rewriting Bryan O'Sullivan **20080119054821] { addfile ./examples/ch04/GlobalVariable.hs addfile ./examples/ch04/ListADT.hs addfile ./examples/ch04/NestedLets.hs addfile ./examples/ch04/nestedlets.ghci addfile ./examples/ch04/Tree.java hunk ./en/ch04-defining-types.xml 557 - care. We use it as follows. This function tells - us whether the result of the roots - function we defined earlier is real-valued or not. + care. We use it as follows. + + This function tells us whether the result of the + roots function we defined earlier is + real-valued or not. We don't care about root-finding per se: + this is just a well-known function that's a little (but + only a little) complicated, so it's a + good vehicle to explore with. hunk ./en/ch04-defining-types.xml 693 - Here's a definition of a binary tree type. + The familiar list type is recursive: + it's defined in terms of itself. To understand what this means, + let's create our own list-like type. We'll use + Cons in place of the (:) + constructor, and Nil in place of + []. hunk ./en/ch04-defining-types.xml 700 - &Tree.hs:Tree; + &ListADT.hs:List; hunk ./en/ch04-defining-types.xml 702 - 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. - + We can visually identify this type as defined in terms of + itself because List a appears on both the left and + the right of the = sign. What this means in + practice is that if we want to use the Cons + constructor to create a new value, we must supply a value of + type a, and another value of type + List a. hunk ./en/ch04-defining-types.xml 710 - - A little more about lists + The smallest value of type List a that we can + create is Nil. hunk ./en/ch04-defining-types.xml 713 - 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). + &listadt.ghci:empty; hunk ./en/ch04-defining-types.xml 715 - &list.ghci:empty; + We can use Nil, which has the type List + a, as a parameter to Cons. hunk ./en/ch04-defining-types.xml 718 - 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. + &listadt.ghci:tiny; hunk ./en/ch04-defining-types.xml 720 - &list.ghci:cons; + We can also use a value constructed using Cons + as a parameter to Cons. hunk ./en/ch04-defining-types.xml 723 - We can use (:) repeatedly to add new - elements to the front of a list. + &listadt.ghci:two; hunk ./en/ch04-defining-types.xml 725 - &list.ghci:cons2; + We could obviously continue in this fashion indefinitely, + creating ever longer Cons chains, each with a + single Nil at the end. This gives us another way + to look at List as recursive. + + To prove to ourselves that our List a type is + the same shape as [a], we can write a function that + reproduces any value of type [a] in the form of a + value of type List a. hunk ./en/ch04-defining-types.xml 735 - The right hand side of (:) must be a - list, and of the correct type. If it's not, we'll get an - error. + &ListADT.hs:fromList; hunk ./en/ch04-defining-types.xml 737 - &list.ghci:cons.bad; + By inspection, this clearly substitutes a Cons + for every (:), and a Nil for + each []. The two types are + isomorphic. hunk ./en/ch04-defining-types.xml 742 - 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. + &listadt.ghci:fromList; hunk ./en/ch04-defining-types.xml 744 - One consequence of lists being generic is that lists of - lists, for example, aren't special in any way. + For a third perspective on what a recursive type + is, here's a definition of a binary tree type. hunk ./en/ch04-defining-types.xml 747 - &list.ghci:listlist; + &Tree.hs:Tree; hunk ./en/ch04-defining-types.xml 749 - 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! + This time, let's search for insight by looking at a more + familiar language. Here's a comparable class definition in + Java. hunk ./en/ch04-defining-types.xml 753 - 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. + &Tree.java:Tree; hunk ./en/ch04-defining-types.xml 755 - &list.ghci:append; + The one significant difference is that Java lets us use the + special value null anywhere to indicate + nothing, so we can use null to + indicate that a node doesn't have a left or right child. Here's + a small function that constructs a tree with two leaves (a leaf, + by convention, has no children). hunk ./en/ch04-defining-types.xml 762 - The concat function takes a list of - lists, and concatenates the whole lot into a single list. + &Tree.java:Example; hunk ./en/ch04-defining-types.xml 764 - &list.ghci:concat; + In Haskell, we don't have an equivalent of + null. We could use the Maybe type to + provide a similar effect, but that bloats the pattern matching + (try it yourself). Instead, we've decided to use a no-argument + Empty constructor. Where the Java example provides + null to the Tree constructor, we + supply Empty in Haskell. + + &Tree.hs:simpleTree; + + + Exercises hunk ./en/ch04-defining-types.xml 777 + + + + Write the converse of fromList: + a function that takes a List a and + generates a [a]. + + + + hunk ./en/ch04-defining-types.xml 924 - it's out of scope. + it's out of scope. If a name is visible + throughout a source file, we say it's at the top + level. hunk ./en/ch04-defining-types.xml 1048 - let and where blocks; we can define + let and where blocks: we can define hunk ./en/ch04-defining-types.xml 1066 + + We can also define variables, as well as functions, at the + top level of a source file. + + &GlobalVariable.hs:itemName; + + Global variables are frowned upon in imperative languages, + because they introduce coupling between distant pieces of + code. Change a global variable in one function, and it + affects the behaviour of another, possibly unexpectedly. + Since values are immutable in Haskell, top level variables are + risk-free. hunk ./en/ch04-defining-types.xml 1091 - arbitrary expression; the result of this expression is what - we're pattern matching on. The of keyword - signifies the end of the expression and the beginning of the - block of patterns and expressions. + arbitrary expression: this is the expression that we're + checking0. The of keyword signifies the end of the + expression and the beginning of the block of patterns and + expressions. hunk ./en/ch04-defining-types.xml 1158 - irrefutable. + irrefutable. The wild card _ + is also irrefutable. hunk ./en/ch04-defining-types.xml 1312 - The offside rule, and white space in a function - body + The offside rule and white space in an expression hunk ./en/ch04-defining-types.xml 1360 - 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. + The name a is only visible + within the inner let expression. It's not visible + in the outer let. If we try to use the name + a there, we'll get a compilation + error. hunk ./en/ch04-defining-types.xml 1385 - The reason for this is simple portability. In an editor + The reason for this is portability. In an editor hunk ./en/ch05-fp.xml 276 - We've already seen the definition of the list algebraic - data type in , and know - that a list doesn't encode its own length. Thus, the only way - that length can operate is to walk the - entire list. + We've already seen the definition of the list + algebraic data type many times, and know that a list doesn't + store its own length explicitly. Thus, the only way that + length can operate is to walk the entire + list. hunk ./examples/ch04/GlobalVariable.hs 1 +{-- snippet itemName --} +itemName = "Weighted Companion Cube" +{-- /snippet itemName --} hunk ./examples/ch04/ListADT.hs 1 +{-- snippet List --} +data List a = Cons a (List a) + | Nil + deriving (Show) +{-- /snippet List --} + +{-- snippet fromList --} +fromList (x:xs) = Cons x (fromList xs) +fromList [] = Nil +{-- /snippet fromList --} hunk ./examples/ch04/NestedLets.hs 1 +{-- snippet foo --} +foo = let a = 1 + in let b = 2 + in a + b +{-- /snippet foo --} + +{-- snippet bar --} +bar = let x = 1 + in ((let x = "foo" in x), x) +{-- /snippet bar --} + +{-- snippet quux --} +quux a = let a = "foo" + in a ++ "eek!" +{-- /snippet quux --} hunk ./examples/ch04/Roots.hs 60 -finalRoots 0 _ _ = Nothing -finalRoots a b c | n >= 0 = Just (r1, r2) - | otherwise = Nothing - where n = b**2 - 4 * a * c - r1 = (-b + sqrt n) / (2 * a) - r2 = (-b - sqrt n) / (2 * a) +finalRoots :: Double -> Double -> Double -> QuadraticRoots + +finalRoots 0 b c = Undefined +finalRoots a b c + | n >= 0 = RealValued ((-b + s) / a2) ((-b - s) / a2) + | otherwise = 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/Tree.hs 2 -data Tree a = Node (Tree a) (Tree a) - | Leaf a +data Tree a = Node a (Tree a) (Tree a) + | Empty hunk ./examples/ch04/Tree.hs 8 -{-- snippet ComplexTree --} -data ComplexTree a b = ComplexNode a (ComplexTree a b) (ComplexTree a b) - | ComplexLeaf b - deriving (Show) -{-- /snippet ComplexTree --} +{-- snippet simpleTree --} +simpleTree = Node "parent" (Node "left child" Empty Empty) + (Node "right child" Empty Empty) +{-- /snippet simpleTree --} hunk ./examples/ch04/Tree.java 1 +/** snippet Tree */ +class Tree +{ + A value; + Tree left; + Tree right; + + public Tree(A v, Tree l, Tree r) + { + value = v; + left = l; + right = r; + } +} +/** /snippet Tree */ + +/** snippet Example */ +class Example +{ + static Tree simpleTree() + { + return new Tree( + "parent", + new Tree("left leaf", null, null), + new Tree("right leaf", null, null)); + } +} +/** /snippet Example */ hunk ./examples/ch04/letwhere.hs 9 + c = True hunk ./examples/ch04/letwhere.hs 11 - in a + in (a, c) hunk ./examples/ch04/nestedlets.ghci 1 +:load NestedLets + +--# bar +bar + +--# quux +:type quux }