loop?

2003-03-03 Thread Jon Fairbairn
The following module takes an inordinately long time to compile in ghc[i] (5.04): module Y2 where -- define the Y combinator without using built in recursion data Y2 t = Recur (Y2 t - (t - t) - t) y f = y2 (Recur y2) f where y2:: Y2 t - (t - t) - t y2 (Recur y2') f = f (y2'

RE: loop?

2003-03-03 Thread Simon Peyton-Jones
http://haskell.cs.yale.edu/ghc/docs/latest/html/users_guide/bugs.html Regrettable, but documented. Simon | -Original Message- | From: Jon Fairbairn [mailto:[EMAIL PROTECTED] | Sent: 03 March 2003 11:40 | To: GHC bugs | Subject: loop? | | The following module takes an inordinately long

Network on Win98: failed - socket - no error ??

2003-03-03 Thread Claus Reinke
I'm playing with the Network library (the recommended portable way?) and have a surprising problem with a simple client/server example. As the same program works fine on Solaris and Win2k, I suspect its a standard feature and someone here with more network programming experience might be able to

Re: Network on Win98: failed - socket - no error ??

2003-03-03 Thread Sigbjorn Finne
Did you remember to use 'withSocketsDo'? If you did, it would help to see the code that's failing for you (trivial or not.) --sigbjorn - Original Message - From: Claus Reinke [EMAIL PROTECTED] To: [EMAIL PROTECTED] Sent: Monday, March 03, 2003 04:14 Subject: Network on Win98: failed -

Re: Network on Win98: failed - socket - no error ??

2003-03-03 Thread Claus Reinke
Did you remember to use 'withSocketsDo'? If you did, it would help to see the code that's failing for you (trivial or not.) Did. But you're right, of course, so here's the current code. Claus -- Server.hs module Main where import Network import IO import System main = withSocketsDo $ do

Re: Network on Win98: failed - socket - no error ??

2003-03-03 Thread Claus Reinke
Still looking for inspirations on this one. I'm not at all sure I interpret the chain of indirections in the CVS sources correctly, but Network.Socket uses throwErrnoIfMinus1Retry, which does indeed try to use errno to figure out what went wrong. Is that redirected anywhere for windows? Because,

Re: int to float problem

2003-03-03 Thread Ketil Z. Malde
Mike T. Machenry [EMAIL PROTECTED] writes: I am having a problem. I recently desided I wanted a bunch function to return float instead of Int. I changed their type and wrote a new function that returned a float. I figured it'd be okay if all the others still returned Int since it's trivial

RE: fundeps for extended Monad definition

2003-03-03 Thread Simon Peyton-Jones
| The reason, which is thoroughly explained in Simon Peyton-Jones' | message, is that the given type signature is wrong: it should read | f1 :: (exists b. (C Int b) = Int - b) | | Right. Simon pointed out that this is a pretty useless function, but not | entirely so, since the result of

Re: How to force UNIX text files as output instead of DOS text files??

2003-03-03 Thread Alexandre Weffort Thenorio
Thanks a lot m8 but ghc says it can't the module IOExts when I try to compile, any suggestion??? Do I just use normal writeFile method to create the text file then?? Best Regards Alex - Original Message - From: Glynn Clements [EMAIL PROTECTED] To: Alexandre Weffort Thenorio [EMAIL

Re: How to force UNIX text files as output instead of DOS text files??

2003-03-03 Thread Alexandre Weffort Thenorio
OK I fixed the IOExts not found problem (-package lang) but my problem now is that I never worked with handles. How can I write the string to the file and so on?? Where can I find more info on handle data types?? Best Regards NooK - Original Message - From: Glynn Clements [EMAIL

looking for Database Interface in Haskell

2003-03-03 Thread Johannes Waldmann
Dear all, we want to access a (MySQL) data base, running on a linux server, from a Haskell program. We planned to use http://www.volker-wysk.de/mysql-hs/ but it depends on earlier versions of hdirect (0.17?) and ghc(-4?). I built hdirect-0.19 (?) (from the ghc CVS) but the Foreign interfaces seem

The Revised Haskell 98 Report

2003-03-03 Thread Simon Peyton-Jones
Folks I am holding in my hands the first copy of the Haskell 98 Report to roll off the presses at Cambridge University Press. It looks great. And it has a copyright notice that says It is intended that this Report belong to the entire Haskell community..., just as the online version does.

Re: looking for Database Interface in Haskell

2003-03-03 Thread Steffen Mazanek
Have a look here: http://haskell.cs.yale.edu/haskellDB/ ___ Haskell mailing list [EMAIL PROTECTED] http://www.haskell.org/mailman/listinfo/haskell

Re: looking for Database Interface in Haskell

2003-03-03 Thread Shae Matijs Erisson
Johannes Waldmann [EMAIL PROTECTED] writes: Dear all, we want to access a (MySQL) data base, running on a linux server, from a Haskell program. We planned to use http://www.volker-wysk.de/mysql-hs/ but it depends on earlier versions of hdirect (0.17?) and ghc(-4?). I built hdirect-0.19 (?)

Re: looking for Database Interface in Haskell

2003-03-03 Thread Daan Leijen
On 03 Mar 2003 13:57:06 +, Steffen Mazanek [EMAIL PROTECTED] wrote: Dear all, we want to access a (MySQL) data base, running on a linux server, from a Haskell program. Have a look here: http://haskell.cs.yale.edu/haskellDB/ A word of warning though from the author :-), HaskellDB is somewhat

GUI for Windows

2003-03-03 Thread Markus . Schnell
What User Interface Library would you recommend for use under Windows? I tried FranTk but it crashes as soon as I run the display function (under hugs) and with ghc it won't even compile (I already tinkered with the makefiles, so finally I could make the package, but then the demos won't compile).

Re: GUI for Windows

2003-03-03 Thread Daan Leijen
On Mon, 3 Mar 2003 16:21:22 +0100, [EMAIL PROTECTED] wrote: What User Interface Library would you recommend for use under Windows? Unfortunately, there is no official GUI library for Haskell yet (but many people are working toward this goal at the haskell gui mailing list). At the moment, the

Re: GUI for Windows

2003-03-03 Thread Axel Simon
On Mon, Mar 03, 2003 at 04:21:22PM +0100, [EMAIL PROTECTED] wrote: What User Interface Library would you recommend for use under Windows? I tried FranTk but it crashes as soon as I run the display function (under hugs) and with ghc it won't even compile (I already tinkered with the makefiles,

Re: int to float problem

2003-03-03 Thread Mike T. Machenry
Thank does sound like a pain, but it's better than putting fromIntegral all over my code. Why can't Haskell unify a an expected float with an infered int? It seems that this would make life alot easier. -mike On Sun, Mar 02, 2003 at 11:28:00AM +, Jorge Adriano wrote: Mike T. Machenry

Re: Tutorial for literate Haskell

2003-03-03 Thread Steffen Mazanek
Hello. I do Literate Programming this way: At first I define a Latex environment code as verbatim e.g. so: \newenvironment{code}{\footnotesize\verbatim}{\endverbatim\normalsize} This environment is understood by the Haskell compilers. All my modules are own documents concluded in the main

RE: fundeps for extended Monad definition

2003-03-03 Thread Hal Daume III
| entirely so, since the result of it is not of type 'forall b. b', but | rather of 'forall b. C Int b = b'. Thus, if the C class has a function | which takes a 'b' as an argument, then this value does have use. I disagree. Can you give an example of its use? I believe something

RE: fundeps for extended Monad definition

2003-03-03 Thread oleg
| The reason, which is thoroughly explained in Simon Peyton-Jones' | message, is that the given type signature is wrong: it should read | f1 :: (exists b. (C Int b) = Int - b) Can you give an example of its use? Yes, I can. class (Show a, Show b) = C a b | a - b where doit:: a -

Re: How to force UNIX text files as output instead of DOS text files??

2003-03-03 Thread Alexandre Weffort Thenorio
Thanks a lot m8. I got it. I was supplying it with --make but not with -o. Thanks again. I guess everything is fine now thanks to you guys.I wanna learn more about catching errors but that comes later when I finish this program. Best Regards Alex - Original Message - From: Nils Decker

Re: Tutorial for literate Haskell

2003-03-03 Thread b . i . mills
Yo, Steffen Mazanek wrote: I do Literate Programming this way: At first I define a Latex environment code as verbatim e.g. so: \newenvironment{code}{\footnotesize\verbatim}{\endverbatim\normalsize} When I ran into the same question some time ago I tried that, but found that the \verbatim was

Re: looking for Database Interface in Haskell

2003-03-03 Thread Krasimir Angelov
Hi, Shae Also, HToolkit has working but not yet stable support for both postgresql and mysql. I haven't tried the mysql interface myself, but I have tried the postgresql code. It works, but it does explode if you do something unexpected. http://sourceforge.net/projects/htoolkit/ Can

First-class types

2003-03-03 Thread oleg
The following is a more flexible alternative to overloading. We essentially define a function on types and invoke it, seemingly at run time. No Dynamics or unsafe computations are employed. We only need existential types, multi-parameter classes and functional dependencies. The code also shows

Re: Tutorial for literate Haskell

2003-03-03 Thread b . i . mills
Hi, Since I sent this to the haskell list in the first place, I'd better let everyone know that it all worked out. Hmm, there were no problems in simply doing so. Ok, I've cut your example down a bit (just from a minimalist tendency). The complete modified code is ...

Persistent data

2003-03-03 Thread Sengan . Baring-Gould
Is there some way to reduce the cost of garbage collection over large persistent datastructures without resorting to escaping to C to malloc memory outside the heap? The program I'm working is part database, which cannot discard information. The net result is that I see figures like 82.9% of the

Re: int to float problem

2003-03-03 Thread Ketil Z. Malde
Matthew Donadio [EMAIL PROTECTED] writes: Thank does sound like a pain, but it's better than putting fromIntegral all over my code. Why can't Haskell unify a an expected float with an infered int? It seems that this would make life alot easier. Personally, I think that one of the things that

Re: is identity the only polymorphic function without typeclasses?

2003-03-03 Thread Cagdas Ozgenc
Cagdas Ozgenc [EMAIL PROTECTED] wrote: Greetings, Is identity function the only meaningful function one can write without constraining the type variable using a typeclass? If not, could you please give a counter-example? Certainly you can write lots of ``meaningful function''s

Re: modeling out of memory

2003-03-03 Thread Cagdas Ozgenc
Greetings, 1) How does one model out of memory condition in Haskell, perhaps using a Maybe type? Unfortuntely not since it would not be referentially transparent. It's part of a more general issue of exceptions in pure code. You can't have calculateSomething :: X - Maybe Y Such

