[Haskell-cafe] Re: Guidance on using asynchronous exceptions

2007-11-16 Thread Simon Marlow

Yang wrote:

To follow up on my previous post (Asynchronous Exceptions and the
RealWorld), I've decided to put together something more concrete in
the hopes of eliciting response.

I'm trying to write a library of higher-level concurrency
abstractions, in particular for asynchronous systems programming. The 
principal goal here is composability and safety. Ideally, one can apply 
combinators on any existing (IO a), not just procedures written for this 
library. But that seems like a pipe dream at this point.


It's quite hard to write composable combinators using threads and 
asynchronous exceptions, and this is certainly a weakness of the design. 
See for example the timeout combinator we added recently:


http://darcs.haskell.org/packages/base/System/Timeout.hs

There we did just about manage to make timeout composable, but it was tricky.

In the code below, the running theme is process orchestration. (I've put 
TODOs at places where I'm blocked - no pun intended.)


I'm currently worried that what I'm trying to do is simply impossible in
Concurrent Haskell. I'm bewildered by the design decisions in the
asynchronous exceptions paper. I'm also wondering if there are any
efforts under way to reform this situation. I found some relevant
posts below hinting at this, but I'm not sure what the status is
today.


We haven't made any changes to block/unblock, although that's something I'd 
like to investigate at some point.  If you have any suggestions, I'd be 
interested to hear them.


The problem your code seems to be having is that waitForProcess is 
implemented as a C call, and C calls cannot be interrupted by asynchronous 
exceptions - there's just no way to implement that in general.  One 
workaround would be to fork a thread to call waitForProcess, and 
communicate with the thread using an MVar (takeMVar *is* interruptible). 
You could encapsulate this idiom as a combinator interruptible, perhaps. 
 But note that interrupting the thread waiting on the MVar won't then 
terminate the foreign call: the call will run to completion as normal.


The fact that some operations which block indefinitely cannot be 
interrupted is a problem.  We should document which those are, but the fact 
that the audit has to be done by hand means it's both tedious and 
error-prone, which is why it hasn't been done.


The only example that I know of where asynchronous exceptions and 
block/unblock are really used in anger is darcs, which tries to do 
something reasonable in response to a keyboard interrupt.


Cheers,
Simon
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: emacs haskellers: r-stripping files becomes popular

2007-11-16 Thread Valery V. Vorotyntsev
On 11/16/07, Valery V. Vorotyntsev [EMAIL PROTECTED] wrote:
 Add the following lines to your ~/.emacs:

Adding buffer name to confirmation message:

--- BEGIN ---
(defun delete-trailing-whitespace-if-confirmed ()
  Delete all the trailing whitespace across the current buffer,
asking user for confirmation.
  (if (and
   (save-excursion (goto-char (point-min))
   (re-search-forward [[:space:]]$ nil t))
   (y-or-n-p (format Delete trailing whitespace from %s?  (buffer-name
  (delete-trailing-whitespace)))
--- END ---

 (add-hook 'before-save-hook 'delete-trailing-whitespace-if-confirmed)

--
vvv
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] ghc 6.8.1 bug?

2007-11-16 Thread SevenThunders



Simon Peyton-Jones wrote:
 
 Alberto, SevenThunders, Joel,
 
 Glark. This is not good. Thank you for being so polite about it.  And
 thanks for working on a reproducible test case -- without that we are 100%
 stuck.
 
 We did fix one just-possibly-related bug in 6.8 recently, which concerned
 the use of {-# UNPACK #-} on strict Double-sized fields in fixed,
 top-level data structures. I think it was only wrong on a 64-bit machine.
 http://www.haskell.org/pipermail/glasgow-haskell-users/2007-November/013454.html
 What is the word size on your machine?
 
 But that may well be a complete red herring.  We'll stand by.
 
 Simon
 
 

Well I am running windows xp-64 and I have an athlon x2.  Does a 64 bit ghc
exist for windows?  I just installed ghc 6.8.1 using the binary installer. 
I know the C code I link to is 32 bit.  I actually did have some problems
upgrading atlas some time ago, but that was a build failure.  I think I've
built atlas 3.7.11 and had trouble  installing 3.7.24.  I haven't bothered
to upgrade to 3.8, but I suppose I should get around to doing so.  Since my
current version of atlas passes the tests and has been working flawlessly
until the upgrade to ghc 6.8.1,   I'm not inclined to suspect that right
now.

As for narrowing down a test case.  It's still a work in progress.  So far
it appears that I need to do a lot of computations before I see it.  Also
one oddity is that in that code that I have right now  I have to apply the
round function in my main routine to an arbitrary double, that's not even
used in the final calculation (but is printed), in order to see the spurious
NaNs.  I'm not sure if that means anything since the behavior is reminiscent
of buggy C code.  However my C code has already been through some valgrind
checks and some other tests.  I'm quite confident there are no memory faults
there.  If I save off my matrices right before doing the multiply the bug
goes away as well.




-- 
View this message in context: 
http://www.nabble.com/ghc-6.8.1-bug--tf4810375.html#a13794966
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] emacs haskellers: r-stripping files becomes popular

2007-11-16 Thread Valery V. Vorotyntsev
On 11/16/07, Denis Bueno [EMAIL PROTECTED] wrote:
 For one thing, if you happen to write code shared with other people
 who do not use this hook, then you may end up causing *huge* numbers
 of spurious differences in diff(1) output.  There may be an easy way
 to deal with this, but, it is a problem.

Yes, you are right. That's why user is being asked for confirmation.
And `diff -w' removes the noise, but still, yes, that can be a problem.

:)

--
vvv
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] The percent operator

2007-11-16 Thread PR Stanley

Hi
I understand 2%4 will construct a fraction in Haskell. I've tried 
this in GHCI but got an error message. Is there such an operator in 
Prelude and if so how is it applied?

Cheers,
Paul

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Knot tying vs monads

2007-11-16 Thread John D. Ramsdell
This is another Haskell style question.

I had some trouble with the pretty printer that comes with GHC, so I
translated one written in Standard ML.  I have already translated the
program into C, so rewriting it in Haskell was quick and easy for me.

The Standard ML version uses a reference cell to keep track of the
space available on a line.  I threaded the value of the reference cell
through the computation using a where clause to define two mutually
recursive equations.  The fixed point implicit in the where clause
ties the knot in the circular definitions in a way that allows the
output string to be efficiently computed front to back.

I showed the code to a colleague, who found the circular definitions
opaque.  He suggested a better style is to use monads, and describe
the computation in a mode that is closer to its origin form in
Standard ML.

What style do to you prefer, a knot-tying or a monad-based style?  I
have enclosed the pretty printer.  The printing function is the
subject of the controversy.

John

A simple pretty printer

The alogithm is by Lawrence C. Paulson, who simplified an algorithm
by Derek C. Oppen.

Derek C. Oppen, Prettyprinting, ACM Transactions on Programming
Languages and Systems, Vol 2, No. 4, October 1980, Pages 465-483.

A pretty printer based on ML programs with the following copyright

( ML Programs from Chapter 8 of

  ML for the Working Programmer, 2nd edition
  by Lawrence C. Paulson, Computer Laboratory, University of Cambridge.
  (Cambridge University Press, 1996)

Copyright (C) 1996 by Cambridge University Press.
Permission to copy without fee is granted provided that this copyright
notice and the DISCLAIMER OF WARRANTY are included in any copy.

DISCLAIMER OF WARRANTY.  These programs are provided `as is' without
warranty of any kind.  We make no warranties, express or implied, that the
programs are free of error, or are consistent with any particular standard
of merchantability, or that they will meet your requirements for any
particular application.  They should not be relied upon for solving a
problem whose incorrect solution could result in injury to a person or loss
of property.  If you do use the programs or functions in such a manner, it
is at your own risk.  The author and publisher disclaim all liability for
direct, incidental or consequential damages resulting from your use of
these programs or functions.
)

 module Pretty(Pretty, pr, blo, str, brk) where

 data Pretty
 = Str !String
 | Brk !Int  -- Int is the number of breakable spaces
 | Blo ![Pretty] !Int !Int -- First int is the indent, second int
 --  is the number of chars and spaces for strings and breaks in block

Constructors

Strings

 str :: String - Pretty
 str = Str

Break points

 brk :: Int - Pretty
 brk = Brk

Indentation blocks

 blo :: Int - [Pretty] - Pretty
 blo indent es =
 Blo es indent (sum es 0)
 where
   sum [] k = k
   sum (e:es) k = sum es (size e + k)
   size (Str s) = length s
   size (Brk n) = n
   size (Blo _ _ n) = n

Pretty prints the constructed object

 pr :: Int - Pretty - ShowS
 pr margin e s =
 s1
 where
   (_, s1) = printing margin [e] margin 0 (margin, s)

The state of the computation is maintained as a pair consisting of
an integer and a string.  The integer is the number of unused
character positions in the current line of output.  The printer
adds content to the front of the given string.

 printing :: Int - [Pretty] - Int - Int - (Int, String) - (Int, String)
 printing _ [] _ _ p = p
 printing margin (e:es) blockspace after (space, s) =
 (space1, s1)
 where
   (space2, s1) =-- Result of first item
   case e of
 Str str -  -- Place a string
  (space - length str, showString str s2)
 Brk n --- Place breakable space
  if n + breakdist es after = space then
  blanks n (space, s2) -- Don't break
  else
  (space3, showChar '\n' s3) -- Break
  where
(space3, s3) =
blanks (margin - blockspace) (margin, s2)
 Blo bes indent _ - -- Place a block
  printing margin bes (space - indent)
 (breakdist es after) (space, s2)
   (space1, s2) =-- Result of the remaining items
   printing margin es blockspace after (space2, s)

Find the distance to the nearest breakable space.

 breakdist :: [Pretty] - Int - Int
 breakdist (Str s : es) after = length s + breakdist es after
 breakdist (Brk _ : _) _ = 0
 breakdist (Blo _ _ n : es) after = n + breakdist es after
 breakdist [] after = after

Place spaces

 blanks :: Int - (Int, String) - (Int, String)
 blanks n (space, s)
 | n = 0 = (space, s)
 | otherwise = blanks (n - 1) (space - 1, showChar ' ' s)
___

Re: [Haskell-cafe] let vs. where

2007-11-16 Thread Henning Thielemann

On Fri, 16 Nov 2007, jeff p wrote:

 A function is an expression whose type is an arrow; e.g. Int - Int.
 The type of taxRate is (Fractional t) = t.

I had this misunderstanding too, when starting with Haskell. In other
languages there are functions with zero, one or more arguments. In
contrast to that, Haskell functions have exactly one argument and one
result, which I find is a nice thing. In other languages this is
asymmetric, you can have multiple arguments but only one result. It is not
possible to pass a struct to a function that expects multiple arguments.
However, due to heavy usage of Schoenfinkel form in Haskell's standard
functions the situation is similar in Haskell.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: Re[2]: [Haskell-cafe] the interact function and Hugs/ghci on Windows ...

2007-11-16 Thread Neil Mitchell
Hi Bulat,

  The released version of WinHugs does not support Ctrl+Z or Ctrl+D, but
  the development builds do.

 btw, are you plan to release hugs version compatible with ghc 6.8?

That would make sense, and I suspect Ross will want to (he's in charge
of Hugs stuff). I am super-busy until after the end of the month, but
will look into things then.

Thanks

Neil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ghc 6.8.1 bug?

2007-11-16 Thread Michael McNeil Forbes
Just out of curiosity, what LAPACK and BLAS implementation is causing  
problems?  I have no idea if there is anything related, but I have  
been having similar sounding problems with python when using the  
latest ATLAS library on 64 bit core 2 machines.  I am beginning to  
suspect that there may be something wrong in ATLAS, but I don't have  
any definite evidence yet because the bug is also rather elusive here.


Michael.

On 16 Nov 2007, at 2:13 AM, Simon Peyton-Jones wrote:


Alberto, SevenThunders, Joel,

Glark. This is not good. Thank you for being so polite about it.   
And thanks for working on a reproducible test case -- without that  
we are 100% stuck.


We did fix one just-possibly-related bug in 6.8 recently, which  
concerned the use of {-# UNPACK #-} on strict Double-sized fields  
in fixed, top-level data structures. I think it was only wrong on a  
64-bit machine.
http://www.haskell.org/pipermail/glasgow-haskell-users/2007- 
November/013454.html

What is the word size on your machine?

But that may well be a complete red herring.  We'll stand by.

Simon

| -Original Message-
| From: [EMAIL PROTECTED] [mailto:haskell-cafe- 
[EMAIL PROTECTED] On Behalf Of Alberto Ruiz

| Sent: 15 November 2007 08:44
| To: haskell-cafe@haskell.org
| Subject: Re: [Haskell-cafe] ghc 6.8.1 bug?
|
| Hello,
|
| I have had exactly the same problem with my bindings to GSL, BLAS  
and LAPACK.
| The foreign functions (!) randomly (but very frequently) produced  
NaN with
| ghc-6.8.1 -O. As usual, I first thought that I had a subtle bug  
related to
| the foreign pointers, but after a lot of refactoring,  
experiments, and
| tracing everything, I'm reasonably sure that memory is safely  
used. What I

| have found is that the same errors can be reproduced on ghc-6.6.1
| with -O -fasm. So I tried -O -fvia-C on ghc-6.8.1 (which now it  
is not the
| default) and apparently everything works well. So it seems that  
now the ffi
| requires and additional and explicit -fvia-C. In any case I don't  
know
| why -fasm produces those strange NaN in precompiled foreign  
functions...

|
| Alberto
|
| On Thursday 15 November 2007 09:05, SevenThunders wrote:
|  The good news is that my code compiles without error and much  
faster under

|  ghc 6.8.1.
|  The bad news is that there appear to be subtle bugs that did  
not occur when

|  I compiled things under
|  6.6.1.  One issue is that my code is somewhat complex and links  
into a  C

|  library as well.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


--
Mailing address:

Michael McNeil Forbes
UW Dept. of Physics
Box 351560
Seattle, WA, 98195-1560
For couriers:

Physics/Astronomy Building, Room C121
3910 15th Ave NE
Seattle, WA, 98195-1560

If you would like to visit me personally:
Room B482 (Fourth floor)
(206) 543-9754



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Knot tying vs monads

2007-11-16 Thread apfelmus

John D. Ramsdell wrote:

This is another Haskell style question.

I had some trouble with the pretty printer that comes with GHC, so I
translated one written in Standard ML.  I have already translated the
program into C, so rewriting it in Haskell was quick and easy for me.


Concerning the choice of a pretty printer, the one bundled in GHC is 
close to


  John Hughes. The Design of a Pretty-printing Library.
  http://citeseer.ist.psu.edu/hughes95design.html

but there's also

  Philip Wadler. A prettier printer.
  http://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf

(probably available as a library on hackage). Btw, both papers are 
marvelous introductions to the derivation of programs from their 
specification.


Compared to that, I'm missing the specification part for your pretty 
printer. How's it supposed to lay out?



The Standard ML version uses a reference cell to keep track of the
space available on a line.  I threaded the value of the reference cell
through the computation using a where clause to define two mutually
recursive equations.  The fixed point implicit in the where clause
ties the knot in the circular definitions in a way that allows the
output string to be efficiently computed front to back.

I showed the code to a colleague, who found the circular definitions
opaque.  He suggested a better style is to use monads, and describe
the computation in a mode that is closer to its origin form in
Standard ML.

What style do to you prefer, a knot-tying or a monad-based style?  I
have enclosed the pretty printer.  The printing function is the
subject of the controversy.


Neither, I think that the code mixes too many concerns. You need neither 
knot tying nor monads for efficient string concatenation, a simple 
difference list


  type DString = Data.DList String = String - String

will do. (There's a small difference list library Data.DList available 
on hackage). If ++ is too inefficient, then simply switch to a different 
String implementation with a faster ++.


Introducing a difference list means to replace the output type

  (Int, String) - (Int, String)

of  printing  not by

  Int - (String - (Int, String)) -- state monad with state String

but by

  Int - (Int, String - String)   -- difference list

Furthermore, I guess that this can probably be replaced by

  Int - (String - String)
  (Int - Int, String - String)

or made entirely abstract

  type X = (Int, String) - (Int, String)

  blanks :: Int - X

blanks n (space, s)
 | n = 0 = (space, s)
 | otherwise = blanks (n - 1) (space - 1, showChar ' ' s)


  string :: String - X
  string s (space,t) = (space - length s, s ++ t)

or something like that. I don't know what your printer is supposed to 
do, so I can't say for sure.




module Pretty(Pretty, pr, blo, str, brk) where



data Pretty
= Str !String
| Brk !Int  -- Int is the number of breakable spaces
| Blo ![Pretty] !Int !Int -- First int is the indent, second int
--  is the number of chars and spaces for strings and breaks in block


Drop those strictness annotations from !String and ![Pretty], they won't 
do any good. The !Int are only useful if they will be unboxed, but I 
wouldn't bother right now.



Indentation blocks


blo :: Int - [Pretty] - Pretty
blo indent es =
Blo es indent (sum es 0)
where
  sum [] k = k
  sum (e:es) k = sum es (size e + k)
  size (Str s) = length s
  size (Brk n) = n
  size (Blo _ _ n) = n


 size  is of independent value, I'd make it a top-level function. Oh, 
and the  sum  won't be tail-recursive (until ghc's strictness analyzer 
figures it out). I'd like to point you to


  http://haskell.org/haskellwiki/Performance/Accumulating_parameter

for an explanation of why, but the information there is rather 
inaccurate. For the moment, I could only find


  http://monad.nfshost.com/wordpress/?p=19

  last section of
  http://blog.interlinked.org/tutorials/haskell_laziness.html

but isn't there a short text that describes in detail why foldl' is 
different from foldl and why foldr is better in many cases? I thought 
this faq would have been cached already :)


In any case, I'd simply write

  blo indent es = Blo es indent . sum . map size $ es

( sum  is a function from the Prelude.)


Regards,
apfelmus

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] ghc 6.8.1 bug?

2007-11-16 Thread Simon Peyton-Jones
Alberto, SevenThunders, Joel,

Glark. This is not good. Thank you for being so polite about it.  And thanks 
for working on a reproducible test case -- without that we are 100% stuck.

We did fix one just-possibly-related bug in 6.8 recently, which concerned the 
use of {-# UNPACK #-} on strict Double-sized fields in fixed, top-level data 
structures. I think it was only wrong on a 64-bit machine.
http://www.haskell.org/pipermail/glasgow-haskell-users/2007-November/013454.html
What is the word size on your machine?

But that may well be a complete red herring.  We'll stand by.

Simon

| -Original Message-
| From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf Of Alberto Ruiz
| Sent: 15 November 2007 08:44
| To: haskell-cafe@haskell.org
| Subject: Re: [Haskell-cafe] ghc 6.8.1 bug?
|
| Hello,
|
| I have had exactly the same problem with my bindings to GSL, BLAS and LAPACK.
| The foreign functions (!) randomly (but very frequently) produced NaN with
| ghc-6.8.1 -O. As usual, I first thought that I had a subtle bug related to
| the foreign pointers, but after a lot of refactoring, experiments, and
| tracing everything, I'm reasonably sure that memory is safely used. What I
| have found is that the same errors can be reproduced on ghc-6.6.1
| with -O -fasm. So I tried -O -fvia-C on ghc-6.8.1 (which now it is not the
| default) and apparently everything works well. So it seems that now the ffi
| requires and additional and explicit -fvia-C. In any case I don't know
| why -fasm produces those strange NaN in precompiled foreign functions...
|
| Alberto
|
| On Thursday 15 November 2007 09:05, SevenThunders wrote:
|  The good news is that my code compiles without error and much faster under
|  ghc 6.8.1.
|  The bad news is that there appear to be subtle bugs that did not occur when
|  I compiled things under
|  6.6.1.  One issue is that my code is somewhat complex and links into a  C
|  library as well.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] emacs haskellers: r-stripping files becomes popular

2007-11-16 Thread Denis Bueno
On Nov 16, 2007 12:05 PM, Valery V. Vorotyntsev [EMAIL PROTECTED] wrote:
 On 11/16/07, Brent Yorgey [EMAIL PROTECTED] wrote:
  Nice!  Is there a way to have this only run if the current buffer is in
  haskell-mode?  I'd add it myself but I've not yet taken the plunge to being
  an elisp hacker.

 Try adding ``(eq major-mode 'haskell-mode)'' after the `and' ..
 .. but why would you tolerate whitespace in other modes?

For one thing, if you happen to write code shared with other people
who do not use this hook, then you may end up causing *huge* numbers
of spurious differences in diff(1) output.  There may be an easy way
to deal with this, but, it is a problem.


-- 
  Denis
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] dropSpace not exported in ByteString

2007-11-16 Thread Olivier Boudry
On 11/16/07, Duncan Coutts [EMAIL PROTECTED] wrote:

 On Thu, 2007-11-15 at 21:55 -0500, Olivier Boudry wrote:

  By the way, what's the reason dropSpaceEnd is defined but not exported
  nor used through a rule? I'm just curious.

 We decided when trying to standardise the API to start with just the
 equivalents of the Data.List functions. We have tracked changes to
 Data.List, adding intercalate and isInfixOf.

 If there is a compelling reason to add dropSpaceEnd to the
 Data.ByteString API then the same would probably apply to Data.List and
 so it should be proposed for there and then Data.ByteString will track
 it too.

 Alternatively, someone should make the case for why it should be added
 to bytestring but not list. There is probably room for more string
 oriented list functions in some library somewhere (especially crazy
 Unicode stuff), like Data.String.

 Duncan


I understand the need for standardization. Having consistent functions
across modules is something I really appreciate in Haskell.

Thanks for the information,

Olivier.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: let vs. where

2007-11-16 Thread John Lato
This actually clears up something that's been bothering me for some
time.  I've never really like syntax of types for functions with
multiple arguments.  Using the same token, -, to separate both
arguments and the result seems very poor, because when reading a type
you don't know if the value after that token is another argument or
the final result without going further ahead.  However, knowing that a
function takes exactly one argument makes the syntax seem much more
expressive for me.

 From: Henning Thielemann [EMAIL PROTECTED]

 ... In
 contrast to that, Haskell functions have exactly one argument and one
 result, which I find is a nice thing.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The percent operator

2007-11-16 Thread Philip Armstrong

On Fri, Nov 16, 2007 at 02:44:33PM +, PR Stanley wrote:
I understand 2%4 will construct a fraction in Haskell. I've tried this in 
GHCI but got an error message. Is there such an operator in Prelude and if 
so how is it applied?


It's not in the Prelude, it's in the Ratio module IIRC.

Phil

--
http://www.kantaka.co.uk/ .oOo. public key: http://www.kantaka.co.uk/gpg.txt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] the interact function and Hugs/ghci on Windows ...

2007-11-16 Thread Neil Mitchell
Hi

The released version of WinHugs does not support Ctrl+Z or Ctrl+D, but
the development builds do.

If you download:
http://haskell.org/hoogle/other/winhugs-interact-fixes-2006-oct-25.zip
and replace the WinHugs.exe with this new one then you should get that
functionality.

Thanks

Neil

On 11/16/07, Justin Bailey [EMAIL PROTECTED] wrote:
 On Nov 15, 2007 6:25 PM, Galchin Vasili [EMAIL PROTECTED] wrote:
  Hello,
 
   I have a Haskell script that contains several functions that are
  implemented in terms on interact. When I do a function application,
  Hugs/ghci is waiting for input from stdin. How do one denote EOF from stdin,
  so that the function evaluation can continue and do the IO () action , ie..
  write to stdout?

 Usually CTRL-D or CTRL-Z.

 Justin
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] dropSpace not exported in ByteString

2007-11-16 Thread Duncan Coutts
On Thu, 2007-11-15 at 21:55 -0500, Olivier Boudry wrote:

 By the way, what's the reason dropSpaceEnd is defined but not exported
 nor used through a rule? I'm just curious.

We decided when trying to standardise the API to start with just the
equivalents of the Data.List functions. We have tracked changes to
Data.List, adding intercalate and isInfixOf.

If there is a compelling reason to add dropSpaceEnd to the
Data.ByteString API then the same would probably apply to Data.List and
so it should be proposed for there and then Data.ByteString will track
it too.

Alternatively, someone should make the case for why it should be added
to bytestring but not list. There is probably room for more string
oriented list functions in some library somewhere (especially crazy
Unicode stuff), like Data.String.

Duncan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] cabal Main-Is restriction

