GHC predictability

Hello, One frequent criticism of Haskell (and by extension GHC) is that it has unpredictable performance and memory consumption. I personally do not find this to be the case. I suspect that most programmer confusion is rooted in shaky knowledge of lazy evaluation; and I have been able to fix, with relative ease, the various performance problems I've run into. However I am not doing any sort of performance critical computing (I care about minutes or seconds, but not about milliseconds). I would like to know what others think about this. Is GHC predictable? Is a thorough knowledge of lazy evaluation good enough to write efficient (whatever that means to you) code? Or is intimate knowledge of GHC's innards necessary? thanks, Jeff PS I am conflating Haskell and GHC because I use GHC (with its extensions) and it produces (to my knowledge) the fastest code. --- This e-mail may contain confidential and/or privileged information. If you are not the intended recipient (or have received this e-mail in error) please notify the sender immediately and destroy this e-mail. Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden.

jeff.polakow:
Hello,
One frequent criticism of Haskell (and by extension GHC) is that it has unpredictable performance and memory consumption. I personally do not find this to be the case. I suspect that most programmer confusion is rooted in shaky knowledge of lazy evaluation; and I have been able to fix, with relative ease, the various performance problems I've run into. However I am not doing any sort of performance critical computing (I care about minutes or seconds, but not about milliseconds).
I would like to know what others think about this. Is GHC predictable? Is a thorough knowledge of lazy evaluation good enough to write efficient (whatever that means to you) code? Or is intimate knowledge of GHC's innards necessary?
thanks, Jeff
PS I am conflating Haskell and GHC because I use GHC (with its extensions) and it produces (to my knowledge) the fastest code.
This has been my experience to. I'm not even sure where "unpredicatiblity" would even come in, other than though not understanding the demand patterns of the code. It's relatively easy to look at the Core to get a precise understanding of the runtime behaviour. I've also not found the GC unpredicatble either. -- Don

On Fri, May 09, 2008 at 02:24:12PM -0700, Don Stewart wrote:
jeff.polakow:
Hello,
One frequent criticism of Haskell (and by extension GHC) is that it has unpredictable performance and memory consumption. I personally do not find this to be the case. I suspect that most programmer confusion is rooted in shaky knowledge of lazy evaluation; and I have been able to fix, with relative ease, the various performance problems I've run into. However I am not doing any sort of performance critical computing (I care about minutes or seconds, but not about milliseconds).
I would like to know what others think about this. Is GHC predictable? Is a thorough knowledge of lazy evaluation good enough to write efficient (whatever that means to you) code? Or is intimate knowledge of GHC's innards necessary?
thanks, Jeff
PS I am conflating Haskell and GHC because I use GHC (with its extensions) and it produces (to my knowledge) the fastest code.
This has been my experience to. I'm not even sure where "unpredicatiblity" would even come in, other than though not understanding the demand patterns of the code.
I think the unpredictability comes in due to the difficulty of predicting resource useage in the presence of lazy data (and particularly lazy IO). It's not really that hard to predict the behavior of code that you write, but it can certainly be hard to predict the effect of changes that you make to someone else's code. It's an effect of the possibility of constructing and consuming large data objects without ever holding them in memory. It's beautiful, and it's wonderful, but it's also really easy for someone to add a second consumer of the same object, and send performance through the floor. Of course, one can avoid this particular pattern, but then you lose some of the very nice abstractions that laziness gives us. -- David Roundy Department of Physics Oregon State University

Don Stewart wrote:
jeff.polakow:
Hello,
One frequent criticism of Haskell (and by extension GHC) is that it has unpredictable performance and memory consumption. I personally do not find this to be the case. I suspect that most programmer confusion is rooted in shaky knowledge of lazy evaluation; and I have been able to fix, with relative ease, the various performance problems I've run into. However I am not doing any sort of performance critical computing (I care about minutes or seconds, but not about milliseconds).
I would like to know what others think about this. Is GHC predictable? Is a thorough knowledge of lazy evaluation good enough to write efficient (whatever that means to you) code? Or is intimate knowledge of GHC's innards necessary?
thanks, Jeff
PS I am conflating Haskell and GHC because I use GHC (with its extensions) and it produces (to my knowledge) the fastest code.
This has been my experience to. I'm not even sure where "unpredicatiblity" would even come in, other than though not understanding the demand patterns of the code.
It's relatively easy to look at the Core to get a precise understanding of the runtime behaviour.
I've also not found the GC unpredicatble either.
I offer up the following example: mean xs = sum xs / length xs Now try, say, "mean [1.. 1e9]", and watch GHC eat several GB of RAM. (!!) If we now rearrange this to mean = (\(s,n) -> s / n) . foldr (\x (s,n) -> let s' = s+x; n' = n+1 in s' `seq` n' `seq` (s', n')) (0,0) and run the same example, and watch it run in constant space. Of course, the first version is clearly readable, while the second one is almost utterly incomprehensible, especially to a beginner. (It's even more fun that you need all those seq calls in there to make it work properly.) The sad fact is that if you just write something in Haskell in a nice, declarative style, then roughly 20% of the time you get good performance, and 80% of the time you get laughably poor performance. For example, I sat down and spent the best part of a day writing an MD5 implementation. Eventually I got it so that all the test vectors work right. (Stupid little-endian nonsense... mutter mutter...) When I tried it on a file containing more than 1 MB of data... ooooohhhh dear... I gave up after waiting several minutes for an operation that the C implementation can do in milliseconds. I'm sure there's some way of fixing this, but... the source code is pretty damn large, and very messy as it is. I shudder to think what you'd need to do to it to speed it up. Of course, the first step in any serious attempt at performance improvement is to actually profile the code to figure out where the time is being spent. Laziness is *not* your friend here. I've more or less given up trying to comprehend the numbers I get back from the GHC profiles, because they apparently defy logic. I'm sure there's a reason to the madness somewhere, but... for nontrivial programs, it's just too hard to figure out what's going on. Probably the best part is that almost any nontrivial program you write spends 60% or more of its time doing GC rather than actual work. Good luck with the heap profiler. It's even more mysterious than the time profiles. ;-) In short, as a fairly new Haskell programmer, I find it completely impossibly to write code that doesn't crawl along at a snail's pace. Even when I manage to make it faster, I usually have no clue why. (E.g., adding a seq to a mergesort made it 10x faster. Why? Changing from strict ByteString to lazy ByteString made one program 100x faster. Why?) Note that I'm not *blaming* GHC for this - I think it's just inherantly very hard to predict performance in a lazy language. (Remember, deterministic isn't the same as predictable - see Chaos Theory for why.) I wish it wasn't - becuase I really *really* want to write all my complex compute-bounded programs in Haskell, because it makes algorithms so beautifully easy to express. But when you're trying to implement something that takes hours to run even in C...

On Mon, 2008-05-12 at 20:01 +0100, Andrew Coppin wrote:
In short, as a fairly new Haskell programmer, I find it completely impossibly to write code that doesn't crawl along at a snail's pace. Even when I manage to make it faster, I usually have no clue why. (E.g., adding a seq to a mergesort made it 10x faster. Why? Changing from strict ByteString to lazy ByteString made one program 100x faster. Why?)
This isn't just a little language issue. You know nothing about the data representations you're working with and then you're surprised that switching data representations makes a big difference. Have you looked up the time complexity of the operations you're using? Duncan

Andrew Coppin wrote:
I offer up the following example:
mean xs = sum xs / length xs
Now try, say, "mean [1.. 1e9]", and watch GHC eat several GB of RAM. (!!)
If we now rearrange this to
mean = (\(s,n) -> s / n) . foldr (\x (s,n) -> let s' = s+x; n' = n+1 in s' `seq` n' `seq` (s', n')) (0,0)
and run the same example, and watch it run in constant space.
Of course, the first version is clearly readable, while the second one is almost utterly incomprehensible, especially to a beginner. (It's even more fun that you need all those seq calls in there to make it work properly.)
You can write it like this: mean = uncurry (/) . foldl' (\(s,n) x -> ((,) $! s+x) $! n+1) (0,0) I don't think that's so bad. And for real-life examples, you almost never need the ($!)'s or seq's - your function will do some kind of pattern matching that will force the arguments. So really, all you need to remember is: if you're repeating a fast calculation across a big list, use foldl'. And insertWith', if you're storing the result in a Data.Map. That's about it.
The sad fact is that if you just write something in Haskell in a nice, declarative style, then roughly 20% of the time you get good performance, and 80% of the time you get laughably poor performance.
I don't know why you think that. I've written a wide variety of functions over the past few years. I find that when performance isn't good enough, it's because of the algorithm, not because of laziness. Laziness works for me, not against me. Of course, it depends what you mean by "good performance". I have never needed shootout-like performance. But to get that, you need some messy optimization in any language. Regards, Yitz

gale:
Andrew Coppin wrote:
I offer up the following example:
mean xs = sum xs / length xs
Now try, say, "mean [1.. 1e9]", and watch GHC eat several GB of RAM. (!!)
If we now rearrange this to
mean = (\(s,n) -> s / n) . foldr (\x (s,n) -> let s' = s+x; n' = n+1 in s' `seq` n' `seq` (s', n')) (0,0)
and run the same example, and watch it run in constant space.
Of course, the first version is clearly readable, while the second one is almost utterly incomprehensible, especially to a beginner. (It's even more fun that you need all those seq calls in there to make it work properly.)
You can write it like this:
mean = uncurry (/) . foldl' (\(s,n) x -> ((,) $! s+x) $! n+1) (0,0)
I don't think that's so bad. And for real-life examples, you almost never need the ($!)'s or seq's - your function will do some kind of pattern matching that will force the arguments. So really, all you need to remember is: if you're repeating a fast calculation across a big list, use foldl'. And insertWith', if you're storing the result in a Data.Map. That's about it.
The sad fact is that if you just write something in Haskell in a nice, declarative style, then roughly 20% of the time you get good performance, and 80% of the time you get laughably poor performance.
I don't know why you think that. I've written a wide variety of functions over the past few years. I find that when performance isn't good enough, it's because of the algorithm, not because of laziness. Laziness works for me, not against me.
Of course, it depends what you mean by "good performance". I have never needed shootout-like performance. But to get that, you need some messy optimization in any language.
We can actually get great performance here, {-# LANGUAGE TypeOperators #-} import Data.Array.Vector import Text.Printf mean :: UArr Double -> Double mean arr = b / fromIntegral a where k (n :*: s) a = n+1 :*: s+a a :*: b = foldlU k (0 :*: 0) arr :: (Int :*: Double) main = printf "%f\n" . mean $ enumFromToFracU 1 1e9 ghc -O2 $ time ./A 500000000.067109 ./A 3.69s user 0.00s system 99% cpu 3.692 total Versus on lists: import Data.List import Text.Printf import Data.Array.Vector mean :: [Double] -> Double mean arr = b / fromIntegral a where k (n :*: s) a = (n+1 :*: s+a) (a :*: b) = foldl' k (0 :*: 0) arr :: (Int :*: Double) main = printf "%f\n" . mean $ [1 .. 1e9] $ time ./A 500000000.067109 ./A 66.08s user 1.53s system 99% cpu 1:07.61 total Note the use of strict pairs. Key to ensuring the accumulators end up in registers. The performance difference here is due to fold (and all left folds) not fusing in normal build/foldr fusion. The vector version runs about the same speed as unoptimsed C. -- Don

On Tue, May 13, 2008 at 2:20 AM, Don Stewart
Note the use of strict pairs. Key to ensuring the accumulators end up in registers. The performance difference here is due to fold (and all left folds) not fusing in normal build/foldr fusion.
The vector version runs about the same speed as unoptimsed C.
These "tricks" going into Real World Haskell? When you say someone needs to get familiar with the "STG paper" it scares me (a beginner) off a little, an I've been making an effort to approach the papers. I could barely understand the Fusion one and getting familiar with compiler internals sounds like something I'd not be ready for. Probably if I really looked at ghc-core I'd be pleasantly surprised but I'm totally biased against even looking. Gcc is hard to read, thus ghc is also. So while you are right about all this when you say it, I think your goal is to persuade. RWH has some of the best practical prose I've read yet. Well done there. Hopefully chapter 26 will be crammed full of this stuff? -- Darrin

"Darrin Thompson"
On Tue, May 13, 2008 at 2:20 AM, Don Stewart
wrote: Note the use of strict pairs. Key to ensuring the accumulators end up in registers. The performance difference here is due to fold (and all left folds) not fusing in normal build/foldr fusion.
The vector version runs about the same speed as unoptimsed C.
These "tricks" going into Real World Haskell? When you say someone needs to get familiar with the "STG paper" it scares me (a beginner) off a little, an I've been making an effort to approach the papers. I could barely understand the Fusion one and getting familiar with compiler internals sounds like something I'd not be ready for. Probably if I really looked at ghc-core I'd be pleasantly surprised but I'm totally biased against even looking. Gcc is hard to read, thus ghc is also. So while you are right about all this when you say it, I think your goal is to persuade. RWH has some of the best practical prose I've read yet. Well done there. Hopefully chapter 26 will be crammed full of this stuff?
You know, sometimes I wish this would be the Eve forums, so that I could just answer "FAIL". Anyway, the goal of the Haskell community is to prevent success at any cost, so anything that is done to ease things for noobs that is not purely meant to prevent anyone from asking questions will be warded off by automatic defence systems of the big ivory tower, which are reinforced faster than you can ever hope to understand any topic. To get a bit more on-topic: I currently completely fail to implement a layout rule in Parsec because I don't understand its inner workings, and thus constantly mess up my state. Parsec's ease of usage is deceiving as soon as you use more than combinators: Suddenly the plumbing becomes important, and hackage is full of such things. Haskell has potentially infinite learning curves, and each one of them usually represents a wall. To make them crumble, you have to get used to not understand anything until you understand everything. -- (c) this sig last receiving data processing entity. Inspect headers for past copyright information. All rights reserved. Unauthorised copying, hiring, renting, public performance and/or broadcasting of this signature prohibited.

Achim Schneider wrote:
To get a bit more on-topic: I currently completely fail to implement a layout rule in Parsec because I don't understand its inner workings, and thus constantly mess up my state. Parsec's ease of usage is deceiving as soon as you use more than combinators: Suddenly the plumbing becomes important, and hackage is full of such things. Haskell has potentially infinite learning curves, and each one of them usually represents a wall. To make them crumble, you have to get used to not understand anything until you understand everything.
A big component of this is just that a high level of abstraction is involved. Something similar occurs in other languages, for programs that are written in a very abstract way. Some frameworks in e.g. Smalltalk, Java, or C++ are an example of this: full of classes whose domain is mainly internal to the framework, and you have to understand the framework's design principles in their full generality in order to be able to really understand the code. As a more concrete example related to Parsec, consider a generator of table-driven parsers written in C, and compare this to writing a recursive-descent parser directly. The code for the parser generator is completely impenetrable for someone who isn't familiar with the theory behind it, so if they want to change the generator's behavior, they're likely to be stuck. Whereas for a recursive descent parser for a single language, it's much easier to map between the ultimate application goals, and how those are accomplished in the code, without much special knowledge. Of course there are pros and cons on either side. One reason that DSLs work well is that when done right, so that abstraction leakage is minimal, they can insulate users from having to understand the underlying system. Embedded DSLs, like Parsec, seem more likely to suffer from problems in this area, although in that case the tradeoff is that you're getting to use them directly in a general-purpose language. Anton

Darrin Thompson wrote:
These "tricks" going into Real World Haskell?
Some will, yes. For example, the natural and naive way to write Andrew's "mean" function doesn't involve tuples at all: simply tail recurse with two accumulator parameters, and compute the mean at the end. GHC's strictness analyser does the right thing with this, so there's no need for seq, $!, or the like. It's about 3 lines of code.

Hello,
For example, the natural and naive way to write Andrew's "mean" function doesn't involve tuples at all: simply tail recurse with two accumulator parameters, and compute the mean at the end. GHC's strictness analyser does the right thing with this, so there's no need for seq, $!, or the like. It's about 3 lines of code.
Is this the code you mean? meanNat = go 0 0 where go s n [] = s / n go s n (x:xs) = go (s+x) (n+1) xs If so, bang patterns are still required bang patterns in ghc-6.8.2 to run in constant memory: meanNat = go 0 0 where go s n [] = s / n go !s !n (x:xs) = go (s+x) (n+1) xs Is there some other way to write it so that ghc will essentially insert the bangs for me? -Jeff --- This e-mail may contain confidential and/or privileged information. If you are not the intended recipient (or have received this e-mail in error) please notify the sender immediately and destroy this e-mail. Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden.

jeff.polakow:
Hello,
For example, the natural and naive way to write Andrew's "mean" function doesn't involve tuples at all: simply tail recurse with two accumulator parameters, and compute the mean at the end. GHC's strictness analyser does the right thing with this, so there's no need for seq, $!, or the like. It's about 3 lines of code.
Is this the code you mean?
meanNat = go 0 0 where go s n [] = s / n go s n (x:xs) = go (s+x) (n+1) xs If so, bang patterns are still required bang patterns in ghc-6.8.2 to run in constant memory:
meanNat = go 0 0 where go s n [] = s / n go !s !n (x:xs) = go (s+x) (n+1) xs
Is there some other way to write it so that ghc will essentially insert the bangs for me?
Yes, give a type annotation, constraining 'n' to Int. meanNat :: [Double] -> Double meanNat = go 0 0 where go :: Double -> Int -> [Double] -> Double go s n [] = s / fromIntegral n go s n (x:xs) = go (s+x) (n+1) xs And you get this loop: M.$wgo :: Double# -> Int# -> [Double] -> Double# M.$wgo = \ (ww_smN :: Double#) (ww1_smR :: Int#) (w_smT :: [Double]) -> case w_smT of wild_B1 { [] -> /## ww_smN (int2Double# ww1_smR); : x_a9k xs_a9l -> case x_a9k of wild1_am7 { D# y_am9 -> M.$wgo (+## ww_smN y_am9) (+# ww1_smR 1) xs_a9l } } Without the annotation you get: M.$wgo :: Double# -> Integer -> [Double] -> Double GHC sees through the strictness of I#. -- Don

dons:
jeff.polakow:
Hello,
For example, the natural and naive way to write Andrew's "mean" function doesn't involve tuples at all: simply tail recurse with two accumulator parameters, and compute the mean at the end. GHC's strictness analyser does the right thing with this, so there's no need for seq, $!, or the like. It's about 3 lines of code.
Is this the code you mean?
meanNat = go 0 0 where go s n [] = s / n go s n (x:xs) = go (s+x) (n+1) xs If so, bang patterns are still required bang patterns in ghc-6.8.2 to run in constant memory:
meanNat = go 0 0 where go s n [] = s / n go !s !n (x:xs) = go (s+x) (n+1) xs
Is there some other way to write it so that ghc will essentially insert the bangs for me?
Yes, give a type annotation, constraining 'n' to Int.
meanNat :: [Double] -> Double meanNat = go 0 0 where go :: Double -> Int -> [Double] -> Double go s n [] = s / fromIntegral n go s n (x:xs) = go (s+x) (n+1) xs
And you get this loop:
M.$wgo :: Double# -> Int# -> [Double] -> Double#
M.$wgo = \ (ww_smN :: Double#) (ww1_smR :: Int#) (w_smT :: [Double]) -> case w_smT of wild_B1 { [] -> /## ww_smN (int2Double# ww1_smR); : x_a9k xs_a9l -> case x_a9k of wild1_am7 { D# y_am9 -> M.$wgo (+## ww_smN y_am9) (+# ww1_smR 1) xs_a9l } }
Note this is pretty much identical to the code you get with a foldl' (though without the unboxed pair return): import Data.List import Text.Printf import Data.Array.Vector mean :: [Double] -> Double mean arr = b / fromIntegral a where k (n :*: s) a = (n+1 :*: s+a) (a :*: b) = foldl' k (0 :*: 0) arr :: (Int :*: Double) main = printf "%f\n" . mean $ [1 .. 1e9] Note I'm using strict pairs for the accumulator, instead of banging lazy pairs. $s$wlgo :: [Double] -> Double# -> Int# -> (# Int, Double #) $s$wlgo = \ (xs1_aMQ :: [Double]) (sc_sYK :: Double#) (sc1_sYL :: Int#) -> case xs1_aMQ of wild_aML { [] -> (# I# sc1_sYL, D# sc_sYK #); : x_aMP xs11_XMX -> case x_aMP of wild1_aOg { D# y_aOi -> $s$wlgo xs11_XMX (+## sc_sYK y_aOi) (+# sc1_sYL 1) } } -- Don

On Tuesday 13 May 2008, Jeff Polakow wrote:
Is this the code you mean?
meanNat = go 0 0 where go s n [] = s / n go s n (x:xs) = go (s+x) (n+1) xs
If so, bang patterns are still required bang patterns in ghc-6.8.2 to run in constant memory:
meanNat = go 0 0 where go s n [] = s / n go !s !n (x:xs) = go (s+x) (n+1) xs
Is there some other way to write it so that ghc will essentially insert the bangs for me?
It works fine here when compiled with -O or better. Perhaps that should be a tip in the book? Make sure you're compiling with optimizations. :) -- Dan

Darrin Thompson wrote:
These "tricks" going into Real World Haskell?
Seconded.
When you say someone needs to get familiar with the "STG paper" it scares me (a beginner) off a little, an I've been making an effort to approach the papers.
Well, I'm the sort of contrary person who reads random papers like that just for the fun of it. But when somebody says something like this, I don't think "ooo, that's scary", I think "ooo, somebody really ought to sit down and write a more gentle introduction". You really shouldn't *need* to know the exact implementation details to get some idea of what will perform well and what won't. But obviously you do need some kind of high-level understanding of what's going on. The STG paper isn't a good way to get that high-level overview.

andrewcoppin:
Darrin Thompson wrote:
These "tricks" going into Real World Haskell?
Seconded.
When you say someone needs to get familiar with the "STG paper" it scares me (a beginner) off a little, an I've been making an effort to approach the papers.
Well, I'm the sort of contrary person who reads random papers like that just for the fun of it. But when somebody says something like this, I don't think "ooo, that's scary", I think "ooo, somebody really ought to sit down and write a more gentle introduction". You really shouldn't *need* to know the exact implementation details to get some idea of what will perform well and what won't. But obviously you do need some kind of high-level understanding of what's going on. The STG paper isn't a good way to get that high-level overview.
Andrew, would you say you understand the original problem of why mean xs = sum xs / fromIntegral (length xs) was a bad idea now? Or why the left folds were a better solution? -- Don

Hello Don, Wednesday, May 14, 2008, 12:34:07 AM, you wrote:
high-level understanding of what's going on. The STG paper isn't a good way to get that high-level overview.
Andrew, would you say you understand the original problem of why
mean xs = sum xs / fromIntegral (length xs)
was a bad idea now? Or why the left folds were a better solution?
i think that the problem is just what xs can't be consumed while it generated because it's used two times and this may be understood just by learning reduction graph as strategy of Haskell evaluation. isn't? -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

Don Stewart wrote:
Andrew, would you say you understand the original problem of why
mean xs = sum xs / fromIntegral (length xs)
was a bad idea now? Or why the left folds were a better solution?
That definition of mean is wrong because it traverses the list twice. (Curiosity: would traversing it twice in parallel work any better?) As for the folds - I always *always* mix up left and right folds. Every single damn time I want a fold I have to look it up to see which one I want. I had a similar problem with learning to drive, by the way... the consequences there are of course much more serious than just crashing your _computer_... It was probably a poor example. The point I was attempting to make is that in Haskell, very subtle little things can have an unexpectedly profound effect. If you don't know what you're supposed to be looking for, it can be really hard to see why your program is performing badly. For what it's worth, I think I *do* currently have a reasonably gasp of how lazzy evaluation works, normal order reduction, graph machines, and so on. And yet, I still have trouble making my code go fast sometimes. As I said in another post, if I can track down some *specific* programs I've written and had problems with, maybe we can have a more meaningful debate about it.

On 2008 May 13, at 17:01, Andrew Coppin wrote:
That definition of mean is wrong because it traverses the list twice. (Curiosity: would traversing it twice in parallel work any better?) As for the folds - I always *always* mix up
It might work "better" but you're still wasting a core that could be put to better use doing something more sensible. It's pretty much always best to do all the calculations that require traversing a given list in a single traversal. -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

Brandon S. Allbery KF8NH wrote:
On 2008 May 13, at 17:01, Andrew Coppin wrote:
That definition of mean is wrong because it traverses the list twice. (Curiosity: would traversing it twice in parallel work any better?) As for the folds - I always *always* mix up
It might work "better" but you're still wasting a core that could be put to better use doing something more sensible. It's pretty much always best to do all the calculations that require traversing a given list in a single traversal.
Yeah, you're probably right there. I mean, with sufficient inlining, maybe you would end up with a loop that doesn't even construct any heap-allocated list nodes, just adds up the integers as fast as it can generate them. On the other hand, N(N+1)/2N is probably even faster! ;-) So I guess it's kinda of a daft example...

andrewcoppin:
Brandon S. Allbery KF8NH wrote:
On 2008 May 13, at 17:01, Andrew Coppin wrote:
That definition of mean is wrong because it traverses the list twice. (Curiosity: would traversing it twice in parallel work any better?) As for the folds - I always *always* mix up
Yes, using parallelism does work. It turns the naive definition into one which traverses the list on two cores at the same time, so the garbage collector does get clean up the list as each core races along it. mean ls = count `par` (total/count) where count = fromIntegral (length ls) total = foldl' (+) 0 ls It is kind of amazing how parallelism and laziness enable the naive definition to fall out as much the same as the explicitly recursive version. -- Don

On Tue, May 13, 2008 at 4:30 PM, Andrew Coppin
Well, I'm the sort of contrary person who reads random papers like that just for the fun of it. But when somebody says something like this, I don't think "ooo, that's scary", I think "ooo, somebody really ought to sit down and write a more gentle introduction". You really shouldn't *need* to know the exact implementation details to get some idea of what will perform well and what won't. But obviously you do need some kind of high-level understanding of what's going on. The STG paper isn't a good way to get that high-level overview.
I don't think anyone would disagree with that. Reflecting on what I already know, I can optimize python pretty well and the principles are pretty similar for C. The reason I can't just port that knowledge is that with GHC I'm in the land of optimizing for cache hits and at the same time I'm at a really high level of abstraction so I have to have some mental picture of how the plumbing connects. I'm hoping that the optimization chapter of RWH covers a lot of individual techniques. I think the sum of the techniques will shed light on the compiler internals in a practical way. But then I'm not the one doing the work. -- Darrin

Hello,
I offer up the following example:
This is an instructive example.
mean xs = sum xs / length xs
In order to type-check, I actually need to write something like: mean xs = sum xs / fromIntegral (length xs) There are other ways of get the numeric types to match correctly, but this is fairly general. Then, I immediately blow my stack if I try something like: mean [1..1000000000]. The culprit is actually sum which is defined in the base libraries as either a foldl or a direct recursion depending on a compiler flag. In either case, the code is not strict enough; just trying to compute: sum [1..10000000] blows the stack. This can be easily fixed by defining a suitable strict sum: sum' = foldl' (+) 0 and now sum' has constant space. We could try to redefine mean using sum': mean1 xs = sum' xs / fromIntegral (length xs) but this still gobbles up memory. The reason is that xs is used twice and cannot be discarded as it is generated. So we must move to a direct fold, as you did, to get a space efficient mean.
If we now rearrange this to
mean = (\(s,n) -> s / n) . foldr (\x (s,n) -> let s' = s+x; n' = n+1 in s' `seq` n' `seq` (s', n')) (0,0)
and run the same example, and watch it run in constant space.
This code actually blows the stack on my machine just like the first naive mean. Foldl is perhaps more intuitive to use here, since we are summing the numbers as we encounter them while walking down the list, and there is a strict version, foldl', provided in the base libraries. mean2 = uncurry (/) . foldl' (\(s,n) x -> (s+x, n+1)) (0,0) However, this still gobbles up memory... the reason is that pairs are lazy. So we need a way to force the (s+x) and (n+1). An easy, and unobtrusive way to do this is to use strict pattern matching: mean2 = uncurry (/) . foldl' (\(!s, !n) x -> (s+x, n+1)) (0,0) Now we can run: mean2 [1..1000000000] in constant space. While using an explicit foldl is less readable than the direct version (especially to a beginner), it is a standard functional idiom. Furthermore, a good understanding of lazy evaluation should be enough to guide you to using the strict foldl' and then then strict patterns. Is this a reasonable analysis? Also, we've made no attempt to address speed. However, I would argue that the code's performance time is predictable-- it grows linearly with the size of the list. Improving the performance time is another matter that requires knowing about the internal representation of the various types being used. -Jeff --- This e-mail may contain confidential and/or privileged information. If you are not the intended recipient (or have received this e-mail in error) please notify the sender immediately and destroy this e-mail. Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden.

I don't know why, but perhaps beginners may expect too much from the laziness, almost to the level of magic (me too, in the beginning!). In an eager language, a function like mean :: (Fractional a) => [a] -> a expects the *whole* list before it can calculate the mean, and the question of the 'mean' function consuming memory does not arise. We look for other methods of finding the mean of very long lists. We do not expect such a function in C or Scheme to succeed when the number of numbers is more than that can fit the memory. (It will not even be called; the list creation itself will not succeed.) Lazy languages allow us to use the same abstraction while allowing doing more. But it is not magic, it is plain normal order evaluation. Just as every Scheme programmer or C programmer must understand the consequences of the fact that the arguments to a function will be evaluated first, a Haskell programmer must understand the consequences of the fact that the arguments to a function will be evaluated only when needed/forced. Perhaps an early emphasis on an understanding of normal order evaluation is needed while learning Haskell in order to stop expecting magic, especially when one comes prejudiced from eager languages. Regards Abhay

On 2008 May 12, at 22:18, Jeff Polakow wrote:
Then, I immediately blow my stack if I try something like:
mean [1..1000000000].
The culprit is actually sum which is defined in the base libraries as either a foldl or a direct recursion depending on a compiler flag. In either case, the code is not strict enough; just trying to compute:
sum [1..10000000]
There's also an insufficient-laziness issue with enumerations in at least some versions of the standard library, IIRC. meaning that just saying [1..10000000] can introduce a space leak that can lead to a stack blowout. -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

Jeff Polakow wrote:
[...] This can be easily fixed by defining a suitable strict sum:
sum' = foldl' (+) 0
and now sum' has constant space. We could try to redefine mean using sum':
mean1 xs = sum' xs / fromIntegral (length xs)
but this still gobbles up memory. The reason is that xs is used twice and cannot be discarded as it is generated. As an experiment I tried using "pointfree" to see if it would do something similar.
$ pointfree "\xs -> foldl' (+) 0 xs / fromIntegral (length xs)" ap ((/) . foldl' (+) 0) (fromIntegral . length)
But when I try this in GHCi 6.8.2 I get:
Prelude Data.List Control.Monad> let mean2 = ap ((/) . foldl' (+) 0) (fromIntegral . length)
<interactive>:1:12: No instance for (Monad ((->) [b])) arising from a use of `ap' at <interactive>:1:12-58 Possible fix: add an instance declaration for (Monad ((->) [b])) In the expression: ap ((/) . foldl' (+) 0) (fromIntegral . length) In the definition of `mean2': mean2 = ap ((/) . foldl' (+) 0) (fromIntegral . length)
Any ideas? Would the auto-generated pointfree version be any better if it could be made to work? Paul.

On Tue, May 13, 2008 at 12:48 PM, Paul Johnson
$ pointfree "\xs -> foldl' (+) 0 xs / fromIntegral (length xs)" ap ((/) . foldl' (+) 0) (fromIntegral . length)
But when I try this in GHCi 6.8.2 I get:
Prelude Data.List Control.Monad> let mean2 = ap ((/) . foldl' (+) 0) (fromIntegral . length)
<interactive>:1:12: No instance for (Monad ((->) [b])) arising from a use of `ap' at <interactive>:1:12-58 Possible fix: add an instance declaration for (Monad ((->) [b])) In the expression: ap ((/) . foldl' (+) 0) (fromIntegral . length) In the definition of `mean2': mean2 = ap ((/) . foldl' (+) 0) (fromIntegral . length)
It's using the Monad ((->) r) instance, which doesn't exist by default. import Control.Monad.Instances to get it. Luke

Hello,
$ pointfree "\xs -> foldl' (+) 0 xs / fromIntegral (length xs)" ap ((/) . foldl' (+) 0) (fromIntegral . length)
This will have the same space usage as the pointed version. You can see this by looking at the monad instance for ((->) r): instance Monad ((->) r) where return = const f >>= k = \ r -> k (f r) r -Jeff --- This e-mail may contain confidential and/or privileged information. If you are not the intended recipient (or have received this e-mail in error) please notify the sender immediately and destroy this e-mail. Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden.

Jeff Polakow wrote:
Then, I immediately blow my stack if I try something like:
mean [1..1000000000].
The culprit is actually sum which is defined in the base libraries as either a foldl or a direct recursion depending on a compiler flag. In either case, the code is not strict enough; just trying to compute:
sum [1..10000000]
blows the stack. This can be easily fixed by defining a suitable strict sum:
sum' = foldl' (+) 0
and now sum' has constant space.
OK *now* I'm worried... I thought sum was _already_ defined this way? o_O

On Mon, May 12, 2008 at 08:01:53PM +0100, Andrew Coppin wrote:
I offer up the following example:
mean xs = sum xs / length xs
Now try, say, "mean [1.. 1e9]", and watch GHC eat several GB of RAM. (!!)
I don't see why the performance implications of this program are surprising. Just ask any programmer used to a strict language how much memory "[1 .. 1e9]" will require.
If we now rearrange this to
mean = (\(s,n) -> s / n) . foldr (\x (s,n) -> let s' = s+x; n' = n+1 in s' `seq` n' `seq` (s', n')) (0,0)
and run the same example, and watch it run in constant space.
This will use linear stack space. You probably meant to use foldl'? Better: mean = uncurry (/) . foldl' f (0, 0) where f (!s, !n) x = (s + x, n + 1) -- or, if you require Haskell '98: f (s, n) x = s `seq` n `seq` (s + x, n + 1) This version is very legible in my opinion. In fact, the algorithm is identical to what I'd write in C. Also, "mean [1 .. 1e9]" will actually work in Haskell, while in C you'll just run out of memory. Cheers, Spencer Janssen

On 2008-05-12, Andrew Coppin
(Stupid little-endian nonsense... mutter mutter...)
I used to be a big-endian advocate, on the principle that it doesn't really matter, and it was standard network byte order. Now I'm convinced that little endian is the way to go, as bit number n should have value 2^n, byte number n should have value 256^n, and so forth. Yes, in human to human communication there is value in having the most significant bit first. Not really true for computer-to-computer communication. -- Aaron Denney -><-

Aaron Denney
I used to be a big-endian advocate, on the principle that it doesn't really matter, and it was standard network byte order. Now I'm convinced that little endian is the way to go
I guess it depends a lot on what you grew up with. The names (little/big endian) are incredibly apt. The only argument I can come up with, is that big endian seems to make more sense for 'od': % echo foobar > foo % od -x foo 0000000 6f66 626f 7261 000a 0000007 Since this is little endian, the output corresponds to "of bo ra \0\n". So I guess the argument is that for big-endian, the concatenation of hex numbers is invariant with respect to word sizes? -k -- If I haven't seen further, it is by standing in the footprints of giants

On Tue 2008-05-13 20:46, Ketil Malde wrote:
Aaron Denney
writes: I guess it depends a lot on what you grew up with. The names (little/big endian) are incredibly apt.
The only argument I can come up with, is that big endian seems to make more sense for 'od':
% echo foobar > foo % od -x foo 0000000 6f66 626f 7261 000a 0000007
This, of course, is because `od -x' regards the input as 16-bit integers. We can get saner output if we regard it is 8-bit integers. $ od -t x1 foo 0000000 66 6f 6f 62 61 72 0a 0000007
Now I'm convinced that little endian is the way to go, as bit number n should have value 2^n, byte number n should have value 256^n, and so forth.
It's not that simple with bits. They lack consistency just like the usual US date format and the way Germans read numbers. Jed

Jed Brown
This, of course, is because `od -x' regards the input as 16-bit integers. We can get saner output if we regard it is 8-bit integers.
Yes, of course. The point was that for big-endian, the word size won't matter. Little-endian words will be reversed with respect to the normal (left-to-right, most significant first) way we print numbers. -k -- If I haven't seen further, it is by standing in the footprints of giants

On 2008-05-13, Ketil Malde
Jed Brown
writes: This, of course, is because `od -x' regards the input as 16-bit integers. We can get saner output if we regard it is 8-bit integers.
Yes, of course. The point was that for big-endian, the word size won't matter. Little-endian words will be reversed with respect to the normal (left-to-right, most significant first) way we print numbers.
Right. Because we print numbers backwards. -- Aaron Denney -><-

Am Dienstag, 13. Mai 2008 21:28 schrieb Aaron Denney:
On 2008-05-13, Ketil Malde
wrote: Jed Brown
writes: This, of course, is because `od -x' regards the input as 16-bit integers. We can get saner output if we regard it is 8-bit integers.
Yes, of course. The point was that for big-endian, the word size won't matter. Little-endian words will be reversed with respect to the normal (left-to-right, most significant first) way we print numbers.
Right. Because we print numbers backwards.
Try hebrew or arab then, they have the least significant digit first in reading order :)

On 2008-05-13, Jed Brown
Now I'm convinced that little endian is the way to go, as bit number n should have value 2^n, byte number n should have value 256^n, and so forth.
It's not that simple with bits. They lack consistency just like the usual US date format and the way Germans read numbers.
Yes. I'm saying what should be, not what is. I'm saying one of those ways is wrong, wrong, wrong. It usually doesn't matter in practice, because writes to e.g. RAM effectively happen at byte-level or higher, making the internal labels fairly arbitrary. It matters and can cause confusion in actual serial protocols, of course, which have been making a resurgence in recent years, though again, the bit order in these are well understood. Just possibly wrong. -- Aaron Denney -><-

Jed Brown
It's not that simple with bits. They lack consistency just like the usual US date format and the way Germans read numbers.
So you claim that you pronounce 14 tenty-four? In German pronunciation is completely uniform from 13 to 99. -- (c) this sig last receiving data processing entity. Inspect headers for past copyright information. All rights reserved. Unauthorised copying, hiring, renting, public performance and/or broadcasting of this signature prohibited.

On Tue 2008-05-13 22:14, Achim Schneider wrote:
Jed Brown
wrote: It's not that simple with bits. They lack consistency just like the usual US date format and the way Germans read numbers.
So you claim that you pronounce 14 tenty-four? In German pronunciation is completely uniform from 13 to 99.
I would argue that 100n+11 to 100n+19 are special cases in both German and English, but only 100n+11 to 100n+15 in Spanish. In any case, the order of the digits is dependent on where the decimal falls. If the ordering is pure little endian (not x86 halfway) or big endian, the bit order is not dependent on the width of the field. Converting breaks this nice property. Convention is to write numbers in big endian and it would be nice if there were fewer exceptions. Yet another argument for ISO 8601 dates. A somewhat dramatic change would be to put the exponent first in scientific notation. Alas, this seems unlikely to happen. Jed

On Tue, 13 May 2008, Achim Schneider wrote:
Jed Brown
wrote: It's not that simple with bits. They lack consistency just like the usual US date format and the way Germans read numbers.
So you claim that you pronounce 14 tenty-four? In German pronunciation is completely uniform from 13 to 99.

Henning Thielemann
On Tue, 13 May 2008, Achim Schneider wrote:
Jed Brown
wrote: It's not that simple with bits. They lack consistency just like the usual US date format and the way Germans read numbers.
So you claim that you pronounce 14 tenty-four? In German pronunciation is completely uniform from 13 to 99.
Dammit! Don't affirm the stereotype that any group of like-minded Germans forms an association to affirm importance and ultimately get drowned by the "well I don't care at all" mentality of the rest. -- (c) this sig last receiving data processing entity. Inspect headers for past copyright information. All rights reserved. Unauthorised copying, hiring, renting, public performance and/or broadcasting of this signature prohibited.

Henning Thielemann wrote:
On Tue, 13 May 2008, Achim Schneider wrote:
Jed Brown
wrote: It's not that simple with bits. They lack consistency just like the usual US date format and the way Germans read numbers.
So you claim that you pronounce 14 tenty-four? In German pronunciation is completely uniform from 13 to 99.
So I've always wondered, if you are writing down a number being dictated (slowly) by someone else, like 234, do you write the 2, then leave space and write the 4, then go back and fill in with 3? Or do you push the 4 onto the stack until the 3 arrives, and write 34 at once. If the latter, does this imply that Germans have a harder time with tail recursion?

On 2008 May 14, at 14:34, Dan Weston wrote:
So I've always wondered, if you are writing down a number being dictated (slowly) by someone else, like 234, do you write the 2, then leave space and write the 4, then go back and fill in with 3? Or do you push the 4 onto the stack until the 3 arrives, and write 34 at once.
If the latter, does this imply that Germans have a harder time with tail recursion?
Stacking, surely: recall the joke about the German professor who saved all his verbs for the end of the lecture. :) -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

On Wed, 14 May 2008, Brandon S. Allbery KF8NH wrote:
On 2008 May 14, at 14:34, Dan Weston wrote:
So I've always wondered, if you are writing down a number being dictated (slowly) by someone else, like 234, do you write the 2, then leave space and write the 4, then go back and fill in with 3? Or do you push the 4 onto the stack until the 3 arrives, and write 34 at once.
If the latter, does this imply that Germans have a harder time with tail recursion?
Stacking, surely: recall the joke about the German professor who saved all his verbs for the end of the lecture. :)
Interesting to know what jokes are told about Germans. 8-] So, do English professors save their prepositions for the end of a lecture?

On Wed, 2008-05-14 at 20:59 +0200, Henning Thielemann wrote: . . .
Interesting to know what jokes are told about Germans. 8-] So, do English professors save their prepositions for the end of a lecture? This seems peculiarly apropos:
I lately lost a preposition. It hid, I thought, beneath my chair, And angrily I cried "Perdition! Up from out of in under there!" Correctness is my vade mecum And straggling phrases I abhor. Still, I wonder, what should he come Up from out of in under for? - Morris Bishop -- Bill Wood

On Wed, 14 May 2008, Dan Weston wrote:
Henning Thielemann wrote:
So I've always wondered, if you are writing down a number being dictated (slowly) by someone else, like 234, do you write the 2, then leave space and write the 4, then go back and fill in with 3? Or do you push the 4 onto the stack until the 3 arrives, and write 34 at once.
Of course, we write down 243, realize the mistake and rewrite the number. :-) Actually, many pupils have problems with the mixed order of digits and give solutions like this one in examinations: 8 * 8 = 46 because they write the digits as they speak them. That's one of the reasons the mentioned assocation was founded for.

Henning Thielemann
Of course, we write down 243, realize the mistake and rewrite the number. :-) Actually, many pupils have problems with the mixed order of digits and give solutions like this one in examinations: 8 * 8 = 46 because they write the digits as they speak them. That's one of the reasons the mentioned assocation was founded for.
Funny enough you never hear stories about pupils writing 7 + 7 = 41 -- (c) this sig last receiving data processing entity. Inspect headers for past copyright information. All rights reserved. Unauthorised copying, hiring, renting, public performance and/or broadcasting of this signature prohibited.

