Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Jimmy Hartzell
> Am Mittwoch 23 September 2009 04:06:11 schrieb Jimmy Hartzell:
>> Daniel Fischer wrote:
>> > Or, what I do:
>> >
>> > concat
>> > [ "("
>> > , str
>> > , ")"
>> > ]

You're right: my objections to this seem mostly to be matters of taste --
as I think about it, I find fewer and fewer practical reasons for
disliking it. I  still would prefer it if the proposal were implemented
(and I would modify it so brackets weren't mismatched), and I'm still
interested in implementing it, if only so I (and others) can do
programming projects both ways and see if it actually makes a big
difference.



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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Daniel McAllansmith
On Wed, 23 Sep 2009 15:06:25 Daniel Fischer wrote:
> Am Mittwoch 23 September 2009 04:06:11 schrieb Jimmy Hartzell:
> > Daniel Fischer wrote:
> > > Or, what I do:
> > >
> > > concat
> > > [ "("
> > > , str
> > > , ")"
> > > ]
> >
> > This is a lot better, true, but it still takes a lot of typing, and the
>
> Huh? Per line it's two keystrokes more than with the accessible layout
> proposal. That's not a lot.
>
> > first element is now special-cased, preventing easy copy-and-paste
>
> Making it slightly harder. Copy-Paste-Cursor to beginning-delete-comma.
> No big deal. Besides, how often does one need to copy the beginning of one
> list into the middle of another?

Or you could use:

concat (
  : "("
  : str
  : ")"
  :[])

Though you do sometimes have to bracket an element that you wouldn't otherwise 
have to, eg

concat (
  : "("
  : str
  : ('a':'b':[])
  : ")"
  :[])
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Richard O'Keefe


On Sep 23, 2009, at 3:40 PM, James Hartzell wrote:

I asked for the trailing comma in Erlang for _social_ reasons,
not because I believed it would fix all problems of this type.


What do you mean, for social reasons?


The proposal is http://www.erlang.org/eeps/eep-0021.html

The abstract says "Allow an extra comma at the end of a list
or tuple.  Darren New proposed this change; Richard O'Keefe,
who doesn't like it very much, wrote it up as an EEP."

Later on, we find the text
"I don't actually feel any need for this proposal;
I believe that the answer is better tool support.
However, many people are wedded to their tools, even more than
their programming languages. Darren New is not the only one to
have asked for it, and with about 1 SLOC in 110 of the Erlang/OTP
sources reflecting a list or tuple where this feature could have
been used, it's very much a low cost high public appreciation
feature."

It was a feature that people *wanted* because they were used
to in other languages and it could be added at comparatively
low cost (there's only one Erlang implementation worth
bothering about) without breaking existing tools.  Adding it
would please many existing and potential Erlang programmers
without ing off too many others (you don't _have_ to
write the extra comma, and it's not that obtrusive when you
read other people's code), and it would remove some complaints
and criticisms from the mailing list, so, social reasons.
I don't believe it solves any problem that can't be better
solved any other way, but at least optional trailing commas
don't *hurt* anything.

This might actually be different in Haskell, which allows
things like (,,).  You can't add a trailing comma here
without breaking things.

The #( #[ #$ # proposal, on the other hand,
WOULD break things.  "#" is currently an 'ascSymbol',
so the character sequences #( and #[ may occur in
legal Haskell code.

infix #

x # y = (x,y)

foo x y = x #( y )

bar x z = x #[ z ]

As for "all problems of this type", I agree in theory, but often  
enough,

for an operator @@, you can use foldl1 (@@) [...] and reduce it to the
trailing comma problem (notable exceptions include (.) and ($) and  
other
operators where the type is different for the intermediate return  
values

-- and this, I take it, is why '$#' is in the proposal).


I am a bit puzzled here.
This seems to mean something like
 "If you take readable code using an operator you can
  make it less readable, and when you do that you create
  another problem as well, and an even less readable hack
  can fix that."

"I know an old lady who swallowed a fly..."


I don't see how this is all that revolutionary,


I don't think anyone claims that it is.
The claims are that it is
 - not needed
 - not pleasant to look at
 - not good for existing syntax-(semi-)aware tools
 - not backwards compatible with existing code

I am not at all committed to the specifics. Would it be better if  
there

were keywords like 'list#', 'tuple#', or maybe '(#)', '[#]' etc?


But of course!




I guess where I'm coming from is: I don't like my expressions to be  
full
of parentheses or hard-to-track operator precedences, and find it  
harder
to read, to write, and to maintain, even for toy examples like the  
ones

we've been discussing.


There's no accounting for taste.

I find invisible operators much harder to deal with than
parentheses.

So we agree to differ.

Changing the proposal to something that doesn't spoil bracket
matching and doesn't break previously legal Haskell' code
(note the prime; I'm not fighting old battles again) would
make a huge difference.  I still wouldn't _like_ it, but
wouldn't have such strong reasons to _oppose_ it.

For what it's worth, I've used an experimental language
where
 - immediately after ( [ { or an infix or prefix operator,
   newlines were treated like any other white space
 - in other contexts, newlines inside ( [ were treated as
   commas
 - in other contexts, newlines were treated as semicolons
 - trailing commas and semicolons were allowed

In Haskell terms, this would mean that

(
1
2
3
)

meant (1,2,3) and

[
1
2
3
]

meant [1,2,3] and 'do' and 'case' worked as now.

By adding

f $$ (x,y) = f x y
f $$ (x,y,z) = f x y z
f $$ (x,y,z,a) = f x y z a
...

you could also have

f $(
1
2
3
)

meaning f 1 2 3.
I am aware that this is not backwards compatible with existing
code, and I am not proposing this for adoption.

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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Richard O'Keefe


On Sep 23, 2009, at 3:04 PM, Evan Laforge wrote:


It would be so much better if we could discuss a _real_
example.


Or implement one.


I really did mean EXAMPLES.  Examples of code which would
be improved *more* by the proposal than by adopting an
alternative style within the existing language.

Let's not forget what the proposal actually _is_.
It is that "#(" "#[" "#$" and "#" should become magic
tokens such that

#( {a;b;c}  is read as  (a,b,c)
#[ {a;b;c}  is read as  [a,b,c]
  f #$ {a;b;c}  is read as  f (a) (b) (c)
#  {a;b;c}  is read as  {a,b,c}

[http://www.haskell.org/haskellwiki/Accessible_layout_proposal]

Are you not troubled by the inconsistencies here?
Why isn't the last case #{ to match #( and #[?
Why does #$ add extra parentheses but not the others?

Are you not troubled by the fact that it breaks the automatic
bracket matching in editors like Vim, Emacs, XCode, ...?
I _can_ hack on Emacs if I have to, but I _can't_ hack on
XCode.  In fact it breaks bracket matching in two ways:
 - clicking just after #( doesn't select the tuple the
   way that clicking just after ( does
 - the excess imbalanced bracket wrecks matching for
   anything that includes an #( or #[

That's a *lot* to give up for less readable code!

In effect, the proposal is that there should be a context-
sensitive overloading of  to mean
- nothing  (existing case)
- semicolon (existing case)
- >> or >>= (existing case)
- comma (for #( and #[ and #)
- nothing, except parentheses magically go somewhere else

That's too many overloadings for me.  'do' was already too
many overloadings for me to be comfortable with, which is
one reason why I avoid it.

On small examples, I find no advantage.

Let's see a real medium-size example.
The heavy costs that I can see might just be overwhelmed by
advantages in real use.

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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Jimmy Hartzell
Richard O'Keefe wrote:
> After all, someone might have started with
>   (
> "(" ++
> str ++
> ")"
>   )
> and ended up with
>   (
> "(" ++
> str ++
> ")" -- (oops, no ++!)
> lineEnd -- forgot I needed this
>  )
>
> I asked for the trailing comma in Erlang for _social_ reasons,
> not because I believed it would fix all problems of this type.

What do you mean, for social reasons? And are there any projects/feature
requests to add the trailing comma to ghc?

As for "all problems of this type", I agree in theory, but often enough,
for an operator @@, you can use foldl1 (@@) [...] and reduce it to the
trailing comma problem (notable exceptions include (.) and ($) and other
operators where the type is different for the intermediate return values
-- and this, I take it, is why '$#' is in the proposal). If I need to use
'a @@ b @@ c' for any operator @@, I rewrite it with a fold (if possible),
because I find it more readable to not repeat the operator over and over
again. I find lists more semantically appealing in this situation: you
really are listing things.

> Actually, I'd write
>
> main =
>  getChar >>= \a ->
>  bracket_ (enter a) (exit a) (putChar a >> putStrLn "hello")
>
> so even _with_ this proposal, I'd still need exactly the same
> parentheses.

Doing monads without do-notation gets me into precedence trouble pretty
quickly -- I find myself adding lots and lots of parentheses, until it
ends up looking like Lisp (which I've always found hard on the eyes,
keeping track of how many layers you have -- indentation is better for
this, in my opinion). The fact that $ can't be used for the last
expression of the bracket_ is an example of the precedence trouble I get
into.

I agree that this proposal makes a lot less sense if you don't also use
do-notation.

> Where I'm coming from is this:
>I do not find meaningless jumbles of special characters
>combined with overloaded white space readable.

I find the combination of characters very meaningful and intuitive,
especially if '(#' is chosen over '#(': use an # if you want to put a list
on separate lines (which you'd lay out like that anyway: why not give the
compiler some extra knowledge), and don't use it if it fits on the same
line.

I don't see how this is all that revolutionary, especially as we already
have whitespace-significant and non-whitespace-significant versions of
'case', 'do', etc. I don't even see it as syntactic sugar, but more as an
alternative syntax -- with the exception of '$#' it parses pretty much
directly to the same tree, does it not? It's just changing what's
significant.

I am not at all committed to the specifics. Would it be better if there
were keywords like 'list#', 'tuple#', or maybe '(#)', '[#]' etc? I would
suggest using colon like Python, except for it's taken by the (:)
operator.

I guess where I'm coming from is: I don't like my expressions to be full
of parentheses or hard-to-track operator precedences, and find it harder
to read, to write, and to maintain, even for toy examples like the ones
we've been discussing.



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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Daniel Fischer
Am Mittwoch 23 September 2009 04:06:11 schrieb Jimmy Hartzell:
> Daniel Fischer wrote:
> > Or, what I do:
> >
> > concat
> > [ "("
> > , str
> > , ")"
> > ]
>
> This is a lot better, true, but it still takes a lot of typing, and the

Huh? Per line it's two keystrokes more than with the accessible layout 
proposal. That's 
not a lot.

> first element is now special-cased, preventing easy copy-and-paste

Making it slightly harder. Copy-Paste-Cursor to beginning-delete-comma.
No big deal. Besides, how often does one need to copy the beginning of one list 
into the 
middle of another?

> (although, admittedly, much less opportunity for mistake). On a more
> philosophical level, the signals used by the humans still are different
> from the signals used by the computer, which leads me to suspect such a
> system could still cause confusion.

I don't think so. The dominant factor to the human eye (at least to mine) is 
the layout. 
The commas are rather unobtrusive and go almost unnoticed.

>
> > And that is avoided, because a missing comma leaps to the eye.
>
> True. Drawing this much attention to syntax, however, is part of why I
> find it aesthetically displeasing.

To me, it doesn't draw attention to syntax, only to syntax errors.
When each line has its comma at the beginning, all is fine.
When one line lacks the comma, it looks different and only then spring the 
commas to 
attention.
Of course, it may be different for you.

>
> > Which is a good thing in my eyes.
>
> Well, yes, but it means that when you lay it out the way I was proposing,
> you had two levels of indentation. With the way you're using, it's a lot
> cleaner.
>
> > I see your point but remain not liking the proposal.
>
> Do you mean you see that there is a problem in the language that needs
> fixing, but you just don't like this fix?

I don't consider it a problem in the language. For me it works fine as is.
But I can understand that if

> In summary, I have to spend a good portion of my time coding Haskell
> dealing with the fact that I have a lot of {'s, ['s, and ,'s to keep track
> of, and they rarely fit on one line (records, ADTs, lists). I have to
> spend a significant amount of my coding time finagling the layout to look
> sensible,

there is reason to desire something that would simplify the process.

> Would you be open to a modified version of the proposal?

Maybe. I haven't formed an opinion yet.

> Is it an aesthetic objection, or more philosophical?

On an aesthetic level, I find #( and #[ absolutely terrible. Opening a 
parenthesis (or 
bracket) and not closing it just screams "WRONG!!!" to me.
On the philosophical side, I'm not fundamentally opposed to syntax sugar, but I 
think it 
should be added sparingly. I don't think there is sufficient reason to add this 
sugar, but 
if many argue that there is, I would accept such an addition (just, please 
don't use #( 
and #[).

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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Evan Laforge
> It would be so much better if we could discuss a _real_
> example.

Or implement one.  Unlike some proposals, this could be implemented
with a preprocessor and -F -pgmF, right?  As far as the parsing job, I
don't know how hard this would be to plug into the haskell parsing
library, but in case it is hard, then improving the library to handle
layout extensions would be a nice side-effect even if the preprocessor
never became widely popular.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Richard O'Keefe


On Sep 23, 2009, at 12:24 PM, James Hartzell wrote:


Well, look at code like this:


wrapParens str = concat [
  "(",
  str,
  ")"
 ]


I just did.  I'd write it as

wrap_parens s = "(" ++ s ++ ")"

although I wouldn't use that name, because it's not the
parentheses that are wrapped, it's s.


First off, there is a serious issue with the commas.



You should at least
be allowed to have a comma after the last element, a la Python.


Oh, I agree about that.  I've written an Erlang Extension
Proposal for Erlang about that.


concat [
  "(",
  str,
  ")" -- (oops, no comma!)
  lineEnd -- forgot I needed this
]


"(" ++ str ++ ")" ++ line_end

I'm actually quite serious here.  Using infix ++ we have
the SAME problem about missing ++ as we do about mssing ,
After all, someone might have started with
(
  "(" ++
  str ++
  ")"
)
and ended up with
(
  "(" ++
  str ++
  ")" -- (oops, no ++!)
  lineEnd -- forgot I needed this
)

I asked for the trailing comma in Erlang for _social_ reasons,
not because I believed it would fix all problems of this type.

And as to the "simplifying your code" idea: however "pure" your code  
is,

you will regularly have to embed lists of things in it (ADTs, export
lists, data from the domain). And unless you're claiming it is *almost
always bad style to have code looking like (from the proposal):

main = do
 a <- getChar
 bracket_
 (enter a)
 (exit a)
 (do
 putChar a
 putStrLn "hello")


The thing about toy examples is that they are toy size.
On an example this size, we don't NEED fancy new stuff.

Actually, I'd write

main =
getChar >>= \a ->
bracket_ (enter a) (exit a) (putChar a >> putStrLn "hello")

so even _with_ this proposal, I'd still need exactly the same
parentheses.  One thing I might do is this:

enter_exit_bracket a body =
bracket_ (enter a) (exit a) body

and then

main =
getChar >>= \a ->
enter_exit_bracket a (putChar a >> putStrLn "hello")

because it looks very much as if enter and exit exist only
to be passed (with suitable parameters) to bracket_.



But I would *still* rather have:
with a = bracket_ $#
   enter a
   exit a

Layout is easier to read than parentheses.


It all depends on size (small things being easy pretty much
no matter what you do) and tools (tools where you click just
inside parentheses and the bracketed thing lights up, like
the traditional Smalltalk interface make parentheses very very
easy to read).



In summary, I have to spend a good portion of my time coding Haskell
dealing with the fact that I have a lot of {'s, ['s, and ,'s to keep  
track

of, and they rarely fit on one line (records, ADTs, lists). I have to
spend a significant amount of my coding time finagling the layout to  
look
sensible, and I don't think anyone would claim that I just shouldn't  
use

records or ADTs.


For what it's worth, the editor I normally use has an
"add new element to list" command.

Where I'm coming from is this:
  I do not find meaningless jumbles of special characters
  combined with overloaded white space readable.

It would be so much better if we could discuss a _real_
example.

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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Jimmy Hartzell
Daniel Fischer wrote:

> Or, what I do:
>
> concat
> [ "("
> , str
> , ")"
> ]

This is a lot better, true, but it still takes a lot of typing, and the
first element is now special-cased, preventing easy copy-and-paste
(although, admittedly, much less opportunity for mistake). On a more
philosophical level, the signals used by the humans still are different
from the signals used by the computer, which leads me to suspect such a
system could still cause confusion.

> And that is avoided, because a missing comma leaps to the eye.

True. Drawing this much attention to syntax, however, is part of why I
find it aesthetically displeasing.

> Which is a good thing in my eyes.

Well, yes, but it means that when you lay it out the way I was proposing,
you had two levels of indentation. With the way you're using, it's a lot
cleaner.

> I see your point but remain not liking the proposal.

Do you mean you see that there is a problem in the language that needs
fixing, but you just don't like this fix? Would you be open to a modified
version of the proposal? Is it an aesthetic objection, or more
philosophical?

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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Daniel Fischer
Am Mittwoch 23 September 2009 02:51:59 schrieb Jimmy Hartzell:
> > On Sep 22, 2009, at 8:01 PM, Jimmy Hartzell wrote:
> >> I am in love with this proposal:
> >> http://www.haskell.org/haskellwiki/Accessible_layout_proposal
(Richard O'Keefe:)
> >
> > I hadn't read it before.  Now that I have, I really do not like
> > it.  "Syntactic sugar causes cancer of the semicolon" as Alan
> > Perlis once said, and to my taste this proposal definitely
> > counts as cancer of the semicolon.  In effect, its purpose
> > is to overload vertical white space.
> >
> > Any time that you have something where you think you need
> > this, it's likely that a better solution is to break what
> > you are doing into smaller pieces.

I don't like it either. I have not nearly a s strong feelings as Mr. O'Keefe, 
but to me it 
doesn't look right.

>
> Well, look at code like this:
>
> wrapParens str = concat [
>"(",
>str,
>")"
>   ]
>
> (And yes, I realize you can do something like this with 'printf "(%s)"
> str'.)

Or, what I do:

concat
[ "("
, str
, ")"
]

(of course, here I would just write '(' : str ++ ")"). I admit it looked odd 
for the first 
couple of hours, but now I find it nice, clean and systematic.

>
> First off, there is a serious issue with the commas. You should at least
> be allowed to have a comma after the last element, a la Python. Otherwise,
> the last one is randomly special in this list, and in a format like this,
> I regularly edit code accidentally leaving off commas, yielding stuff
> like:
>
> concat [
>"(",
>str,
>")" -- (oops, no comma!)
>lineEnd -- forgot I needed this
> ]

And that is avoided, because a missing comma leaps to the eye.

>
> which (of course) results in a very confusing type error. Meanwhile, you
> have to format your code very awkwardly, as the closing bracket can't be
> in the left-most column,

Which is a good thing in my eyes.

> In summary, I have to spend a good portion of my time coding Haskell
> dealing with the fact that I have a lot of {'s, ['s, and ,'s to keep track
> of, and they rarely fit on one line (records, ADTs, lists). I have to
> spend a significant amount of my coding time finagling the layout to look
> sensible, and I don't think anyone would claim that I just shouldn't use
> records or ADTs.

I see your point but remain not liking the proposal.


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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Jimmy Hartzell
>
> On Sep 22, 2009, at 8:01 PM, Jimmy Hartzell wrote:
>
>> I am in love with this proposal:
>> http://www.haskell.org/haskellwiki/Accessible_layout_proposal
>
> I hadn't read it before.  Now that I have, I really do not like
> it.  "Syntactic sugar causes cancer of the semicolon" as Alan
> Perlis once said, and to my taste this proposal definitely
> counts as cancer of the semicolon.  In effect, its purpose
> is to overload vertical white space.
>
> Any time that you have something where you think you need
> this, it's likely that a better solution is to break what
> you are doing into smaller pieces.

Well, look at code like this:

wrapParens str = concat [
   "(",
   str,
   ")"
  ]

(And yes, I realize you can do something like this with 'printf "(%s)" str'.)

First off, there is a serious issue with the commas. You should at least
be allowed to have a comma after the last element, a la Python. Otherwise,
the last one is randomly special in this list, and in a format like this,
I regularly edit code accidentally leaving off commas, yielding stuff
like:

concat [
   "(",
   str,
   ")" -- (oops, no comma!)
   lineEnd -- forgot I needed this
]

which (of course) results in a very confusing type error. Meanwhile, you
have to format your code very awkwardly, as the closing bracket can't be
in the left-most column, and, all in all, you have lots and lots of commas
cluttering up your otherwise clean-looking layout.

You get humans reading the code based off of the physical layout, while
the computer is interpreting it based on the presence of commas, which the
human mind will naturally filter in favor of the layout.

And as to the "simplifying your code" idea: however "pure" your code is,
you will regularly have to embed lists of things in it (ADTs, export
lists, data from the domain). And unless you're claiming it is *almost
always bad style to have code looking like (from the proposal):

main = do
  a <- getChar
  bracket_
  (enter a)
  (exit a)
  (do
  putChar a
  putStrLn "hello")

then the same argument holds for $# (which I expect is the most
controversial part of the proposal): the humans read the layout, the
computers read the parentheses, and there are many opportunities for
error. I mean, probably in this case the code could stand to be changed
to:

with a = bracket_ (enter a) (exit a)
main = do
   a <- getChar
   with a $ do
putChar a
putStrLn "hello"

But I would *still* rather have:
with a = bracket_ $#
enter a
exit a

Layout is easier to read than parentheses.

In summary, I have to spend a good portion of my time coding Haskell
dealing with the fact that I have a lot of {'s, ['s, and ,'s to keep track
of, and they rarely fit on one line (records, ADTs, lists). I have to
spend a significant amount of my coding time finagling the layout to look
sensible, and I don't think anyone would claim that I just shouldn't use
records or ADTs.



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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Richard O'Keefe


On Sep 22, 2009, at 8:01 PM, Jimmy Hartzell wrote:


I am in love with this proposal:
http://www.haskell.org/haskellwiki/Accessible_layout_proposal


I hadn't read it before.  Now that I have, I really do not like
it.  "Syntactic sugar causes cancer of the semicolon" as Alan
Perlis once said, and to my taste this proposal definitely
counts as cancer of the semicolon.  In effect, its purpose
is to overload vertical white space.

Any time that you have something where you think you need
this, it's likely that a better solution is to break what
you are doing into smaller pieces.


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


Re: [Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Raynor Vliegendhart
On Tue, Sep 22, 2009 at 10:01 AM, Jimmy Hartzell  
wrote:
> I am in love with this proposal:
> http://www.haskell.org/haskellwiki/Accessible_layout_proposal

I'm not sure whether I like the idea in general or not. It looks a bit
odd. The suggestion on the talk page (
http://www.haskell.org/haskellwiki/Talk:Accessible_layout_proposal )
might be preferable, although I wonder about the implications. For
example, what should (#) be parsed as?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Strange problem with type classes (ghc 6.8.2 looks allright and ghc 6.10.1 doesn't).

2009-09-22 Thread Serguey Zefirov
(followup to my previous letter with the same subject)

I found the way to break 6.8.2 type checker.

It's as easy as to uncomment Div case alternative in valueIndex.

Weird.

I found a solution, though. Instead of (valueIndex (x_38,(x_36,x_37)))
in that Div alternative I should create expression (valueIndex
x_38*valuesCount x_36*valuesCount x_37 + valueIndex x_36 * valuesCount
x_37+valueIndex x_37) which is equivalent to above one.

Slightly more work. And I still cannot figure why valueIndex (a,(b,c))
works in one type and doesn;t in another.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] FFMpeg, SDL and Haskell

2009-09-22 Thread Vasyl Pasternak
Hi all,

Last few days I was playing with FFI, FFMpeg and Haskell. Currently I am
trying to make this tutorial http://www.dranger.com/ffmpeg/ on Haskell. Now
I have done tutorial 01 and tutorial 02 (show video stream in SDL window).

The third tutorial is about audio, and I found that audio doesn't supported
in SDL bindings completely. So I'd like to fill this gap, but I don't know
where to get latest version and to whom I have to send SDL patches.

Anyway, does anybody interested in FFMpeg bindings ? Should I put it on
Hackage ?

The preliminary version I've put on google code:
http://hs-ffmpeg.googlecode.com/files/hs-ffmpeg-0.2.0.tar.gz, but this is
"work on my PC" version.

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


Re: [Haskell-cafe] How to install GD library on Mac OSX?

2009-09-22 Thread Brandon S. Allbery KF8NH

-BEGIN PGP SIGNED MESSAGE-
Hash: SHA1

On Sep 22, 2009, at 13:44 , Colin Adams wrote:
It needs some missing C libraries - gd, png, jpeg, fontconfig and  
freetype.

Does anyone know what to do to install these on OSX?



Customarily, Fink or MacPorts.

Several of those *are* installed on OSX by default (at least Leopard  
and up); if they're not being found, make sure you have installed the  
latest XCode and Apple's X11 (the latter should only matter for Tiger  
and earlier).  You may also want the latest X11 from http://xquartz.macosforge.org 
.


- --
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH


-BEGIN PGP SIGNATURE-
Version: GnuPG v2.0.10 (Darwin)

iEUEARECAAYFAkq5R1sACgkQIn7hlCsL25VVqgCg024xKkPI4fQcKVz1SZp4ca8Y
TmEAkwbId0xKjhL8HmJAIukgVFrTz7E=
=fAaa
-END PGP SIGNATURE-
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Strange problem with type classes (ghc 6.8.2 looks allright and ghc 6.10.1 doesn't).

2009-09-22 Thread Serguey Zefirov
I try to create yet another hardware description language embedded in
Haskell and faced a (perceived) bug in ghc 6.10.1 type checker. In ghc
6.8.2 everything works fine.

I need a type class that can express relationship between type and
its' "size in wires" (the number of bits needed to represent any value
of a type). The type class can be easily generalized to most haskell
data types and it's easy to write instance derivation using Template
Haskell.

I used multiparameter type classes because support for type families
in Template Haskell was incomplete in 6.10.1 and prior versions.

The source code below.

Do not forget to include -fcontext-stack=100 when trying to load the
code into ghci. The problem lines are between "THE PROBLEM!!"
comments.

Please, tell me, is it geniune bug or I misunderstand something about
Haskell type checker? How do you solve problems like that?

and, btw, you can take a look on how we can describe something
MIPS-alike in Haskell here: http://thesz.mskhug.ru/svn/hhdl/MIPS.hs

it is not finished by any means, but it gives a feel on how it will
look. I head to obtain (pretty) efficient simulation functions on
infinite streams (almost done, transformations are very simple) and
synthesable VHDL/Verilog description all from the same code that looks
like ordinary Haskell code.
-
-- "A problem with functional dependencies.
-- use -fcontext-stack=100 ghc switch.

{-# LANGUAGE GADTs, FunctionalDependencies, MultiParamTypeClasses,
TypeSynonymInstances, FlexibleInstances, FlexibleContexts,
UndecidableInstances #-}

module Problem where

import Data.Bits
import Data.Word

---
-- Type level arithmetic.

data Zero = Zero
data Succ n = Succ n

type ZERO = Zero
type ONE = Succ ZERO
type TWO = Succ ONE
type THREE = Succ TWO
type FOUR = Succ THREE
type FIVE = Succ FOUR
type SIX = Succ FIVE
type SEVEN = Succ SIX
type EIGHT = Succ SEVEN
type NINE = Succ EIGHT
type SIZE10 = Succ NINE
type SIZE11 = Succ SIZE10
type SIZE12 = Succ SIZE11
type SIZE13 = Succ SIZE12
type SIZE15 = Succ (Succ SIZE13)
type SIZE16 = Succ SIZE15
type SIZE20 = Succ (Succ (Succ (Succ (Succ SIZE15
type SIZE25 = Succ (Succ (Succ (Succ (Succ SIZE20
type SIZE26 = Succ SIZE25
type SIZE30 = Succ (Succ (Succ (Succ (Succ SIZE25
type SIZE32 = Succ (Succ SIZE30)

class Nat n where fromNat :: n -> Int

instance Nat Zero where fromNat = const 0
instance Nat n => Nat (Succ n) where fromNat ~(Succ n) = 1+fromNat n

class (Nat a, Nat b, Nat c) => CPlus a b c | a b -> c, a c -> b

--instance Nat a => CPlus a Zero a
instance Nat a => CPlus Zero a a
instance (CPlus a b c) => CPlus (Succ a) b (Succ c)
--instance (CPlus a b c) => CPlus (Succ a) b (Succ c)
--instance (CPlus a b c) => CPlus a (Succ b) (Succ c)

class (Nat a, Nat b, Nat c) => CMax a b c | a b -> c
instance CMax Zero Zero Zero
instance Nat a => CMax (Succ a) Zero (Succ a)
instance Nat a => CMax Zero (Succ a) (Succ a)
instance CMax a b c => CMax (Succ a) (Succ b) (Succ c)

class (Nat a, Nat b) => CDbl a b | a -> b
instance CPlus a a b => CDbl a b

class (Nat a, Nat b) => CPow2 a b | a -> b
instance CPow2 Zero (Succ Zero)
instance (CPow2 a b, CDbl b b2) => CPow2 (Succ a) b2

---
-- Sized integer.

data IntSz n where
IntSz :: Nat sz => Integer -> IntSz sz

intSzSizeType :: IntSz n -> n; intSzSizeType _ = undefined
intSzSize :: Nat n => IntSz n -> Int; intSzSize n = fromNat $ intSzSizeType n

instance Nat sz => Eq (IntSz sz) where
(IntSz a) == (IntSz b) = a == b

instance Show (IntSz n) where
show n@(IntSz x) = show x++"{"++show (intSzSize n)++"}"

instance Nat sz => Num (IntSz sz) where
fromInteger x = IntSz x
(IntSz a) + (IntSz b) = IntSz $ a+b
(IntSz a) - (IntSz b) = IntSz $ a-b
(IntSz a) * (IntSz b) = IntSz $ a*b
abs = error "No abs for IntSz."
signum = error "No signum for IntSz."

---
-- ToWires class, the main source of problems.

class Nat aSz => ToWires a aSz | a -> aSz where
wireSizeType :: a -> aSz
wireSizeType _ = undefined
-- size of a bus to hold a value in bits.
wireSize :: a -> Int
wireSize x = fromNat $ wireSizeType x
-- 2^wireSize, currently unused.
wireMul :: a -> Integer
wireMul x = Data.Bits.shiftL 1 (wireSize x)
-- selector size for decode (unused).
wireSelSize :: a -> Int
wireSelSize = const 0
-- Integer should occupy no more than wireSize bits, the remaining
bits should be 0
toWires :: a -> Integer
-- fromWires should work with integers that have non-zero bits
-- above wireSize index.
fromWires :: Integer -> a
 

Re: [Haskell-cafe] gtk2hs and runghc

2009-09-22 Thread Brandon S. Allbery KF8NH

-BEGIN PGP SIGNED MESSAGE-
Hash: SHA1

On Sep 22, 2009, at 11:31 , Günther Schmidt wrote:
Gtk2hs then complains about running in a multithreaded ghc, ie. one  
with several "real" OS threads. Is it possible to start runghc  
single-threaded?



No, but you can unsafeInitGUIForThreadedRTS.

- --
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH


-BEGIN PGP SIGNATURE-
Version: GnuPG v2.0.10 (Darwin)

iEYEARECAAYFAkq5PNcACgkQIn7hlCsL25UbYQCfSTz6RgOOB2v2x5aWQl2wTqQ0
5/sAnipoGEOCHn0zXfsx9H3N4ggp/7aJ
=Czq6
-END PGP SIGNATURE-
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Quadratic complexity though use of STArrays

2009-09-22 Thread Daniel Fischer
Am Dienstag 22 September 2009 22:31:48 schrieb Daniel Fischer:
> That doesn't explain the quadratic behaviour of shuffleArr, though.
> I suspect it's laziness, things aren't actually done until the result is
> finally demanded, but I would have to take a closer look to really find
> out.

Yep. Strictifying things gives the expected linear behaviour.

In
    swap a n m = do
        [n',m'] <- mapM (readArray a) [n,m]
        mapM (uncurry $ writeArray a) [(m,n'),(n,m')]

you don't actually read and write values, but ever longer thunks.

Changing swap to

    swap a m n
vm <- readArray a m
vn <- readArray a n
writeArray a n $! vm
writeArray a m $! vn

is all you need to do (as long as your values have a simple type).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Quadratic complexity though use of STArrays

2009-09-22 Thread Tobias Olausson
Hi Dan!
You might want to change the following:

shuffleRec :: StdGen -> [a] -> [a]
shuffleRec g list = x:shuffleArr g' xs
 where
   (n,g')  = randomR (0,length list-1) g
   (x:xs') = drop n list
   xs  = take n list ++ xs'

into the following:

shuffleRec :: StdGen -> [a] -> [a]
shuffleRec g list = x:shuffleRec g' xs
 where
   (n,g')  = randomR (0,length list-1) g
   (x:xs') = drop n list
   xs  = take n list ++ xs'

Since shuffleRec just called shuffleArr, one would expect them
to run in approximately the same time :-)

//Tobias

2009/9/22 Dan Rosén :
> Dear haskell-cafe users,
>
> I am constructing a shuffle function: given an StdGen and a list, return the
> list permuted, with all permutations of equal probability.
>
> There is the simlpe recursive definition: generate a number from 1 to length
> list, take this element out from the list, call the function recursively on
> the remaining list and then cons the element on the shuffled list.
>
> A more imperative approach is to make the list an array, and traverse the
> array in reverse, swapping the iterated element with an arbitrary element
> less than or equal to the iterator.
>
> These functions are implemented as shuffleRec and shuffleArr, respectively.
>
> What complexity does these functions have?
>
> I argue that the shuffleArr function should be O(n), since it only contains
> one loop of n, where each loop does actions that are O(1): generating a random
> number and swapping two elements in an array.
>
> I argue that the shuffleRec function should be O(n^2), since for each call,
> it creates a new list in O(n), with the drop and take calls, and calls itself
> recursively. This yields O(n^2).
>
> However, they both have the same runnig time (roughly), and through looking
> at the plot it _very_ much looks quadratic.
>
> I am compiling with GHC and I guess there is something in the lazy semantics
> that confuses me about the complexities, and maybe I have misunderstood how
> STArrays work.
>
> Any pointers to what's going in is greatly appreciated!
>
> Best regards,
> Dan Rosén, Sweden
>
> Here is the code:
>
> module Main where
>
> import Control.Monad
> import Control.Monad.ST
> import Data.Array.ST
> import Data.STRef
> import System.Random
>
> import Time
> import CPUTime
>
> shuffleArr :: StdGen -> [a] -> [a]
> shuffleArr g list = runST $ do
>    let n = length list
>    gref <- newSTRef g
>    arr <- listToArray list
>    forM_ [n,n-1..2] $ \p -> do
>        m <- rand (1,p) gref
>        swap arr m p
>    getElems arr
>  where
>    rand range gref = do
>        g <- readSTRef gref
>        let (v,g') = randomR range g
>        writeSTRef gref g'
>        return v
>
>    swap a n m = do
>        [n',m'] <- mapM (readArray a) [n,m]
>        mapM (uncurry $ writeArray a) [(m,n'),(n,m')]
>
> listToArray :: [a] -> ST s (STArray s Int a)
> listToArray list = let n = length list
>                   in  newListArray (1,n) list
>
> shuffleRec :: StdGen -> [a] -> [a]
> shuffleRec g list = x:shuffleArr g' xs
>  where
>    (n,g')  = randomR (0,length list-1) g
>    (x:xs') = drop n list
>    xs      = take n list ++ xs'
>
> -- A somewhat lame attempt to derive the complexities through testing,
> -- prints the times for the different functions in a table
> main :: IO ()
> main = do
>    let times = take 30 $ iterate (+3) 1
>    answers <- mapM test times
>    sequence_ [ putStrLn $ concatMap ((++ "\t"). show) [toInteger t,arr,rec]
>              | (t,(arr,rec)) <- zip times answers
>              ]
>
> -- Perform a test of size n, and return the cycles it took for the different
> -- algorithms in a pair. Evaluation is enforced by seq on length of the list.
> test :: Int -> IO (Integer,Integer)
> test n = do
>    let list = [1..n]
>    [g1,g2] <- replicateM 2 newStdGen
>    length list `seq` do
>        s  <- doTime ("shuffleArr " ++ show n) $
>                 (length $ shuffleArr g1 list) `seq` return ()
>        s' <- doTime ("shuffleRec " ++ show n) $
>                 (length $ shuffleRec g2 list) `seq` return ()
>        return (s,s')
>
> -- This is taken from GenUtil from the JHC creator's homepage
> doTime :: String -> IO a -> IO Integer
> doTime str action = do
>    start <- getCPUTime
>    x <- action
>    end <- getCPUTime
>    let time = (end - start) `div` 100 -- `div` cpuTimePrecision
>    -- putStrLn $ "Timing: " ++ str ++ " " ++ show time
>    return time
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>



-- 
Tobias Olausson
tob...@gmail.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Quadratic complexity though use of STArrays

2009-09-22 Thread Daniel Fischer
Am Dienstag 22 September 2009 21:31:08 schrieb Dan Rosén:
> Dear haskell-cafe users,
>
> I am constructing a shuffle function: given an StdGen and a list, return
> the list permuted, with all permutations of equal probability.
>
> There is the simlpe recursive definition: generate a number from 1 to
> length list, take this element out from the list, call the function
> recursively on the remaining list and then cons the element on the shuffled
> list.
>
> A more imperative approach is to make the list an array, and traverse the
> array in reverse, swapping the iterated element with an arbitrary element
> less than or equal to the iterator.
>
> These functions are implemented as shuffleRec and shuffleArr, respectively.
>
> What complexity does these functions have?
>
> I argue that the shuffleArr function should be O(n), since it only contains
> one loop of n, where each loop does actions that are O(1): generating a
> random number and swapping two elements in an array.
>
> I argue that the shuffleRec function should be O(n^2), since for each call,
> it creates a new list in O(n), with the drop and take calls, and calls
> itself recursively. This yields O(n^2).
>
> However, they both have the same runnig time (roughly), and through looking
> at the plot it _very_ much looks quadratic.

Regarding

>
> shuffleRec :: StdGen -> [a] -> [a]
> shuffleRec g list = x:shuffleArr g' xs
>   where
> (n,g')  = randomR (0,length list-1) g
> (x:xs') = drop n list
> xs  = take n list ++ xs'

it's not surprising they take more or less the same time.
Make it 
shuffleRec g list = x:shuffleRec g' xs
and prepare to kill the process pretty soon.

That doesn't explain the quadratic behaviour of shuffleArr, though.
I suspect it's laziness, things aren't actually done until the result is 
finally demanded, 
but I would have to take a closer look to really find out.

>
> I am compiling with GHC and I guess there is something in the lazy
> semantics that confuses me about the complexities, and maybe I have
> misunderstood how STArrays work.
>
> Any pointers to what's going in is greatly appreciated!
>
> Best regards,
> Dan Rosén, Sweden
>
> Here is the code:

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


Re: [Haskell-cafe] What is

2009-09-22 Thread Bryan O'Sullivan
On Tue, Sep 22, 2009 at 1:01 PM, DavidA  wrote:

>
> When I try to build my HaskellForMaths library
> (http://hackage.haskell.org/package/HaskellForMaths)
> using GHC6.10.4 on Mac OS X (Leopard), I get several
> "ld warning: atom sorting error" (see below).


The first rule of weird compiler output: enter the message you get into
Google.

http://hackage.haskell.org/trac/ghc/ticket/2578
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] What is

2009-09-22 Thread DavidA
Hi,

When I try to build my HaskellForMaths library
(http://hackage.haskell.org/package/HaskellForMaths)
using GHC6.10.4 on Mac OS X (Leopard), I get several
"ld warning: atom sorting error" (see below). The 
same code built without problems under GHC6.10.3 on Windows.
The code in question is using phantom types
to parameterise type constructors.

Should I be worried? (It's only a warning - I believe the build is fine.)

ld warning: atom sorting error for
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Grevlex_closure_tbl and 
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Lex_closure_tbl in
dist/build/Math/Algebra/Commutative/Monomial.o
ld warning: atom sorting error for
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Glex_closure_tbl and
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Grevlex_closure_tbl in
dist/build/Math/Algebra/Commutative/Monomial.o
ld warning: atom sorting error for
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Elim_closure_tbl and
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Glex_closure_tbl in
dist/build/Math/Algebra/Commutative/Monomial.o
ld warning: atom sorting error for
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Grevlex_closure_tbl and
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Lex_closure_tbl in
dist/build/Math/Algebra/Commutative/Monomial.o
ld warning: atom sorting error for
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Glex_closure_tbl and
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Grevlex_closure_tbl in
dist/build/Math/Algebra/Commutative/Monomial.o
ld warning: atom sorting error for
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Elim_closure_tbl and
_HaskellForMathszm0zi1zi8_MathziAlgebrazi
CommutativeziMonomial_Glex_closure_tbl in
dist/build/Math/Algebra/Commutative/Monomial.o


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


[Haskell-cafe] Quadratic complexity though use of STArrays

2009-09-22 Thread Dan Rosén
Dear haskell-cafe users,

I am constructing a shuffle function: given an StdGen and a list, return the
list permuted, with all permutations of equal probability.

There is the simlpe recursive definition: generate a number from 1 to length
list, take this element out from the list, call the function recursively on
the remaining list and then cons the element on the shuffled list.

A more imperative approach is to make the list an array, and traverse the
array in reverse, swapping the iterated element with an arbitrary element
less than or equal to the iterator.

These functions are implemented as shuffleRec and shuffleArr, respectively.

What complexity does these functions have?

I argue that the shuffleArr function should be O(n), since it only contains
one loop of n, where each loop does actions that are O(1): generating a random
number and swapping two elements in an array.

I argue that the shuffleRec function should be O(n^2), since for each call,
it creates a new list in O(n), with the drop and take calls, and calls itself
recursively. This yields O(n^2).

However, they both have the same runnig time (roughly), and through looking
at the plot it _very_ much looks quadratic.

I am compiling with GHC and I guess there is something in the lazy semantics
that confuses me about the complexities, and maybe I have misunderstood how
STArrays work.

Any pointers to what's going in is greatly appreciated!

Best regards,
Dan Rosén, Sweden

Here is the code:

module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.STRef
import System.Random

import Time
import CPUTime

shuffleArr :: StdGen -> [a] -> [a]
shuffleArr g list = runST $ do
let n = length list
gref <- newSTRef g
arr <- listToArray list
forM_ [n,n-1..2] $ \p -> do
m <- rand (1,p) gref
swap arr m p
getElems arr
  where
rand range gref = do
g <- readSTRef gref
let (v,g') = randomR range g
writeSTRef gref g'
return v

swap a n m = do
[n',m'] <- mapM (readArray a) [n,m]
mapM (uncurry $ writeArray a) [(m,n'),(n,m')]

listToArray :: [a] -> ST s (STArray s Int a)
listToArray list = let n = length list
   in  newListArray (1,n) list

shuffleRec :: StdGen -> [a] -> [a]
shuffleRec g list = x:shuffleArr g' xs
  where
(n,g')  = randomR (0,length list-1) g
(x:xs') = drop n list
xs  = take n list ++ xs'

-- A somewhat lame attempt to derive the complexities through testing,
-- prints the times for the different functions in a table
main :: IO ()
main = do
let times = take 30 $ iterate (+3) 1
answers <- mapM test times
sequence_ [ putStrLn $ concatMap ((++ "\t"). show) [toInteger t,arr,rec]
  | (t,(arr,rec)) <- zip times answers
  ]

-- Perform a test of size n, and return the cycles it took for the different
-- algorithms in a pair. Evaluation is enforced by seq on length of the list.
test :: Int -> IO (Integer,Integer)
test n = do
let list = [1..n]
[g1,g2] <- replicateM 2 newStdGen
length list `seq` do
s  <- doTime ("shuffleArr " ++ show n) $
 (length $ shuffleArr g1 list) `seq` return ()
s' <- doTime ("shuffleRec " ++ show n) $
 (length $ shuffleRec g2 list) `seq` return ()
return (s,s')

-- This is taken from GenUtil from the JHC creator's homepage
doTime :: String -> IO a -> IO Integer
doTime str action = do
start <- getCPUTime
x <- action
end <- getCPUTime
let time = (end - start) `div` 100 -- `div` cpuTimePrecision
-- putStrLn $ "Timing: " ++ str ++ " " ++ show time
return time
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] How to install GD library on Mac OSX?

2009-09-22 Thread Colin Adams
It needs some missing C libraries - gd, png, jpeg, fontconfig and freetype.
Does anyone know what to do to install these on OSX?

-- 
Colin Adams
Preston,
Lancashire,
ENGLAND
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] help with cabal; trying to escape from configuration hell

2009-09-22 Thread Anton van Straaten

S. Doaitse Swierstra wrote:
I am trying to run happstack on my Mac, but unfortunately I am getting 
error messages as described in:


http://code.google.com/p/happstack/issues/detail?id=88

The cure seems to be to downgrade to network-2.2.0.1, but unfortunately 
my installed cabal depends on network-2.2.1.4.


There's a better cure if you're willing to modify & build Happstack. 
Gregory Collins describes it in this message:


   http://groups.google.com/group/HAppS/msg/0c9a0d0fd7c6aff0

It needs to be applied in the following file:

   happstack-server/src/Happstack/Server/HTTP/Socket.hs

Replace the definition of acceptLite with the one in the above email,
and rebuild happstack-server.

The problem seems to be that on OS X, the Template Haskell code to 
detect at compile time whether IPv6 support is available is failing and 
causing the wrong code to get compiled in.


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


[Haskell-cafe] gtk2hs and runghc

2009-09-22 Thread Günther Schmidt

Hi,

I'm trying to test some gtk2hs gui code without compiling it first, just  
by using runghc.


Gtk2hs then complains about running in a multithreaded ghc, ie. one with  
several "real" OS threads. Is it possible to start runghc single-threaded?


Günther

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


[Haskell-cafe] help with cabal; trying to escape from configuration hell

2009-09-22 Thread S. Doaitse Swierstra
I am trying to run happstack on my Mac, but unfortunately I am getting  
error messages as described in:


http://code.google.com/p/happstack/issues/detail?id=88

The cure seems to be to downgrade to network-2.2.0.1, but  
unfortunately my installed cabal depends on network-2.2.1.4.


I tried to re-install happstack using:

cabal install happstack --reinstall --constraint="network==2.2.0.2"

but unfortunately the ghc happily reports to link against  
network-2.2.1.4:


...
Loading package parsec-2.1.0.1 ... linking ... done.
Loading package hsemail-1.3 ... linking ... done.
Loading package network-2.2.1.4 ... linking ... done.
Loading package SMTPClient-1.0.1 ... linking ... done.
Loading package time-1.1.4 ... linking ... done.
...

Can someone rescue me?

 Doaitse





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


Re: [Haskell-cafe] Cabal packages -> cabbages

2009-09-22 Thread Conor McBride

Hi

On 22 Sep 2009, at 15:25, D. Manning wrote:


2009/9/22 Conor McBride 
I'm just suggesting that the marketing department consider the
variety of connotations and suggestions the term evokes before
adopting it: legendary backfirings abound (the Spanish sales
failure of a car called the "nova", for example).

Its not important but the nova story really is legendary: 
http://www.snopes.com/business/misxlate/nova.asp


I chose my words with caution.

Cheers

Conor



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


Re: [Haskell-cafe] Cabal packages -> cabbages

2009-09-22 Thread D. Manning
2009/9/22 Conor McBride 

> I'm just suggesting that the marketing department consider the
> variety of connotations and suggestions the term evokes before
> adopting it: legendary backfirings abound (the Spanish sales
> failure of a car called the "nova", for example).
>


Its not important but the nova story really is legendary:
http://www.snopes.com/business/misxlate/nova.asp
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Cabal packages -> cabbages

2009-09-22 Thread Conor McBride

Hi Jason

On 22 Sep 2009, at 10:04, Jason Dusek wrote:


2009/09/21 Conor McBride :

...or have unpleasant memories of being made to eat sulphurous
overboiled cabbage on pain of no pudding.


 Well, maybe the Cabal cabbages are Napa cabbages or red
 cabbages or pickled cabbages or Savoy cabbages?


Mmm. Kimchi!


 It is too bad, really, that a wholesome vegetable -- good raw
 or pickled or in little salady things like coleslaw -- finds
 itself used as a disincentive.


I quite agree. Despite the best efforts of school kitchens, I
remain stubbornly enthusiastic for the humble cabbage. In fact,
I rather think I'll fetch one for my dinner.

I'm just suggesting that the marketing department consider the
variety of connotations and suggestions the term evokes before
adopting it: legendary backfirings abound (the Spanish sales
failure of a car called the "nova", for example). And what
disturbs me is just how scarily spot-on the wholesome vegetable
metaphor turns out to be.

The time has come...

Conor

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


Re: [Haskell-cafe] Cabal packages -> cabbages

2009-09-22 Thread david48
On Mon, Sep 21, 2009 at 12:11 AM, Jason Dusek  wrote:
>  Some day, we're going to need a short, catchy name for Cabal
>  packages. Let's call them cabbages.

C'est chou !  :-P

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


Re: [Haskell-cafe] Cabal packages -> cabbages

2009-09-22 Thread Jason Dusek
2009/09/21 Conor McBride :
> ...or have unpleasant memories of being made to eat sulphurous
> overboiled cabbage on pain of no pudding.

  Well, maybe the Cabal cabbages are Napa cabbages or red
  cabbages or pickled cabbages or Savoy cabbages?

  It is too bad, really, that a wholesome vegetable -- good raw
  or pickled or in little salady things like coleslaw -- finds
  itself used as a disincentive.

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


[Haskell-cafe] accessible layout proposal?

2009-09-22 Thread Jimmy Hartzell
I am in love with this proposal:
http://www.haskell.org/haskellwiki/Accessible_layout_proposal

However, after some Google searching and contacting its original author, I
have still not found any implementation or project to implement it. Are
there any I'm missing? And, if not, who would be willing to help undertake
a project to patch ghc to support it?

Alternatively, you can try to talk me out of liking the proposal so much,
but that is much less likely to work.

Jimmy Hartzell

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


Re: [Haskell-cafe] Building com-1.2.3

2009-09-22 Thread david48
On Mon, Sep 21, 2009 at 8:37 PM, Andrew Coppin
 wrote:
> It also doesn't explain why Cabal isn't finding include/WideStringSrc.h,
> even though that's the correct relative path to the file. I checked six
> times; it's definitely there.

include/WideStringSrc.h is a relative path, maybe cabal gets the base
path for the include files wrong ?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe