[Haskell-cafe] [Wadler 89] Philip Wadler. "Theorems for free!": Can't get the same results in Haskell
David Feuer
david.feuer at gmail.com
Fri Aug 10 03:55:54 CEST 2012
It looks to me like Wadler made a typo. Even great minds like his slip up
like that sometimes. However, I do have some comments below on your code.
On Aug 9, 2012 8:53 PM, "Stayvoid" <stayvoid at gmail.com> wrote:
> I tried to implement it in Haskell:
> (I'm a newbie. I guess it's possible to write a better version.)
>
> module Param where
> import Prelude
The prelude is imported automatically. You only need to mention it as an
import if you need to *avoid* importing some functions, or want some
functions to be imported only "qualified". This is done if you want to use
a name that clashes with one in the prelude. You'll see things like
import Prelude hiding (foldl',foldl, foldr)
import Prelude qualified as P
in a module implementing a data structure that supports folds.
>
> odds :: [Int] -> [Int]
> odds [] = []
This is a very awkward approach. There's no reason to have a special case
for the one-element list, and certainly no reason to use ++ to add a single
element to the front of a list. You should do the work in the (x:xs) case
instead:
odds [] = []
odds (x:xs)
| odd x = x : odds xs
| otherwise = odds xs
In fact, there's a function called "filter" that captures this pattern, so
you can even write:
odds = filter odd
> odds [x] = if odd x
> then [x]
> else []
> odds (x:xs) = if odds [x] == []
> then odds xs
> else [x] ++ odds xs
>
> inc :: [Int] -> [Int]
> inc [] = error "Empty list"
> inc [x] = [succ x]
> inc (x:xs) = inc [x] ++ inc xs
Again, this is bizarre. You should be writing:
inc [] = []
inc (x:xs) = succ x : inc xs
Again, there is a function that captures this pattern, so you can shorten
it to
inc = map succ
>
> Looks fine:
>
> *Param> odds [1,2,3]
> [1,3]
> *Param> inc [1,2,3]
> [2,3,4]
>
> But my results differ from the paper's:
>
> *Param> inc (odds [1,2,3])
> [2,4]
> *Param> odds (inc [1,2,3])
> [3]
>
> I doubt that there is an error in the paper.
I don't.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120809/1a3969fa/attachment.htm>
More information about the Haskell-Cafe
mailing list