Re: is identity the only polymorphic function without typeclasses?

2003-03-03 Thread Bernard James POPE
I did not mean to include functions that take type constructors as parameters (so lists are out of my discussion scope). I am only considering functions that uses type variables that are not restricted by typeclasses. There is const: const :: a - b - a const x _ = x And of course a

Re: modeling out of memory

2003-03-03 Thread Bernard James POPE
Does this make the use of Monads doubtful? I mean it doesn't seem easy to have a completely pure language, and the time one starts introducing few impurities one also starts thinking why not include many others? I suggest that you read this paper: A semantics for imprecise exceptions,

Re: is identity the only polymorphic function without typeclasses?

2003-03-03 Thread Cagdas Ozgenc
I did not mean to include functions that take type constructors as parameters (so lists are out of my discussion scope). I am only considering functions that uses type variables that are not restricted by typeclasses. There is const: const :: a - b - a const x _ = x And of

Re: is identity the only polymorphic function without typeclasses?

2003-03-03 Thread Wolfgang Jeltsch
On Monday, 2003-03-03, 10:00, CET, Cagdas Ozgenc wrote: [...] I did not mean to include functions that take type constructors as parameters (so lists are out of my discussion scope). I am only considering functions that uses type variables that are not restricted by typeclasses. In this

Re: is identity the only polymorphic function without typeclasses?

