Re: [Haskell-cafe] Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Andrew Coppin
Stefan O'Rear wrote: Mr. C++ apparently isn't a very good C++ programmer, since his best effort absolutely *pales* in comparison to Julian Seward's BWT: [EMAIL PROTECTED]:/usr/local/src/hpaste$ head -c 135000 /usr/share/dict/words | (time bzip2 -vvv) /dev/null (stdin): block 1: crc =

Re: [Haskell-cafe] Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Donald Bruce Stewart
...OK...so how do I make Haskell go faster still? Presumably by transforming the code into an ugly mess that nobody can read any more...? http://haskell.org/haskellwiki/Performance -- Don ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org

Re: [Haskell-cafe] Haskell version of ray tracer code is much slower than the original ML

2007-06-23 Thread Andrew Coppin
Donald Bruce Stewart wrote: Don't use -O3 , its *worse* than -O2, and somewhere between -Onot and -O iirc, ghc -O2 -funbox-strict-fields -fvia-C -optc-O2 -optc-ffast-math -fexcess-precision Are usually fairly good. Is this likely to be fixed ever?

Re: [Haskell-cafe] Haskell version of ray tracer code is much slowerthan the original ML

2007-06-23 Thread Philip Armstrong
On Sat, Jun 23, 2007 at 12:42:33AM +0100, Claus Reinke wrote: http://www.kantaka.co.uk/darcs/ray try making ray_sphere and intersect' local to intersect, then drop their constant ray parameter. saves me 25%. claus I see: I guess I'm paying for laziness in the first parameter to intersect'

Re: [Haskell-cafe] Haskell version of ray tracer code is much slower than the original ML

2007-06-23 Thread Philip Armstrong
On Sat, Jun 23, 2007 at 08:49:15AM +0100, Andrew Coppin wrote: Donald Bruce Stewart wrote: Don't use -O3 , its *worse* than -O2, and somewhere between -Onot and -O iirc, Is this likely to be fixed ever? There is at least a bug report for it IIRC. Phil -- http://www.kantaka.co.uk/ .oOo.

Re: [Haskell-cafe] Haskell version of ray tracer code is much slower than the original ML

2007-06-23 Thread Philip Armstrong
On Sat, Jun 23, 2007 at 03:28:53AM +0100, Jon Harrop wrote: What architecture, platform, compiler versions and compile lines are you using? 32-bit x86, Debian unstable, gcc version 4.1.2, OCaml version 3.09.2-9, GHC version 6.6.1, compile line in the Makfile at

Re: [Haskell-cafe] directory tree?

2007-06-23 Thread Alexis Hazell
On Saturday 23 June 2007 08:18, Chad Scherrer wrote: Now, the UNIX command doesn't really cut it, because it complains there are too many files, Sounds like a case for xargs(1)? Alexis. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org

[Haskell-cafe] Re: copy-on-write monad?

2007-06-23 Thread oleg
Greg Meredith wrote: First, has anyone worked out a monadic approach to copy-on-write? (And, Is there any analysis of perf characteristics of said monadic schemes?) If you use Zippers (Huet's or generic ones) with functional updates, copy-on-write comes out automatically and by default. This

Re: [Haskell-cafe] FFI and Excel VBA

2007-06-23 Thread Lennart Augustsson
There is a number of problems, I'm not sure which one you are encountering. Here are some that I remember: The sample C code doesn't shut down the ghc runtime properly when the DLL is unloaded. This causes a timer interrupt to jump into the void. This is easily fixed with a couple of more

Re: [Haskell-cafe] Re: Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Andrew Coppin
apfelmus wrote: Note that the one usually adds an end of string character $ in the Burrows-Wheeler transform for compression such that sorting rotated strings becomes sorting suffices. Yeah, I noticed that the output from by program can never actually be reverted to its original form. ;-)

Re: [Haskell-cafe] Odd lack of laziness

2007-06-23 Thread Chaddaï Fouché
2007/6/22, Andrew Coppin [EMAIL PROTECTED]: Chaddaï Fouché wrote: You should be using BS.null f rather than BS.length f 0. While we're on the subject... anybody know a neat way to check, say, whether a list contains exactly 1 element? (Obviously pattern matching can do it, but that requires

Re: [Haskell-cafe] Haskell version of ray tracer code is much slower than the original ML

2007-06-23 Thread Jon Harrop
On Saturday 23 June 2007 08:58:10 Philip Armstrong wrote: On Sat, Jun 23, 2007 at 03:28:53AM +0100, Jon Harrop wrote: What architecture, platform, compiler versions and compile lines are you using? 32-bit x86... Intel or AMD?

Re: [Haskell-cafe] Haskell version of ray tracer code is much slowerthan the original ML

2007-06-23 Thread Jon Harrop
On Saturday 23 June 2007 08:54:11 Philip Armstrong wrote: On Sat, Jun 23, 2007 at 12:42:33AM +0100, Claus Reinke wrote: http://www.kantaka.co.uk/darcs/ray try making ray_sphere and intersect' local to intersect, then drop their constant ray parameter. saves me 25%. claus I see: I guess

[Haskell-cafe] Re: Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread apfelmus
Andrew Coppin wrote: apfelmus wrote: Note that the one usually adds an end of string character $ in the Burrows-Wheeler transform for compression such that sorting rotated strings becomes sorting suffices. Yeah, I noticed that the output from by program can never actually be reverted to

Re: [Haskell-cafe] Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Andrew Coppin
Bulat Ziganshin wrote: Hello Andrew, bwt transformation is very good researched area, so probably you will not get decent performance (megabytes per second) without lot of work. Hey, I'm just glad I managed to get within striking distance of Mr C++. So much for Haskell being inherently

Re: [Haskell-cafe] Odd lack of laziness

2007-06-23 Thread Thomas Conway
On 6/23/07, Chaddaï Fouché [EMAIL PROTECTED] wrote: isLength1 [x] = Ok isLength _ = Nok excellent. How is [x] big in any way ? If you need to test for more than one element you can just put put a guard with length Invoking length is more strict than is necessary, though this may not be a

Re: [Haskell-cafe] Haskell version of ray tracer code is muchslowerthan the original ML

2007-06-23 Thread Claus Reinke
http://www.kantaka.co.uk/darcs/ray try making ray_sphere and intersect' local to intersect, then drop their constant ray parameter. saves me 25%. claus also try replacing that (foldl' intersect') with (foldr (flip intersect'))! using a recent ghc head instead of ghc-6.6.1 also seems to make

[Haskell-cafe] A Query Language for Haskell Terms

2007-06-23 Thread Pasqualino 'Titto' Assini
Hi, I am writing a Web application using HAppS. As all HAppS apps, it represents its internal state as a Haskell term (HAppS automagically provides persistence and transactions). It is a neat and efficient solution, you can write your data model entirely in Haskell and, at least for read-only

Re[2]: [Haskell-cafe] Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Bulat Ziganshin
Hello Andrew, Saturday, June 23, 2007, 2:45:01 PM, you wrote: Hey, I'm just glad I managed to get within striking distance of Mr C++. So much for Haskell being inherently less performant. :-P my little analysis says that it's probably due to different sort() implementations, so this says

Re: [Haskell-cafe] Re: Lambdabot

2007-06-23 Thread Daniel Fischer
Am Freitag, 22. Juni 2007 22:43 schrieb Stefan O'Rear: On Fri, Jun 22, 2007 at 10:37:55PM +0200, Daniel Fischer wrote: I can partially answer my questions. Removing also Seen does away with the ByteString.index error. Must check the code to see why. Two more concrete questions a) how

Re: [Haskell-cafe] Haskell version of ray tracer code is muchslowerthan the original ML

2007-06-23 Thread Jon Harrop
On Saturday 23 June 2007 12:05:01 Claus Reinke wrote: http://www.kantaka.co.uk/darcs/ray try making ray_sphere and intersect' local to intersect, then drop their constant ray parameter. saves me 25%. claus also try replacing that (foldl' intersect') with (foldr (flip intersect'))! using

Re: [Haskell-cafe] Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Andrew Coppin
Bulat Ziganshin wrote: Hello Andrew, Saturday, June 23, 2007, 2:45:01 PM, you wrote: Hey, I'm just glad I managed to get within striking distance of Mr C++. So much for Haskell being inherently less performant. :-P my little analysis says that it's probably due to different sort()

Re: [Haskell-cafe] Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Jon Harrop
On Saturday 23 June 2007 13:02:54 Andrew Coppin wrote: Well, I altered the code, and it's *still* very short and very readable, and it's just as fast as the (3 pages long) C++ version. :-D Indeed. The performance of modern functional programming languages never ceases to amaze me. INRIA

Re: [Haskell-cafe] Odd lack of laziness

2007-06-23 Thread Neil Mitchell
Hi I have most of a Data.Nat library done, I should finish it off and release it... Thanks Neil On 6/22/07, Stefan O'Rear [EMAIL PROTECTED] wrote: On Fri, Jun 22, 2007 at 07:14:39PM +0100, Andrew Coppin wrote: Chaddaï Fouché wrote: You should be using BS.null f rather than BS.length f 0.

Re: [Haskell-cafe] Parallel + exceptions

2007-06-23 Thread Neil Mitchell
Hi Parallel: I think this is pretty well solved with STM. I think STM is production ready in GHC. Exceptions: These are less well solved, people are still thinking about some of the issues. In general, you probably don't want to use exceptions too much - the Maybe Monad is often a better

Re: [Haskell-cafe] Parallel + exceptions

2007-06-23 Thread Andrew Coppin
Bulat Ziganshin wrote: Hello Andrew, definitive reading: Tackling the awkward squad: monadic input/output, concurrency, exceptions, and foreign-language calls in Haskell http://research.microsoft.com/Users/simonpj/papers/marktoberdorf/marktoberdorf.ps.gz I've read it. Is everything

Re[2]: [Haskell-cafe] Parallel + exceptions

2007-06-23 Thread Bulat Ziganshin
Hello Andrew, Saturday, June 23, 2007, 7:12:52 PM, you wrote: Is everything described in that paper actually implemented now? (And implemented in exactly the same way as the paper says?) difference may be in subtle details. it just works for me :) in my experience, exceptions are rarely

Re: [Haskell-cafe] A Query Language for Haskell Terms

2007-06-23 Thread Pasqualino 'Titto' Assini
On Saturday 23 June 2007 13:52:27 Neil Mitchell wrote: Hi Regarding the first point, I am aware of with the following options: - SYB (Data.Generics..) You may also want to take a look at Uniplate: http://www-users.cs.york.ac.uk/~ndm/uniplate/ Many thanks Neil. That (or SYB) should take

Re: [Haskell-cafe] Lambdabot

2007-06-23 Thread Thomas Schilling
On 22 jun 2007, at 22.17, Derek Elkins wrote: [blah blah blah] A less (potentially) offensive way of formulating this is: [...] or -snip- (You know, we don't want to accidentally piss of any newcomers. So just saying .. :) ___

Re: [Haskell-cafe] Parallel + exceptions

2007-06-23 Thread Bulat Ziganshin
Hello Andrew, Saturday, June 23, 2007, 5:59:45 PM, you wrote: The two things mentioned in the subject line are both things I've never tried with Haskell. I've seen a lot of papers about these things, but I don't really understand what the current state of play with this is. Are any of these

Re[2]: [Haskell-cafe] Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Bulat Ziganshin
Hello Andrew, Saturday, June 23, 2007, 4:02:54 PM, you wrote: The point being that lots of people look at Haskell and go oh, that's very cute for writing trivial example code, but it can never be fast; for that you must use C or C++. and that's true :) as i said, your C++ code is very far

Re: [Haskell-cafe] A Query Language for Haskell Terms

2007-06-23 Thread Neil Mitchell
Hi Regarding the first point, I am aware of with the following options: - SYB (Data.Generics..) You may also want to take a look at Uniplate: http://www-users.cs.york.ac.uk/~ndm/uniplate/ That (or SYB) should take care of your query/transform issues, and the ACL stuff can be layered on top

[Haskell-cafe] Parallel + exceptions

2007-06-23 Thread Andrew Coppin
The two things mentioned in the subject line are both things I've never tried with Haskell. I've seen a lot of papers about these things, but I don't really understand what the current state of play with this is. Are any of these things production-ready yet? And how do you use them in the real

Re: [Haskell-cafe] Re: Lambdabot