2007-11-16 Thread Nicolas Frisby
It seems the meaning of the -main-is switch for GHC and the Main-Is
build option for Cabal executables differ. With GHC, I can point to
any function main in any module, but in Cabal I must point to a
filename with precisely the module name Main. This is tying my hands
with regard to organizing a default executable and exposing some of
its functionality as a library. Is there a way to get around this
restriction?

Concretely, I want to point Cabal's Main-Is to Program/Main.hs which starts with

  module Program.Main where

instead of just

  module Main where


Is this currently possible? I recognize the add a separate
Program-Main.hs file workaround, but I'll avoid it if I can.

Thanks!
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-16 Thread Arnar Birgisson
On Nov 16, 2007 12:26 AM, Lennart Augustsson [EMAIL PROTECTED] wrote:
 On Nov 14, 2007 1:05 AM, Robin Green [EMAIL PROTECTED] wrote:
 
  On Tue, 13 Nov 2007 13:51:13 -0800
  Dan Piponi [EMAIL PROTECTED] wrote:
 
   Up until yesterday I had presumed that guards only applied to
   functions. But I was poking about in the Random module and discovered
   that you can write things like
  
   a | x  1 = 1
 | x  -1 = -1
 | otherwise = x
  
   where 'a' clearly isn't a function.
 
  Isn't it a function taking zero arguments?

 No, Haskell functions take exactly one argument.

Depends on who you ask. From [1]:

quote
taxRate = 0.06

total cart = subtotal + tax
  where
subtotal = sum cart
taxable  = filter isTaxable cart
tax = (sum taxable) * taxRate

This example defines two functions, taxRate, which returns a constant
value, and total, which computes the total cost of the list of items
in a shopping cart. (Although the taxRate definition appears to be
defining a variable, it's best to think of it as a constant function,
a function that takes no parameters and always returns the same
value.) The definition of total is quite expressive, and highlights
the intent of the function, by isolating and naming important
sub-expressions in the computation. (total also refers to an isTaxable
function, not presented here.)
/quote

Technically, all Haskell functions may take exactly one parameter -
but focusing only on semantics, I guess there's really nothing wrong
with considering constants as parameterless functions, is there?

[1]

cheers,
Arnar
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Guidance on using asynchronous exceptions

2007-11-16 Thread Yang

oleg-at-pobox.com |haskell-cafe| wrote:

Yang wrote:

(Something like this is straightforward to build if I abandon
Concurrent Haskell and use cooperative threading, and if the
operations I wanted to perform could be done asynchronously.)

All operations could be done asynchronously, at least on Linux and
many Unixes:

http://www.usenix.org/events/usenix04/tech/general/full_papers/elmeleegy/elmeleegy_html/index.html