It's not that simple with bits. They lack consistency just like the usual US date format and the way Germans read numbers.
So you claim that you pronounce 14 tenty-four? In German pronunciation is completely uniform from 13 to 99.
So I've always wondered, if you are writing down a number being dictated (slowly) by someone else, like 234, do you write the 2, then leave space and write the 4, then go back and fill in with 3? Or do you push the 4 onto the stack until the 3 arrives, and write 34 at once.
Germans have no problems with sentences which though started at the beginning when observed closely and in the light of day (none of which adds anything to the content of the sentence in which the very parenthetical remark you -dear reader- are reading at this very moment while wondering whether the writer -dear me- is ever going to reach his point -if, in fact, there is a point (of which one cannot always be entirely sure until one has stored and processed the whole construct from beginning to end and thought it over carefully at least once more because who knows, sense appears here and there, now and then, to this one and that one, and how are you, Mr. Wilson?
If the latter, does this imply that Germans have a harder time with tail recursion?
you mean as in returning from a different context than the one we decended into? we'd never do such a thing, honestly!-) then again, Jane Austen was happy enough writing about her characters not being "one and twenty", so perhaps that is just a lost art?-) claus

On 14 May 2008, at 2:13 PM, Claus Reinke wrote:
It's not that simple with bits. They lack consistency just like the usual US date format and the way Germans read numbers.
So you claim that you pronounce 14 tenty-four? In German pronunciation is completely uniform from 13 to 99. http://www.verein-zwanzigeins.de/ So I've always wondered, if you are writing down a number being dictated (slowly) by someone else, like 234, do you write the 2, then leave space and write the 4, then go back and fill in with 3? Or do you push the 4 onto the stack until the 3 arrives, and write 34 at once.
Germans have no problems with sentences which though started at the beginning when observed closely and in the light of day (none of which adds anything to the content of the sentence in which the very parenthetical remark you -dear reader- are reading at this very moment while wondering whether the writer -dear me- is ever going to reach his point -if, in fact, there is a point (of which one cannot always be entirely sure until one has stored and processed the whole construct from beginning to end and thought it over carefully at least once more because who knows, sense appears here and there, now and then, to this one and that one, and how are you, Mr. Wilson?
If the latter, does this imply that Germans have a harder time with tail recursion?
you mean as in returning from a different context than the one we decended into? we'd never do such a thing, honestly!-)
then again, Jane Austen was happy enough writing about her characters not being "one and twenty", so perhaps that is just a lost art?-)
Murthered, by the same revolutionaries who destroyed the rest of the world Jane Austen wrote about. jcc

Claus Reinke wrote:
Germans have no problems with sentences which though started at the beginning when observed closely and in the light of day (none of which adds anything to the content of the sentence in which the very parenthetical remark you -dear reader- are reading at this very moment while wondering whether the writer -dear me- is ever going to reach his point -if, in fact, there is a point (of which one cannot always be entirely sure until one has stored and processed the whole construct from beginning to end and thought it over carefully at least once more because who knows, sense appears here and there, now and then, to this one and that one, and how are you, Mr. Wilson?
Unmatched open parentheses.
you mean as in returning from a different context than the one we decended into? we'd never do such a thing, honestly!-)
then again, Jane Austen was happy enough writing about her characters not being "one and twenty", so perhaps that is just a lost art?-)
Oh, I see the matching closing parentheses now. Perfect... 72MB freed by GC in 2.3ms.

"Claus Reinke"
then again, Jane Austen was happy enough writing about her characters not being "one and twenty", so perhaps that is just a lost art?-)
I'm quite content as long as I'm not "four twenty nineteen". -- (c) this sig last receiving data processing entity. Inspect headers for past copyright information. All rights reserved. Unauthorised copying, hiring, renting, public performance and/or broadcasting of this signature prohibited.

So I've always wondered, if you are writing down a number being dictated (slowly) by someone else, like 234, do you write the 2, then leave space and write the 4, then go back and fill in with 3? Or do you push the 4 onto the stack until the 3 arrives, and write 34 at once.
My German professor told us a story, set in WWII: Two British pilots shot down behind enemy lines, who had received very thorough training on German culture, current sports, etc., successfully blended in with the native Germans for some time until someone noticed them in a cafe writing down the sum on their bill in left-to-right order. They were summarily shot. Not that I have any idea whether this is based on truth or not, or whether Germans, in fact, write the last two digits in reverse order. Also, Claus's reply gives me a headache. Eric

Aaron Denney wrote:
On 2008-05-12, Andrew Coppin
wrote: (Stupid little-endian nonsense... mutter mutter...)
I used to be a big-endian advocate, on the principle that it doesn't really matter, and it was standard network byte order. Now I'm convinced that little endian is the way to go, as bit number n should have value 2^n, byte number n should have value 256^n, and so forth.
Yes, in human to human communication there is value in having the most significant bit first. Not really true for computer-to-computer communication.
It just annoys me that the number 0x12345678 has to be transmuted into 0x78563412 just because Intel says so. Why make everything so complicated? [Oh GOD I hope I didn't just start a Holy War...]

On 2008-05-13, Andrew Coppin
Aaron Denney wrote:
On 2008-05-12, Andrew Coppin
wrote: (Stupid little-endian nonsense... mutter mutter...)
I used to be a big-endian advocate, on the principle that it doesn't really matter, and it was standard network byte order. Now I'm convinced that little endian is the way to go, as bit number n should have value 2^n, byte number n should have value 256^n, and so forth.
Yes, in human to human communication there is value in having the most significant bit first. Not really true for computer-to-computer communication.
It just annoys me that the number 0x12345678 has to be transmuted into 0x78563412 just because Intel says so. Why make everything so complicated?
[Oh GOD I hope I didn't just start a Holy War...]
On the other hand I appreciate that the consecutive memory locations containing [1][0][0][0] are the number 1, no matter whether you're reading a byte, a short, or an int. -- Aaron Denney -><-

On 2008 May 13, at 17:12, Andrew Coppin wrote:
[Oh GOD I hope I didn't just start a Holy War...]
Er, I'd say it's already well in progress. :/ -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

Brandon S. Allbery KF8NH wrote:
On 2008 May 13, at 17:12, Andrew Coppin wrote:
[Oh GOD I hope I didn't just start a Holy War...]
Er, I'd say it's already well in progress. :/
Oh dear. Appologies to everybody who doesn't actually _care_ about which endian mode their computer uses...

Also, the way we write numbers is little endian when writing in
Arabic; we just forgot to reverse the digits when we borrowed the
notation.
Little endian is more logical unless you also number your bits with
MSB as bit 0.
On Tue, May 13, 2008 at 7:35 PM, Aaron Denney
On 2008-05-12, Andrew Coppin
wrote: (Stupid little-endian nonsense... mutter mutter...)
I used to be a big-endian advocate, on the principle that it doesn't really matter, and it was standard network byte order. Now I'm convinced that little endian is the way to go, as bit number n should have value 2^n, byte number n should have value 256^n, and so forth.
Yes, in human to human communication there is value in having the most significant bit first. Not really true for computer-to-computer communication.
-- Aaron Denney -><-
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

As a beginner, I had found the behaviour quite unpredictable. But with time
I found that I could reason out the behaviour with my slowly growing
knowledge of laziness. I don't spot all the places in my program that will
suck while writing a program, but post facto many things become clear. (And
then there is the profiler!)
GHC's internal details had been never necessary to me! I aspire to write
computationally heavy programs in haskell in future, and I have been
successful in reaching factors of 3 to 5 with C programs (though I have not
been upto factors of 1 for which I find claims here and there) without any
knowledge of GHC internals. But the GHC user guide is immensely valuable.
I would like to note that beginners' codes are many times time/memory
consuming even in slighly complicated cases, and it may be a big source of
frustration and turn-away if they don't stick up and pursue. This is not a
problem of GHC, or even Haskell; it generally applies to functional
programming.
These are my opinions; I am only an advanced beginner :)
2008/5/10 Jeff Polakow
Hello,
One frequent criticism of Haskell (and by extension GHC) is that it has unpredictable performance and memory consumption. I personally do not find this to be the case. I suspect that most programmer confusion is rooted in shaky knowledge of lazy evaluation; and I have been able to fix, with relative ease, the various performance problems I've run into. However I am not doing any sort of performance critical computing (I care about minutes or seconds, but not about milliseconds).
I would like to know what others think about this. Is GHC predictable? Is a thorough knowledge of lazy evaluation good enough to write efficient (whatever that means to you) code? Or is intimate knowledge of GHC's innards necessary?
thanks, Jeff
PS I am conflating Haskell and GHC because I use GHC (with its extensions) and it produces (to my knowledge) the fastest code.
---
This e-mail may contain confidential and/or privileged information. If you are not the intended recipient (or have received this e-mail in error) please notify the sender immediately and destroy this e-mail. Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Advanced technology ought to look like unpredictable magic. My experience with lazy evaluation is such that every time a program is slower or bulkier than I presumed, it is not arbitrariness, it is something new to learn. My experience with GHC is such that every surprise it gives me is a pleasant surprise: it produces a program faster or leaner than lazy evaluation would have it. "Where has the box gone?"
participants (29)
-
Aaron Denney
-
Abhay Parvate
-
Achim Schneider
-
Albert Y. C. Lai
-
Andrew Coppin
-
Anton van Straaten
-
Bill
-
Brandon S. Allbery KF8NH
-
Bryan O'Sullivan
-
Bulat Ziganshin
-
Claus Reinke
-
Dan Doel
-
Dan Weston
-
Daniel Fischer
-
Darrin Thompson
-
David Roundy
-
Don Stewart
-
Duncan Coutts
-
Eric Stansifer
-
Henning Thielemann
-
Jed Brown
-
Jeff Polakow
-
Jonathan Cast
-
Ketil Malde
-
Lennart Augustsson
-
Luke Palmer
-
Paul Johnson
-
Spencer Janssen
-
Yitzchak Gale