2007-06-23 Thread Stefan O'Rear
On Sat, Jun 23, 2007 at 01:48:37PM +0200, Daniel Fischer wrote: Am Freitag, 22. Juni 2007 22:43 schrieb Stefan O'Rear: On Fri, Jun 22, 2007 at 10:37:55PM +0200, Daniel Fischer wrote: I can partially answer my questions. Removing also Seen does away with the ByteString.index error. Must

Re: [Haskell-cafe] Lambdabot

2007-06-23 Thread Dave Tapley
Perhaps in here we should start using \x - (unlines . (dropWhile (/= x)) . lines) Instead :) Dave, On 23/06/07, Thomas Schilling [EMAIL PROTECTED] wrote: On 22 jun 2007, at 22.17, Derek Elkins wrote: [blah blah blah] A less (potentially) offensive way of formulating this is: [...]

Re: [Haskell-cafe] Re: Existentials and type var escaping

2007-06-23 Thread Roberto Zunino
Ben Rudiak-Gould wrote: It's not definable, and there is a good reason. Existential boxes in principle contain an extra field storing their hidden type, and the type language is strongly normalizing. Thank you very much for the answer: indeed, I suspected strong normalization for types had

Re: [Haskell-cafe] Haskell version of ray tracer code is muchslowerthan the original ML

2007-06-23 Thread Philip Armstrong
On Sat, Jun 23, 2007 at 12:05:01PM +0100, Claus Reinke wrote: http://www.kantaka.co.uk/darcs/ray try making ray_sphere and intersect' local to intersect, then drop their constant ray parameter. saves me 25%. claus also try replacing that (foldl' intersect') with (foldr (flip intersect'))!

[Haskell-cafe] avoiding command window with wxHaskell on Windows?

2007-06-23 Thread Dean Herington
I'm experimenting with wxHaskell. I created a small program with it on Windows. (Well, small in source form, not so small in binary form :-) The program runs fine when invoked at a Windows command line. But if I double-click the .exe file, I get a command window that hangs around (but

Re: [Haskell-cafe] Haskell version of ray tracer code is muchslowerthan the original ML

2007-06-23 Thread Philip Armstrong
On Sat, Jun 23, 2007 at 07:07:49PM +0100, Philip Armstrong wrote: On Sat, Jun 23, 2007 at 12:05:01PM +0100, Claus Reinke wrote: http://www.kantaka.co.uk/darcs/ray try making ray_sphere and intersect' local to intersect, then drop their constant ray parameter. saves me 25%. claus also try

Re: [Haskell-cafe] Haskell version of ray tracer code is much slower than the original ML

2007-06-23 Thread Philip Armstrong
On Sat, Jun 23, 2007 at 10:32:31AM +0100, Jon Harrop wrote: On Saturday 23 June 2007 08:58:10 Philip Armstrong wrote: On Sat, Jun 23, 2007 at 03:28:53AM +0100, Jon Harrop wrote: What architecture, platform, compiler versions and compile lines are you using? 32-bit x86... Intel or AMD? AMD.

Re: [Haskell-cafe] avoiding command window with wxHaskell on Windows?