Thanks for this pointer.




(Something like this is straightforward to build if I abandon
Concurrent Haskell and use cooperative threading, and if the
operations I wanted to perform could be done asynchronously.)


That seems as a very good idea. You might be aware that well-respected
and well-experienced systems researchers call for *abandoning*
threads. Threads are just a very bad model.

The Problem with Threads
Edward A. Lee
http://www.eecs.berkeley.edu/Pubs/TechRpts/2006/EECS-2006-1.html
Also, IEEE computer, May 2006, pp. 33-42.

From the abstract:
``Although threads seem to be a small step from sequential computation,
in fact, they represent a huge step. They discard the most essential
and appealing properties of sequential computation: understandability,
predictability, and determinism. Threads, as a model of computation,
are wildly nondeterministic, and the job of the programmer becomes one
of pruning that nondeterminism. Although many research techniques
improve the model by offering more effective pruning, I argue that
this is approaching the problem backwards.  Rather than pruning
nondeterminism, we should build from essentially deterministic,
composable components. Nondeterminism should be explicitly and
judiciously introduced where needed, rather than removed where not
needed. The consequences of this principle are profound. I argue for
the development of concurrent coordination languages based on sound,
composable formalisms. I believe that such languages will yield much
more reliable, and more concurrent programs.''


I had read this not long ago. While the bulk of the paper argues for 
determinism, my understanding is that he ultimately doesn't actually 
advocate tossing out threads per se; he approves of their use for data 
flow (message-passing) and with state isolation.


This style of concurrency is, of course, not new. Component 
architectures where data flows
through components (rather than control) have been called 
“actor-oriented” [35]. These can take
many forms. Unix pipes resemble PN, although they are more limited in 
that they do not support
cyclic graphs. Message passing packages like MPI and OpenMP include 
facilities for implementing
rendezvous and PN, but in a less structured context that emphasizes 
expressiveness rather than
determinacy. A naive user of such packages can easily be bitten by 
unexpected nondeterminacy.
Languages such as Erlang [4] make message passing concurrency an 
integral part of a general-
purpose language. Languages such as Ada make rendezvous an integral 
part. Functional languages
[30] and single-assignment languages also emphasize deterministic 
computations, but they are less
explicitly concurrent, so controlling and exploiting concurrency can be 
more challenging. Data
parallel languages also emphasize determinate interactions, but they 
require low-level rewrites of