2003-03-03 Thread Cagdas Ozgenc
My three eurocents. I believe that the Author of the original query won't care more about undefined stuff than most of us. He wants truly polymorphic functions, of the type, say, a-b-a etc., without constraints. The answer exists, although it is not always trivial to find interesting

Network module problem

2003-03-03 Thread David Roundy
Hello. I'm running into a problem with the Network module, which I suspect is pretty easy to fix, but am not sure how to best do so. The problem is that accept fails when the reverse DNS fails, with the following error: Fail: does not exist Action: getHostByAddr Reason: no such host entry I'm

speedup help

2003-03-03 Thread Damien R. Sullivan
So, I'm having to calculate 'n choose k' an awful lot. At the moment I've got this: comb :: Integer - Integer - Integer comb m 0 = 1 comb m n = (numerator(toRational (fact m) / toRational (fact n * fact (m-n where fact is a memoized factorial function. It's not perfectly memoized,

Re: speedup help

2003-03-03 Thread Hal Daume III
I think you would get a big speed-up if you got rid of all the rational stuff and just used: comb m n = fact m `div` (fact n * fact (m-n)) If that doesn't speed it up enouch, you can of course cache fact m in your computation and do something like: sumbn n = sum [ bournoulli i * fm `div` (fn *

Re: speedup help

2003-03-03 Thread Andrew Rock
On Tuesday, March 4, 2003, at 10:26 AM, Damien R. Sullivan wrote: So, I'm having to calculate 'n choose k' an awful lot. At the moment I've got this: comb :: Integer - Integer - Integer comb m 0 = 1 comb m n = (numerator(toRational (fact m) / toRational (fact n * fact (m-n where fact is

Re: speedup help

2003-03-03 Thread Andrew J Bromage
G'day all. On Mon, Mar 03, 2003 at 04:59:21PM -0800, Hal Daume III wrote: I think you would get a big speed-up if you got rid of all the rational stuff and just used: comb m n = fact m `div` (fact n * fact (m-n)) Or, even better, if you didn't multiply stuff that you're just going to

Re: speedup help

2003-03-03 Thread mike castleman
I have no idea if the following is faster or not (I suspect not), but it is certainly easier to read: n `choose` k = (n `permute` k) `div` (fact k) n `permute` k = product [(n-k+1) .. n] fact n = product [1 .. n] mike -- mike castleman / [EMAIL PROTECTED] / http://mlcastle.net aolim: mlcastle

Re: speedup help

2003-03-03 Thread Damien R. Sullivan
On Tue, Mar 04, 2003 at 12:25:01PM +1100, Andrew J Bromage wrote: Or, even better, if you didn't multiply stuff that you're just going to divide out in the first place. I had thought of that before, and used a simple comb m n = product [m, m-1 .. m-n+1] / fact (m-n) but the unmemoized product

Re: speedup help update

2003-03-03 Thread Damien R. Sullivan
On Mon, Mar 03, 2003 at 04:59:21PM -0800, Hal Daume III wrote: comb m n = fact m `div` (fact n * fact (m-n)) This was the biggest help, 33 seconds instead of my original 43. fact is the big consumer now, and I think cries out for being arrayed, especially as it gets used a lot elsewhere too.

do let in

2003-03-03 Thread Damien R. Sullivan
main = do args - System.getArgs let (m, b) = (read (args!!0), read (args!!1)) let lim :: Int lim = read (args!!2) printstate = args!!3 time1 - getClockTime let n = 2^b let afact = array (0,n) ((0,1):[(i,i*afact!(i-1)) |

Re: do let in

2003-03-03 Thread Damien R. Sullivan
On Tue, Mar 04, 2003 at 03:06:13PM +1100, Bernard James POPE wrote: Damien writes: main = do args - System.getArgs let (m, b) = (read (args!!0), read (args!!1)) let lim :: Int lim = read (args!!2) printstate = args!!3

Re: do let in

2003-03-03 Thread Bernard James POPE
Hi, For the reason that I'm lazy and don't want to have to modify all my functions which use afact, or call functions which use afact, and don't see why I should have to -- they were able to call the 'fact' function as a global, and can refer to a global 'afact' if I define it outside of main

Re: do let in

2003-03-03 Thread Damien R. Sullivan
On Mon, Mar 03, 2003 at 10:45:38PM -0600, Jon Cast wrote: Never programmed in C++ much, eh? Only for a few years, professionally. In general, getting the ordering of initialization right in the general case is a harder problem than you might think. It's not something I'd be having trouble