2007-06-23 Thread Jens Fisseler
On Sat, 23 Jun 2007, Dean Herington wrote: But if I double-click the .exe file, I get a command window that hangs around (but doesn't appear to do anything, fortunately) until the program terminates. How can I avoid this command window? With gtk2hs, using -optl-mwindows as a command line

Re: [Haskell-cafe] avoiding command window with wxHaskell on Windows?

2007-06-23 Thread Jens Fisseler
On Sat, 23 Jun 2007, Dean Herington wrote: But if I double-click the .exe file, I get a command window that hangs around (but doesn't appear to do anything, fortunately) until the program terminates. How can I avoid this command window? With gtk2hs, using -optl-mwindows as a command line

Re: [Haskell-cafe] Best idiom for avoiding Defaulting warnings with ghc -Wall -Werror ??

2007-06-23 Thread Neil Mitchell
Hi All the puffing about the advantages of strong typing look pretty silly if code hangs up on an incomplete pattern. Okay... people who don't worry so much about incomplete patterns believe that they get things done. There are trade offs in type systems about how much effort you want to

Re: [Haskell-cafe] Re: Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Bertram Felgenhauer
Andrew Coppin wrote: apfelmus wrote: Note that the one usually adds an end of string character $ in the Burrows-Wheeler transform for compression such that sorting rotated strings becomes sorting suffices. Yeah, I noticed that the output from by program can never actually be reverted

Re: [Haskell-cafe] Best idiom for avoiding Defaulting warnings with ghc -Wall -Werror ??

2007-06-23 Thread David Roundy
On Fri, Jun 22, 2007 at 03:14:06PM -0700, Stefan O'Rear wrote: On Fri, Jun 22, 2007 at 06:11:24PM -0400, Brandon S. Allbery KF8NH wrote: (1) any way to flag a pattern match as I know this is okay, don't warn about it without shutting off pattern match warnings completely? case

Re: [Haskell-cafe] Best idiom for avoiding Defaulting warnings with ghc -Wall -Werror ??

2007-06-23 Thread David Roundy
On Fri, Jun 22, 2007 at 05:39:10PM -0700, Dave Bayer wrote: On Jun 22, 2007, at 4:37 PM, David Roundy wrote: You get strongly-typed code whether or not you enable warnings. In my opinion it's delusional to think one is using strong typing if one doesn't enable warnings. All the puffing

Re: [Haskell-cafe] Parallel + exceptions

2007-06-23 Thread Felipe Almeida Lessa
On 6/23/07, Andrew Coppin [EMAIL PROTECTED] wrote: It's nice that you can have millions of threads if you want to do something very concurrent. What I tend to want is parallel - doing stuff that *could* be done in a single thread, but I want it to go faster using my big mighty multicore box. As

Re: [Haskell-cafe] Collections

2007-06-23 Thread Lennart Augustsson
If you don't run into graphs you are either solving very peculiar problems, or you don't recognize them when you see them. They are everywhere. On 6/22/07, Andrew Coppin [EMAIL PROTECTED] wrote: Dan Piponi wrote: Andrew said: True enough - but that's a rather specific task. I'm still not

[Haskell-cafe] stupid operator question

2007-06-23 Thread Michael Vanier
I noticed that both the Data.Array library and the Data.Map library use the (!) operator for different purposes. How would it be possible to import both libraries usefully in a single module? I guess what I'm really asking is: how do I qualify operator names? Mike

Re: [Haskell-cafe] stupid operator question

2007-06-23 Thread Stefan O'Rear
On Sat, Jun 23, 2007 at 04:53:51PM -0700, Michael Vanier wrote: I noticed that both the Data.Array library and the Data.Map library use the (!) operator for different purposes. How would it be possible to import both libraries usefully in a single module? I guess what I'm really asking

Re: [Haskell-cafe] Re: Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Chris Kuklewicz
I enjoy code like this that requires laziness. My modified version of your code is below... Bertram Felgenhauer wrote: Code: bwt implements a variation of the Burrows-Wheeler transform, using \0 as a sentinel character for simplicity. The sentinel has to be smaller than all other

Re: [Haskell-cafe] Re: Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Felipe Almeida Lessa
On 6/23/07, Bertram Felgenhauer [EMAIL PROTECTED] wrote: rbwt implements the corresponding inverse BWT. It's a fun knot tying exercise. rbwt xs = let res = sortBy (\(a:as) (b:bs) - a `compare` b) (zipWith' (:) xs res) in tail . map snd . zip xs $ head res Indeed it's very fun

Re: [Haskell-cafe] Re: Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Chris Kuklewicz
Felipe Almeida Lessa wrote: On 6/23/07, Bertram Felgenhauer [EMAIL PROTECTED] wrote: rbwt implements the corresponding inverse BWT. It's a fun knot tying exercise. rbwt xs = let res = sortBy (\(a:as) (b:bs) - a `compare` b) (zipWith' (:) xs res) in tail . map snd . zip xs $

Re: [Haskell-cafe] Re: Need for speed: the Burrows-Wheeler Transform

2007-06-23 Thread Bertram Felgenhauer
Felipe Almeida Lessa wrote: On 6/23/07, Bertram Felgenhauer [EMAIL PROTECTED] wrote: rbwt implements the corresponding inverse BWT. It's a fun knot tying exercise. rbwt xs = let res = sortBy (\(a:as) (b:bs) - a `compare` b) (zipWith' (:) xs res) in tail . map snd . zip xs $