software.




I believe that delimited continuations is a good way to build
coordination languages, because delimited continuations let us build a
sound model of computation's interaction with its context.



Aren't safepoints (+ no shared state) enough to tame this issue? What 
visible difference is there between threads with safepoints and 
delimited continuations?


Another reason for separate threads is that they can run on separate OS 
threads (cores), thus exploiting parallelism.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Guidance on using asynchronous exceptions

2007-11-16 Thread oleg

Yang wrote:
 Furthermore, is there any way to embed this information [about async
 execptions] in the type system, so that Haskellers don't produce
 async-exception-unaware code?  (Effectively, introducing checked
 interrupts?)

Yes, it is possible to make the information about exceptions and
interrupts a part of operation's type:
  http://www.haskell.org/pipermail/haskell/2004-June/014271.html

Here is a simple illustration for your specific case

 {-# OPTIONS -fglasgow-exts #-}

 module B where
 import Control.Exception

 idarn _ msg = error msg

 myPutStrLn _ | False = idarn ?e_async myPutStrLn is interruptible
 myPutStrLn x = putStrLn x

*B :t myPutStrLn
myPutStrLn :: (?e_async::()) = String - IO ()

Now it is obvious that myPutStrLn is subject to async interruptions

 test1 x = do myPutStrLn String
  myPutStrLn x

*B :t test1
test1 :: (?e_async::()) = String - IO ()

and so can test1. The compiler figured that out.


 myblock :: ((?e_async::()) = IO a) - IO a
 myblock x = let ?e_async = undefined -- meaning, we `handle' the exc
 in block x

If we try to 
*B test1 here

interactive:1:0:
Unbound implicit parameter (?e_async::())
  arising from use of `test1' at interactive:1:0-11
In the expression: test1 here
In the definition of `it': it = test1 here

meaning that we ought to `handle' that exceptional condition. The
typechecker will not let us overlook the test.

 -- ?e_async::t causes a problem: we really have to `handle' it
 -- main = test1 here

 test3 = myblock (test1 here)

*B :t test3
test3 :: IO ()

The type of test3 shows that the condition is `handled'. And so test3
may now be run.

 (Something like this is straightforward to build if I abandon
 Concurrent Haskell and use cooperative threading, and if the
 operations I wanted to perform could be done asynchronously.)
All operations could be done asynchronously, at least on Linux and
many Unixes:

http://www.usenix.org/events/usenix04/tech/general/full_papers/elmeleegy/elmeleegy_html/index.html

 (Something like this is straightforward to build if I abandon
 Concurrent Haskell and use cooperative threading, and if the
 operations I wanted to perform could be done asynchronously.)

That seems as a very good idea. You might be aware that well-respected
and well-experienced systems researchers call for *abandoning*
threads. Threads are just a very bad model.

The Problem with Threads
Edward A. Lee
http://www.eecs.berkeley.edu/Pubs/TechRpts/2006/EECS-2006-1.html
Also, IEEE computer, May 2006, pp. 33-42.

From the abstract:
``Although threads seem to be a small step from sequential computation,
in fact, they represent a huge step. They discard the most essential
and appealing properties of sequential computation: understandability,
predictability, and determinism. Threads, as a model of computation,
are wildly nondeterministic, and the job of the programmer becomes one
of pruning that nondeterminism. Although many research techniques
improve the model by offering more effective pruning, I argue that
this is approaching the problem backwards.  Rather than pruning
nondeterminism, we should build from essentially deterministic,
composable components. Nondeterminism should be explicitly and
judiciously introduced where needed, rather than removed where not
needed. The consequences of this principle are profound. I argue for
the development of concurrent coordination languages based on sound,
composable formalisms. I believe that such languages will yield much
more reliable, and more concurrent programs.''


I believe that delimited continuations is a good way to build
coordination languages, because delimited continuations let us build a
sound model of computation's interaction with its context.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re[2]: [Haskell-cafe] dropSpace not exported in ByteString

2007-11-16 Thread Bulat Ziganshin
Hello Duncan,

Friday, November 16, 2007, 2:43:05 PM, you wrote:

 Alternatively, someone should make the case for why it should be added
 to bytestring but not list.

the reason is very simple - FPS lib is upgradeable, so there is no
problems if its various versions are not compatible with each other.
adding anything to base library is a nightmare, meaning that
programs that use this new functionality, will be compatible only with
GHC HEAD in the next 0-12 months

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Knot tying vs monads

2007-11-16 Thread Brent Yorgey
 but isn't there a short text that describes in detail why foldl' is
 different from foldl and why foldr is better in many cases? I thought
 this faq would have been cached already :)


Perhaps you're thinking of http://haskell.org/haskellwiki/Stack_overflow ?

-Brent
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The percent operator

2007-11-16 Thread Brent Yorgey
On Nov 16, 2007 9:44 AM, PR Stanley [EMAIL PROTECTED] wrote:

 Hi
 I understand 2%4 will construct a fraction in Haskell. I've tried
 this in GHCI but got an error message. Is there such an operator in
 Prelude and if so how is it applied?
 Cheers,
 Paul


It's in Data.Ratio.

Prelude :m +Data.Ratio
Prelude Data.Ratio 2%4
1%2

-Brent
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] HTTP actions proxy server

2007-11-16 Thread Jim Burton


Justin Bailey wrote:
 
 
 I think it needs to be a real URL:
 
   setProxy (Proxy http://myproxy:80; Nothing)
 
 Justin
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe
 
 
The docs say Should be of the form http://host:port, host, host:port, or
http://host; but none of the variations work. Any ideas where I might find
an example of code that does this?

-- 
View this message in context: 
http://www.nabble.com/HTTP-actions---proxy-server-tf4815272.html#a13792542
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] emacs haskellers: r-stripping files becomes popular

2007-11-16 Thread Brent Yorgey
On Nov 16, 2007 11:14 AM, Valery V. Vorotyntsev [EMAIL PROTECTED] wrote:

 Add the following lines to your ~/.emacs:

 --- BEGIN OF ELISP CODE ---
 ;(global-set-key (kbd f9 s) 'delete-trailing-whitespace)

 (defun delete-trailing-whitespace-if-confirmed ()
  Delete all the trailing whitespace across the current buffer,
 asking user for confirmation.
  (if (and (save-excursion (goto-char (point-min))
   (re-search-forward [[:space:]]$ nil t))
   (y-or-n-p Delete trailing whitespace? ))
  (delete-trailing-whitespace)))

 (add-hook 'before-save-hook 'delete-trailing-whitespace-if-confirmed)
 --- END OF ELISP CODE ---


Nice!  Is there a way to have this only run if the current buffer is in
haskell-mode?  I'd add it myself but I've not yet taken the plunge to being
an elisp hacker.

-Brent
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] RFC: demanding lazy instances of Data.Binary

