[Explicit recursion, structural induction. Bryan O'Sullivan **20070807055732] { addfile ./examples/ch04/ch04.exercises.ghci hunk ./en/ch04-fp.xml 15 + + Explicit recursion + + Here's a C function that takes a string of decimal digits + and turns them into an integer. + + &intparse.c:as_int; + + Given that Haskell doesn't have any looping constructs, + how should we think about representing a fairly + straightforward piece of code like this? + + We don't have to start off by writing a type signature, + but it helps to remind us of what we're working with. + + &IntParse.hs:type; + + The C code computes the result incrementally as it + traverses the string; the Haskell code can do the same. + However, in Haskell, we write the loop as a function, which + we'll call loop just to keep things nice + and explicit. + + &IntParse.hs:loop; + + That first parameter to loop is the + accumulator variable we'll be using. Passing zero into it is + equivalent to initialising the acc variable + in C at the beginning of the loop. + + Rather than leap into blazing code, let's think about the + data we have to work with. Our familiar String + is just a synonym for [Char], a list of + characters. The easiest way for us to get the traversal right + is to think about the structure of a list: it's either empty, + or a single element followed by the rest of the list. + + We can express this structural thinking directly by + pattern matching on the list type's constructors. It's often + handy to think about the easy cases first: here, that means we + will consider the empty-list case. + + &IntParse.hs:base; + + An empty list doesn't just mean the input string is + empty; it's also the case we'll encounter when we + traverse all the way to the end of a non-empty list. So we + don't want to error out if we see an empty + list. Instead, we should do something sensible. Here, the + sensible thing is to return our accumulated value. + + The other case we have to consider arises when the input + list is not empty. We need to do something with the current + element of the list, and something with the rest of the + list. + + &IntParse.hs:inductive; + + We compute a new value for the accumulator, and give it + the name acc'. We then call the + loop function again, passing it the + updated value acc' and the rest of the + input list; this is equivalent to the loop starting another + round in C. + + + Remember, a single quote is a legal character to use in + a Haskell variable name, and is pronounced + prime. There's a common idiom in Haskell + programs involving a variable, say foo, + and another variable, say foo'. We can + usually assume that foo' is somehow + related to foo. It's often a new value + for foo, as in our case here. + + Sometimes we'll see continuations of this idiom, such as + foo''. Since keeping track of the number + of single quotes tacked onto the end of a name rapidly + becomes tedious, use of more than two in a row is thankfully + rare. + + + Each time the loop function calls + itself, it has a new value for the accumulator, and it + consumes one element of the input list. Eventually, it's + going to hit the end of the list, at which time the + [] pattern will match, and the recursive calls + will cease. + + Because the last thing that loop does + is simply call itself, it's an example of a tail recursive + function. There's another common idiom in this code, too. + Thinking about the structure of the list, and handling the + empty and non-empty cases separately, is a kind of approach + called structural recursion. + + We call the non-recursive case (when the list is empty) + the base case. We'll see people refer to the case where the + function calls itself as the recursive case (surprise!), or + they might give a nod to mathematical induction and call it + the inductive case. + + Structural induction isn't confined to lists; we can use + it on other algebraic data types, too. We'll have more to say + about it later. + + hunk ./en/ch04-fp.xml 125 - Consider the C function square, which - squares every element in an array. + Consider another C function, square, + which squares every element in an array. hunk ./en/ch04-fp.xml 289 - recursive, and uses an accumulator - parameter, acc, to hold the current partial - sum of the list. This is a natural way to - represent a loop in a pure functional language. + recursive, and uses an accumulator parameter, + acc, to hold the current partial sum of the + list. As we already saw with asInt, this + is a natural way to represent a loop in a pure + functional language. hunk ./en/ch04-fp.xml 568 + Use a fold (choosing the appropriate fold will make + your code much simpler) to rewrite and improve upon the + asInt function from . + + &ch04.exercises.hs:asInt_fold; + + Your function should behave as follows. + + &ch04.exercises.ghci:asInt_fold; + + Extend your function to handle the following kinds + of exceptional conditions by calling + error. + + &ch04.exercises.ghci:asInt_fold.errors; + + + + + + The asInt_fold function uses + error, so its callers cannot handle + errors. Rewrite it to fix this problem. + + &ch04.exercises.hs:asInt_either; + &ch04.exercises.ghci:asInt_either; + + + + + hunk ./en/ch04-fp.xml 628 - The Data.List module defines a function, - groupBy, which has the following - type. + The Data.List module defines a + function, groupBy, which has the + following type. hunk ./examples/ch04/ch04.exercises.ghci 1 +:load ch04.exercises + +--# asInt_fold +asInt_fold "101" +asInt_fold "-31337" + +--# asInt_fold.errors +asInt_fold "" +asInt_fold "-" +asInt_fold "-3" +asInt_fold "2.7" +asInt_fold "314159265358979323846" + +--# asInt_either +asInt_either "33" +asInt_either "foo" hunk ./examples/ch04/ch04.exercises.hs 1 +import Data.Char (ord) hunk ./examples/ch04/ch04.exercises.hs 24 +-- Idea courtesy of William Lee Irwin. +{-- snippet asInt_fold --} +asInt_fold :: String -> Int +{-- /snippet asInt_fold --} +asInt_fold ('-':xs) = negate (asInt' xs) +asInt_fold xs = asInt_fold' xs + +asInt_fold' [] = error "empty string" +asInt_fold' xs = foldr step 0 xs + where step c n + | c `elem` ['0'..'9'] = let n' = n * 10 + ord c - zero + in if n' < n + then error "numeric overflow" + else n' + | otherwise = error ("non-digit " ++ show c) + zero = ord '0' + +{-- snippet asInt_either --} +type ErrorMessage = String +asInt_either :: String -> Either ErrorMessage Int +{-- /snippet asInt_either --} +asInt_either ('-':xs) = case asInt_either' xs of + Left err -> Left err + Right val -> Right (negate val) +asInt_either xs = asInt_either' xs + +asInt_either' [] = Left "empty string" +asInt_either' xs = foldr step (Right 0) xs + where step c (Right n) + | c `elem` ['0'..'9'] = let n' = n * 10 + ord c - zero + in if n' < n + then Left "numeric overflow" + else Right n' + | otherwise = Left ("non-digit " ++ show c) + step _ err = err + zero = ord '0' + }