2007-11-16 Thread Don Stewart
nicolas.frisby:
 I've noticed a few posts on the cafe, including my own experience,
 where the spine-strictness of the Binary instance for lists caused
 some confusion. I'd like to suggest an approach to preventing this
 confusion in the future, or at least making it easier to resolve.
 
 Having decided that it is indeed appropriate for some standard
 instances to be strict by default [1], I think it would be beneficial
 to standardize an approach for expressing that a lazy instance is
 expected. I propose the following newtype be added to Data.Binary. A
 demonstration immediately follows.
 
  newtype Lazily a = Lazily { unLazily :: a }
 
  -- example instance
  instance Binary a = Binary (Lazily [a]) where
  -- lazy get and put
 
 Now
 
  [1..] = (unLazily . decode . encode . Lazily) [1..]
 
 instead of
 
  _|_ = (decode . encode) [1..]
 
 This email is a request for comments on this concept. I think it is a
 minimal way of expressing the intent that the serialisation be lazy
 [2]. Please share any concerns or suggestions. I'll submit a patch
 once the discussion is complete... or if it becomes inactive ;)

I think this is a good compromise: allowing laziness for those who need
it, in a clean manner. How about we provie

Data.Binary.Lazy

with the Lazy newtype, and lazy instances for types that make sense to
be so?

For now, this can be developed as a single module depending on
Data.Binary. What do you think, Nick?

 
 1 - One solution is to make all standard Binary instances lazy
 wherever possible, but I presume that in most cases it's not needed
 and the compactness gained through default strictness (such as the []
 instance) is quite significant.

Yes, that's the argument.

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: List of all powers

2007-11-16 Thread apfelmus

Calvin Smith wrote:

I really look forward to apfelmus' consistently outstanding
explanations on haskell-cafe.

If some of the especially good ones were bundled up as book --
*Intermediate/Advanced Functional Programming with Haskell* -- I would
buy it sight unseen (hint, hint).


:)

I intend the Haskell wikibook

  http://en.wikibooks.org/wiki/Haskell

to be(come) the one Beginner/Intermediate/Advanced Functional
Programming book and the mailing list can also be seen as a marvelous 
source of materials, like real world questions, problems, techniques 
etc for that. The wikibook hasn't gained much momentum yet, but I guess 
that's also partly to the fact that writing a good tutorial is time 
consuming and harder than I imagined, mailing list rants are far easier :)



Regards,
apfelmus

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Guidance on using asynchronous exceptions

2007-11-16 Thread Aaron Denney
On 2007-11-16, Yang [EMAIL PROTECTED] wrote (quoting a paper):
 This style of concurrency is, of course, not new. Component
 architectures where data flows through components (rather than
 control) have been called 'actor-oriented' [35]. These can take many
 forms. Unix pipes resemble PN, although they are more limited in that
 they do not support cyclic graphs.

This isn't quite true.  Unix pipes support cyclic graphs just fine.
Many programs can't handle this due to buffering (on both input and
output).  Further, most Unix shells can't set them up.  C programs,
or anything else that exposes the underlying calls, can set them up
easily enough.

-- 
Aaron Denney
--

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] dropSpace not exported in ByteString

2007-11-16 Thread Olivier Boudry
Hi all,

I'm writing a Haskell program to do some address cleansing. The program uses
the ByteString library.

Data.ByteString.Char8 documentations shows functions for removing whitespace
from start or end of a ByteString. Those functions are said to be more
efficient than the dropWhile / reverse mixes.

It looks exactly like what I'm searching for, but apparently those functions
are not exported by the Data.ByteString.Char8 module. Are those functions
only called by rules? Transformation of dropWhile isSpace into dropSpace?
I've seen such a rule for dropSpace but did not found an equivalent rule for
dropSpaceEnd.

Is there a way to call the dropSpace and dropSpaceEnd or do I have to code
with dropWhile and hope that some rule will magically transform my
dropWhileS into dropSpaceS?

Thanks,

Olivier.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Flymake Haskell

2007-11-16 Thread Philip Armstrong

On Thu, Nov 15, 2007 at 02:56:32PM +0900, Daisuke IKEGAMI wrote:

Dear Stefan and Haskell-Cafe,

Thanks to keeping your interest to the flymake-mode for Haskell.

Stefan wrote:

Could you explain to me what flycheck_haskell.pl does, and give an
example of a problematic situation solved by the use of
flycheck_haskell.pl. 


Sure. 



I'll add in passing that fixing flymake to cope with multi-line errors
was fairly simple  obviates the need for the extra perl script.

I can pass on patches if anyone cares.

Phil

--
http://www.kantaka.co.uk/ .oOo. public key: http://www.kantaka.co.uk/gpg.txt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] RFC: demanding lazy instances of Data.Binary

2007-11-16 Thread Don Stewart
dons:
 nicolas.frisby:
  I've noticed a few posts on the cafe, including my own experience,
  where the spine-strictness of the Binary instance for lists caused
  some confusion. I'd like to suggest an approach to preventing this
  confusion in the future, or at least making it easier to resolve.
  
  Having decided that it is indeed appropriate for some standard
  instances to be strict by default [1], I think it would be beneficial
  to standardize an approach for expressing that a lazy instance is
  expected. I propose the following newtype be added to Data.Binary. A
  demonstration immediately follows.
  
   newtype Lazily a = Lazily { unLazily :: a }
  
   -- example instance
   instance Binary a = Binary (Lazily [a]) where
   -- lazy get and put
  
  Now
  
   [1..] = (unLazily . decode . encode . Lazily) [1..]
  
  instead of
  
   _|_ = (decode . encode) [1..]
  
  This email is a request for comments on this concept. I think it is a
  minimal way of expressing the intent that the serialisation be lazy
  [2]. Please share any concerns or suggestions. I'll submit a patch
  once the discussion is complete... or if it becomes inactive ;)
 
 I think this is a good compromise: allowing laziness for those who need
 it, in a clean manner. How about we provie
 
 Data.Binary.Lazy
 
 with the Lazy newtype, and lazy instances for types that make sense to
 be so?
 
 For now, this can be developed as a single module depending on
 Data.Binary. What do you think, Nick?

I'd like to also use strictCheck, as we did for the stream fusion
library, to state and check strictness properties for the instances,
since getting this clear and correct seems to be a common FAQ with
Binary.

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ghc 6.8.1 bug?

2007-11-16 Thread Alberto Ruiz
Simon, I have only tested 32-bit machines, I will try to test also on 64-bit.

Michael, I have also observed strange ATLAS behavior. For example, I can make 
atlas3-sse2 segfault on big matrices (1000x1000) in ubuntu 6.06 and 7.04, so 
I typically use atlas3-base. In fact, I found a similar problem:

http://article.gmane.org/gmane.linux.debian.devel.bugs.general/323065

(However, atlas3-sse2 seems to work well in ubuntu 7.10...)

But I have removed ATLAS and the problem persists even with the basic refblas3 
and lapack available in my ubuntu 6.06: lapack3-dev 3.0.2000531a-6ubuntu2. 
And I can even produce errors on GSL functions.

In my particular case all errors disappear if I set -O0 or -O -fvia-C. I will 
try to find a minimal test case exposing the problem with -fasm.

Alberto


On Friday 16 November 2007 11:30, Michael McNeil Forbes wrote:
 Just out of curiosity, what LAPACK and BLAS implementation is causing
 problems?  I have no idea if there is anything related, but I have
 been having similar sounding problems with python when using the
 latest ATLAS library on 64 bit core 2 machines.  I am beginning to
 suspect that there may be something wrong in ATLAS, but I don't have
 any definite evidence yet because the bug is also rather elusive here.

 Michael.

 On 16 Nov 2007, at 2:13 AM, Simon Peyton-Jones wrote:
  Alberto, SevenThunders, Joel,
 
  Glark. This is not good. Thank you for being so polite about it.
  And thanks for working on a reproducible test case -- without that
  we are 100% stuck.
 
  We did fix one just-possibly-related bug in 6.8 recently, which
  concerned the use of {-# UNPACK #-} on strict Double-sized fields
  in fixed, top-level data structures. I think it was only wrong on a
  64-bit machine.
  http://www.haskell.org/pipermail/glasgow-haskell-users/2007-
  November/013454.html
  What is the word size on your machine?
 
  But that may well be a complete red herring.  We'll stand by.
 
  Simon
 
  | -Original Message-
  | From: [EMAIL PROTECTED] [mailto:haskell-cafe-
 
  [EMAIL PROTECTED] On Behalf Of Alberto Ruiz
 
  | Sent: 15 November 2007 08:44
  | To: haskell-cafe@haskell.org
  | Subject: Re: [Haskell-cafe] ghc 6.8.1 bug?
  |
  | Hello,
  |
  | I have had exactly the same problem with my bindings to GSL, BLAS
 
  and LAPACK.
 
  | The foreign functions (!) randomly (but very frequently) produced
 
  NaN with
 
  | ghc-6.8.1 -O. As usual, I first thought that I had a subtle bug
 
  related to
 
  | the foreign pointers, but after a lot of refactoring,
 
  experiments, and
 
  | tracing everything, I'm reasonably sure that memory is safely
 
  used. What I
 
  | have found is that the same errors can be reproduced on ghc-6.6.1
  | with -O -fasm. So I tried -O -fvia-C on ghc-6.8.1 (which now it
 
  is not the
 
  | default) and apparently everything works well. So it seems that
 
  now the ffi
 
  | requires and additional and explicit -fvia-C. In any case I don't
 
  know
 
  | why -fasm produces those strange NaN in precompiled foreign
 
  functions...
 
  | Alberto
  |
  | On Thursday 15 November 2007 09:05, SevenThunders wrote:
  |  The good news is that my code compiles without error and much
 
  faster under
 
  |  ghc 6.8.1.
  |  The bad news is that there appear to be subtle bugs that did
 
  not occur when
 
  |  I compiled things under
  |  6.6.1.  One issue is that my code is somewhat complex and links
 
  into a  C
 
  |  library as well.
 
  ___
  Haskell-Cafe mailing list
  Haskell-Cafe@haskell.org
  http://www.haskell.org/mailman/listinfo/haskell-cafe

 --
 Mailing address:

 Michael McNeil Forbes
 UW Dept. of Physics
 Box 351560
 Seattle, WA, 98195-1560
 For couriers:

 Physics/Astronomy Building, Room C121
 3910 15th Ave NE
 Seattle, WA, 98195-1560

 If you would like to visit me personally:
 Room B482 (Fourth floor)
 (206) 543-9754
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] A small question

2007-11-16 Thread Andrew Coppin

Sebastian Sylvan wrote:

On Nov 15, 2007 6:56 PM, Andrew Coppin [EMAIL PROTECTED] wrote:
  

I notice that in GHC 6.8.1, if I compile a runnably program, as well as
generating foo.exe, GHC now also generates a file foo.exe.manifest,
which appears to contain some kind of XML data. Anybody know anything
about this mysterious file?



I think it's a Windows Vista Manifest (used to let the OS know what
user privileges are required to run the application).
  


Ah, right. That makes sense...

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] RFC: demanding lazy instances of Data.Binary

2007-11-16 Thread Nicolas Frisby
I've noticed a few posts on the cafe, including my own experience,
where the spine-strictness of the Binary instance for lists caused
some confusion. I'd like to suggest an approach to preventing this
confusion in the future, or at least making it easier to resolve.

Having decided that it is indeed appropriate for some standard
instances to be strict by default [1], I think it would be beneficial
to standardize an approach for expressing that a lazy instance is
expected. I propose the following newtype be added to Data.Binary. A
demonstration immediately follows.

 newtype Lazily a = Lazily { unLazily :: a }

 -- example instance
 instance Binary a = Binary (Lazily [a]) where
 -- lazy get and put

Now

 [1..] = (unLazily . decode . encode . Lazily) [1..]

instead of

 _|_ = (decode . encode) [1..]

This email is a request for comments on this concept. I think it is a
minimal way of expressing the intent that the serialisation be lazy
[2]. Please share any concerns or suggestions. I'll submit a patch
once the discussion is complete... or if it becomes inactive ;)

Thanks for your time,
Nick



1 - One solution is to make all standard Binary instances lazy
wherever possible, but I presume that in most cases it's not needed
and the compactness gained through default strictness (such as the []
instance) is quite significant.



2 - A more involved option is to recognize that serialisation always
maps to a sequence, and so create another standard data type and
class.

 data Chunks a = Empty | Chunk !a (Chunks a) -- a la lazy bytestrings

 instance Binary a = Binary (Chunks a) where
   -- lazy put and get

 class Chunky a chunk | a - chunk where
   toChunks :: a - Chunks chunk
   fromChunks :: Chunks chunk - a

All of this machinery, however, may prematurely emphasize
problem-specific concerns. Thus it obfuscates the point: we just want
sufficient laziness. Whatever ends up happening, the Chunks data type
may be a route so common for Lazily instances that it makes sense to
provide it in a library (?
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/strict-0.2).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Showing Data.Ratio - different on GHC vs Hugs/Yhc

2007-11-16 Thread Neil Mitchell
Hi

Under Hugs and Yhc, showing a Ratio 1%2 gives 1 % 2. Under GHC
showing 1%2 gives 1%2. Does the standard say anything about this? Is
someone wrong? And how do Yhc/nhc/Hugs pass Bernouilli in the Nofib
suite given that the output doesn't match?

Thanks

Neil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskellforge?

2007-11-16 Thread Henning Thielemann

On Thu, 15 Nov 2007, Duncan Coutts wrote:

 On Thu, 2007-11-15 at 15:56 -0200, Maurí­cio wrote:
  Hi,
 
  Is there a Haskellforge somewhere, i.e.,
  something like a sourceforge for open source
  Haskell programs, with darcs, automatic
  cabalization etc.? Has anyone tried that
  already?

 There is the Haskell Community server http://community.haskell.org/

 It hosts darcs repos at http://code.haskell.org/

 You can request an account and projects via:
 http://community.haskell.org/admin/

 There are currently 44 registered developers and 41 hosted projects.

It seems that I have missed something because I'm still working on
darcs.haskell.org

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Chart plotting libraries

2007-11-16 Thread David Roundy
On Thu, Nov 15, 2007 at 10:35:06PM -, Tim Docker wrote:
 droundy:
  Chart has rather a complicated API.  I've written a simpler API (but
  somewhat less flexible), if anyone's interested (Tim wasn't).  My API is
  closer in complexity (of use) to matlab's plotting.
 
 I'd describe the API as verbose rather than complicated. It takes 5-10
 lines of haskell to define a chart - see the examples on the web page. I
 think this is fine for use within other code, but I agree is too much
 typing for interactive use.

Okay, verbose then.  5-10 lines to define a chart is 4-9 lines too many.
-- 
David Roundy
Department of Physics
Oregon State University
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] A small question

2007-11-16 Thread Andrew Coppin

J. Garrett Morris wrote:

http://msdn2.microsoft.com/en-us/library/1w45z383(vs.71).aspx

I believe.
  


Interesting. Not sure what the connection between Haskell and .NET is... 
(But then, despite a lot of research, I don't know what .NET is.)


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskellforge?

2007-11-16 Thread Don Stewart
briqueabraque:
 Hi,
 
 Is there a Haskellforge somewhere, i.e.,
 something like a sourceforge for open source
 Haskell programs, with darcs, automatic
 cabalization etc.? Has anyone tried that
 already?
 

We use 
http://community.haskell.org/
which you can ask for an account on.

with darcs repos hosted here:
http://code.haskell.org/

automatic cabalisation can be done with mkcabal, and other tools,
http://haskell.org/haskellwiki/How_to_write_a_Haskell_program

Cheers,
  Don


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] dropSpace not exported in ByteString

2007-11-16 Thread Olivier Boudry
On 11/15/07, Don Stewart [EMAIL PROTECTED] wrote:


 Let me know if the rule fires. If it isn't, that's a bug, essentially.

 -- Don


Don,

As you can see the rule fires.

C:\Tempghc --make -O2 -fasm -ddump-simpl-stats DropSpaceTest.hs
...
3 RuleFired
1 FPS pack/packAddress
2 FPS specialise dropWhile isSpace - dropSpace
...

By the way, what's the reason dropSpaceEnd is defined but not exported nor
used through a rule? I'm just curious.

Best regards,

Olivier.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] A small question

2007-11-16 Thread Andrew Coppin
I notice that in GHC 6.8.1, if I compile a runnably program, as well as 
generating foo.exe, GHC now also generates a file foo.exe.manifest, 
which appears to contain some kind of XML data. Anybody know anything 
about this mysterious file?


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re[2]: [Haskell-cafe] the interact function and Hugs/ghci on Windows ...

2007-11-16 Thread Bulat Ziganshin
Hello Neil,

Friday, November 16, 2007, 3:07:57 PM, you wrote:
 The released version of WinHugs does not support Ctrl+Z or Ctrl+D, but
 the development builds do.

btw, are you plan to release hugs version compatible with ghc 6.8?

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] A small question

2007-11-16 Thread Sebastian Sylvan
On Nov 15, 2007 6:56 PM, Andrew Coppin [EMAIL PROTECTED] wrote:
 I notice that in GHC 6.8.1, if I compile a runnably program, as well as
 generating foo.exe, GHC now also generates a file foo.exe.manifest,
 which appears to contain some kind of XML data. Anybody know anything
 about this mysterious file?

I think it's a Windows Vista Manifest (used to let the OS know what
user privileges are required to run the application).

-- 
Sebastian Sylvan
+44(0)7857-300802
UIN: 44640862
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Erik Meijer's talk at Google?

2007-11-16 Thread David Benbennick
Google's Tech Talks channel is at
http://www.youtube.com/googletechtalks.  There doesn't seem to be any
video of Erik Meijer there.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] emacs haskellers: r-stripping files becomes popular

2007-11-16 Thread Valery V. Vorotyntsev
On 11/16/07, Brent Yorgey [EMAIL PROTECTED] wrote:
 Nice!  Is there a way to have this only run if the current buffer is in
 haskell-mode?  I'd add it myself but I've not yet taken the plunge to being
 an elisp hacker.

Try adding ``(eq major-mode 'haskell-mode)'' after the `and' ..
.. but why would you tolerate whitespace in other modes?

--
vvv
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] emacs haskellers: r-stripping files becomes popular

2007-11-16 Thread Valery V. Vorotyntsev
Add the following lines to your ~/.emacs:

--- BEGIN OF ELISP CODE ---
;(global-set-key (kbd f9 s) 'delete-trailing-whitespace)

(defun delete-trailing-whitespace-if-confirmed ()
  Delete all the trailing whitespace across the current buffer,
asking user for confirmation.
  (if (and (save-excursion (goto-char (point-min))
   (re-search-forward [[:space:]]$ nil t))
   (y-or-n-p Delete trailing whitespace? ))
  (delete-trailing-whitespace)))

(add-hook 'before-save-hook 'delete-trailing-whitespace-if-confirmed)
--- END OF ELISP CODE ---

Have fun!

--
vvv
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: let vs. where

2007-11-16 Thread Jules Bean

John Lato wrote:

This actually clears up something that's been bothering me for some
time.  I've never really like syntax of types for functions with
multiple arguments.  Using the same token, -, to separate both
arguments and the result seems very poor, because when reading a type
you don't know if the value after that token is another argument or
the final result without going further ahead.  However, knowing that a
function takes exactly one argument makes the syntax seem much more
expressive for me.



Right. This is because - doesn't separate arguments from each other. It 
separates the one and only argument from the one and only result:


a - b - c - d


Has one argument of type 'a' and returns one result,
of type 'b - c - d'

The syntax is therefore consistent and uniform if a bit surprising at 
first glance.


It turns out that we can usefully think of this as having three 
arguments and one result, but it doesn't really. It has one argument and 
one result. (It's just the result itself takes arguments!)


Jules
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Showing Data.Ratio - different on GHC vs Hugs/Yhc

2007-11-16 Thread David Menendez
On Nov 16, 2007 2:12 PM, Neil Mitchell [EMAIL PROTECTED] wrote:
 Under Hugs and Yhc, showing a Ratio 1%2 gives 1 % 2. Under GHC
 showing 1%2 gives 1%2. Does the standard say anything about this? Is
 someone wrong? And how do Yhc/nhc/Hugs pass Bernouilli in the Nofib
 suite given that the output doesn't match?

Judging by the Read instance, the whitespace isn't considered significant.

Prelude Data.Ratio map read [1%2, 1 % 2,  1   %   2 ] :: [Rational]
[1%2,1%2,1%2]


-- 
Dave Menendez [EMAIL PROTECTED]
http://www.eyrie.org/~zednenem/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Showing Data.Ratio - different on GHC vs Hugs/Yhc

2007-11-16 Thread Twan van Laarhoven

Neil Mitchell wrote:


Hi

Under Hugs and Yhc, showing a Ratio 1%2 gives 1 % 2. Under GHC
showing 1%2 gives 1%2. Does the standard say anything about this? Is
someone wrong?


Yes, ghc is wrong here, the Haskell 98 report [1] specifies:

instance  (Integral a)  = Show (Ratio a)  where
showsPrec p (x:%y)  =  showParen (p  ratPrec)
   (showsPrec (ratPrec+1) x .
showString  %  .
showsPrec (ratPrec+1) y)

While it doesn't really matter, it is a deviation from the standard.

I would personally prefer it if rationals were shown as 1%2, because 
the space is not needed, and other show instances such as lists don't 
insert spaces either.


[1]: http://haskell.org/onlinereport/ratio.html

Twan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] New demo/test program for Yhc Javascript backend

2007-11-16 Thread Dimitry Golubovsky
Hi,

For those of you who are interested in using Haskell in client-side
web application programming:

I have added a new demo/test program to this Wiki page (Does it leak?):

http://haskell.org/haskellwiki/Yhc/Javascript

This demo program shows some progress made since the first
announcement of Yhc Javascript backend (Core to Javascript converter)
was made about a year ago. Please test the demo for functionality and
memory leaks in various browsers. Your feedback is appreciated.

The demo program is self-contained (does not require any Haskell
libraries beyond those included with Yhc). There is a darcs repo:
http://www.golubovsky.org/repos/wsptest/ from which this demo program
along with Makefile can be obtained if anybody wants to play with the
code.

Thanks.

-- 
Dimitry Golubovsky

Anywhere on the Web
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe