RE: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Mitchell, Neil
  Generalised? Heck, I don't use list comprehension at all! :-P
 
 Perhaps you should! :-)

You definitely should! Take a look at the Uniplate paper for some
wonderful concise uses of list comprehensions for abstract syntax tree
traversals. If you use a language like F# they become even more common -
due to a clunkier syntax for lambdas, less library functions and no
operator sections. In my F# I rarely use a map at all.

But my faviourite list comprehension trick was shown to me by Colin
Runciman:

prettyPrint b (lhs :+: rhs) = ['('|b] ++ f lhs ++  +  ++ f rhs ++
[')'|b]

Imagine b represents whether something should be bracketed or not. In
general:

if boolean then [value] else []

Can be written as:

[value | boolean]

Thanks

Neil

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Duncan Coutts
On Sun, 2008-11-09 at 19:18 +, Andrew Coppin wrote:
 Derek Elkins wrote:
  As far as I can tell, no one actually uses parallel list comprehensions.
  With any luck, the same will be true for generalized list
  comprehensions.

 
 Generalised? Heck, I don't use list comprehension at all! :-P

Perhaps you should! :-)

When I first started with Haskell I kind of had the idea that list
comprehensions were just for beginners and that 'real' hackers used just
concatMaps and filters.

A couple years later I 'rediscovered' list comprehensions and I now use
them frequently. There are many cases in real programs where simple and
not-so-simple list comprehensions are the clearest way of expressing the
solution. In particular the easy support for refutable pattern matching
in the generators allows some succinct and clear code.

Just a random example out of Cabal:

warn verbosity $
 This package indirectly depends on multiple versions of the same 
  ++ package. This is highly likely to cause a compile failure.\n
  ++ unlines [ package  ++ display pkg ++  requires 
++ display (PackageIdentifier name ver)
 | (name, uses) - inconsistencies
 , (pkg, ver) - uses ]

Pretty concise and clear I think.

Duncan

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Andrew Coppin

Duncan Coutts wrote:

On Sun, 2008-11-09 at 19:18 +, Andrew Coppin wrote:
  


Generalised? Heck, I don't use list comprehension at all! :-P



Perhaps you should! :-)

When I first started with Haskell I kind of had the idea that list
comprehensions were just for beginners and that 'real' hackers used just
concatMaps and filters.

A couple years later I 'rediscovered' list comprehensions and I now use
them frequently. There are many cases in real programs where simple and
not-so-simple list comprehensions are the clearest way of expressing the
solution. In particular the easy support for refutable pattern matching
in the generators allows some succinct and clear code.
  


I don't actually use *lists* all that much - or at least not list 
transformations. And if I'm going to do something complicated, I'll 
usually write it as a do-expression rather than a comprehension.



Just a random example out of Cabal:

warn verbosity $
 This package indirectly depends on multiple versions of the same 
  ++ package. This is highly likely to cause a compile failure.\n
  ++ unlines [ package  ++ display pkg ++  requires 
++ display (PackageIdentifier name ver)
 | (name, uses) - inconsistencies
 , (pkg, ver) - uses ]

Pretty concise and clear I think.
  


Erm... yeah, it's not too bad once I change all the formatting to make 
it clear what's what.


Wouldn't it be a lot easier as a do-block though?

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Andrew Coppin

Mitchell, Neil wrote:

In general:

if boolean then [value] else []

Can be written as:

[value | boolean]
  


Is there any specific reason why this is valid?

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Luke Palmer
Because expressions are treated as guards in list comprehensions.  I.e.:

  [ foo | x - a, b, y - c, d ]

Is interpreted as:

  do x - a
 guard b
 y - c
 guard d
 return foo

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Jonathan Cast
On Mon, 2008-11-10 at 18:20 +, Andrew Coppin wrote:
 Mitchell, Neil wrote:
  In general:
 
  if boolean then [value] else []
 
  Can be written as:
 
  [value | boolean]

 
 Is there any specific reason why this is valid?

Is there any specific reason to dis-allow it?  The grammar here looks
something like (NB: I didn't double-check the report):

list_compr ::= [ value | generator* ]
generator ::= boolean | pat - list | let binds

One particular special case is where there is exactly one generator,
which has three further special cases:

[ value | boolean ]
[ value | pat - expr ]
[ value | let binds ]

These are all valid because they are special cases of the general list
comprehension syntax; the de-sugarings are all just special cases of the
general list comprehension de-sugaring rules:

  [ value | ] = [ value ]
  [ value | boolean, generators ]
= if boolean then [ value | generators ] else []
  [ value | pat - expr, generators ]
= expr = \ x - case x of pat - [ value | generators ]; _ - []
  [ value | let binds, generators ]
= let binds in [ value | generators ]

So the special cases simplify to

  [ value | boolean ] = if boolean then [ value ] else []
  [ value | pat - expr ]
= expr = \ x - case x of pat - [ value ]; _ - []
  [ value | let binds ] = let binds in [ value ]

Why wouldn't this work?

jcc


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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Jonathan Cast
On Mon, 2008-11-10 at 18:19 +, Andrew Coppin wrote:
 Duncan Coutts wrote:
  On Sun, 2008-11-09 at 19:18 +, Andrew Coppin wrote:

 
  Generalised? Heck, I don't use list comprehension at all! :-P
  
 
  Perhaps you should! :-)
 
  When I first started with Haskell I kind of had the idea that list
  comprehensions were just for beginners and that 'real' hackers used just
  concatMaps and filters.
 
  A couple years later I 'rediscovered' list comprehensions and I now use
  them frequently. There are many cases in real programs where simple and
  not-so-simple list comprehensions are the clearest way of expressing the
  solution. In particular the easy support for refutable pattern matching
  in the generators allows some succinct and clear code.

 
 I don't actually use *lists* all that much - or at least not list 
 transformations. And if I'm going to do something complicated, I'll 
 usually write it as a do-expression rather than a comprehension.
 
  Just a random example out of Cabal:
 
  warn verbosity $
   This package indirectly depends on multiple versions of the same 
++ package. This is highly likely to cause a compile failure.\n
++ unlines [ package  ++ display pkg ++  requires 
  ++ display (PackageIdentifier name ver)
   | (name, uses) - inconsistencies
   , (pkg, ver) - uses ]
 
  Pretty concise and clear I think.

 
 Erm... yeah, it's not too bad once I change all the formatting to make 
 it clear what's what.
 
 Wouldn't it be a lot easier as a do-block though?

This was my first thought, too:

warn verbosity $
 This package indirectly depends on multiple versions of the same 
  ++ package. This is highly likely to cause a compile failure.\n
  ++ do
(name, uses) - inconsistencies
(pkg, ver) - uses
package  ++ display pkg ++  requires 
  ++ display (PackageIdentifier name ver) ++ \n

is equivalent; it's at least clearer in that the generators come before
the value, rather than after.

jcc


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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Andrew Coppin

Jonathan Cast wrote:

On Mon, 2008-11-10 at 18:20 +, Andrew Coppin wrote:
  

Mitchell, Neil wrote:


In general:

if boolean then [value] else []

Can be written as:

[value | boolean]
  
  

Is there any specific reason why this is valid?



Is there any specific reason to dis-allow it?  The grammar here looks
something like (NB: I didn't double-check the report):

list_compr ::= [ value | generator* ]
generator ::= boolean | pat - list | let binds
  


Hmm, that's interesting. I didn't know that a Boolean was a valid generator.

(Presumably this has the effect of filtering?)

The only time I use list comprehensions is when I quickly want a 
Cartesian product. I wasn't really aware it could filter as well.


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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Duncan Coutts
On Mon, 2008-11-10 at 18:20 +, Andrew Coppin wrote:
 Mitchell, Neil wrote:
  In general:
 
  if boolean then [value] else []
 
  Can be written as:
 
  [value | boolean]

 
 Is there any specific reason why this is valid?

It is due to the rules for the translation of list comprehensions:

[ e | True ] = [ e ]
[ e | q ]= [ e | q, True ]
[ e | b, Q ] = if b then [ e | Q ] else []
[ e | p - l, Q ]= let ok p = [ e | Q ]
   ok _ = []
in concatMap ok l
[ e | let decls, Q ] = let decls in [ e | Q ]

So [ value | boolean ] matches the second rule giving us
  [value | boolean, True]
which matches the third rule
  if boolean then [value | True] else []
which can be simplified via the first rule to
  if boolean then [value] else []

These rules are slightly more complex than necessary because they avoid
using a null base case. We could simplify the first two rules if we were
to allow the degenerate list comprehension [ e | ] and let Q match
nothing. Then we'd use the rule:

[ e | ] = [ e ]

and translate [ value | boolean ] via the original 3rd rule with Q as
nothing:
  if boolean then [value | ] else []
and directly to:
  if boolean then [value ] else []


If you meant, why is it allowed rather than banned then I guess the
answer is because it is orthogonal. The rules naturally handle that case
and there was no particular reason to ban it, even if it is somewhat
unusual.

Duncan

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Duncan Coutts
On Mon, 2008-11-10 at 18:19 +, Andrew Coppin wrote:

 I don't actually use *lists* all that much - or at least not list 
 transformations. And if I'm going to do something complicated, I'll 
 usually write it as a do-expression rather than a comprehension.
 
  Just a random example out of Cabal:
 
  warn verbosity $
   This package indirectly depends on multiple versions of the same 
++ package. This is highly likely to cause a compile failure.\n
++ unlines [ package  ++ display pkg ++  requires 
  ++ display (PackageIdentifier name ver)
   | (name, uses) - inconsistencies
   , (pkg, ver) - uses ]
 
  Pretty concise and clear I think.

 
 Erm... yeah, it's not too bad once I change all the formatting to make 
 it clear what's what.
 
 Wouldn't it be a lot easier as a do-block though?

I don't think so:

   ++ unlines $ do
(name, uses) - inconsistencies
(pkg, ver) - uses
return $ package  ++ display pkg ++  requires 
  ++ display (PackageIdentifier name ver)

Of course reasonable people may disagree. It's mostly aesthetics.

Duncan

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Jonathan Cast
On Mon, 2008-11-10 at 18:48 +, Andrew Coppin wrote:
 Jonathan Cast wrote:
  On Mon, 2008-11-10 at 18:20 +, Andrew Coppin wrote:

  Mitchell, Neil wrote:
  
  In general:
 
  if boolean then [value] else []
 
  Can be written as:
 
  [value | boolean]


  Is there any specific reason why this is valid?
  
 
  Is there any specific reason to dis-allow it?  The grammar here looks
  something like (NB: I didn't double-check the report):
 
  list_compr ::= [ value | generator* ]
  generator ::= boolean | pat - list | let binds

 
 Hmm, that's interesting. I didn't know that a Boolean was a valid generator.
 
 (Presumably this has the effect of filtering?)
 
 The only time I use list comprehensions is when I quickly want a 
 Cartesian product. I wasn't really aware it could filter as well.

Funny.  About the only time I use list comprehensions is when I want a
generalized filter.

Serious computations get the do-notation, instead.  (And sometimes I
*have* to use do-notation for filtering, because I need an error monad
(usually Maybe) for other reasons).

jcc


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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-10 Thread Derek Elkins
On Mon, 2008-11-10 at 18:50 +, Duncan Coutts wrote:
[...]
 If you meant, why is it allowed rather than banned then I guess the
 answer is because it is orthogonal. The rules naturally handle that case
 and there was no particular reason to ban it, even if it is somewhat
 unusual.

Unusual?  This is the motivation of list comprehensions.

In naive set theory, set comprehensions are one way of an equivalence
between predicates and sets.  It's the Cartesian product aspect that
should be considered unusual if anything.  The binding aspect of list
generators corresponds to naming the parameters of the predicate and
then the Cartesian product aspect is simply the fact that a binary
predicate, say, is a unary predicate on a binary Cartesian product.

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-09 Thread Max Bolingbroke
2008/11/9 Johannes Waldmann [EMAIL PROTECTED]:
 NB: Wasn't there a time (before do) when list notation (brackets)
 would work in any monad? And map was a method in Functor,
 and we had class Functor m = Monad m, etc. Well well well times have
 changed.

Sure, I believe the feature was called monad comprehensions. AFAIK
it was removed because it gave confusing error messages to new users
of the language (what is this Monad thing? I just want a list of
stuff!).

List comprehensions really have diverged from being a special do
notation at the list monad, since you are able to write comprehensions
like [(x, y) | x - xs | y - ys], and it's not clear how to define
zip for a monad - but perhaps there is some extension of a monad
where it makes sense?

All the best,
Max
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] generalized list comprehensions

2008-11-09 Thread Johannes Waldmann



like [(x, y) | x - xs | y - ys], and it's not clear how to define
zip for a monad - but perhaps there is some extension of a monad
where it makes sense?


Well, I question that the above notation makes sense (for lists).
It is trying to be too clever.

standard list comprehensions  at least are consistent
with mathematical notation for sets. (That is,
they are putting the cart before the horse consistently.)

But could you show the above code example to some non-ghc-aware person
and expect her to guess the meaning correctly?  I think not.

And even if, the implied zip is dangerous because it does not
complain about unequal lengths, and you cannot guess that either.
If you write  (x,y) - zip xs ys  instead then at least you know
that you need to lookup the definition of zip.

Best regards, J.W.





signature.asc
Description: OpenPGP digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] generalized list comprehensions

2008-11-09 Thread Andrew Coppin

Derek Elkins wrote:

As far as I can tell, no one actually uses parallel list comprehensions.
With any luck, the same will be true for generalized list
comprehensions.
  


Generalised? Heck, I don't use list comprehension at all! :-P

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-09 Thread Derek Elkins
On Sun, 2008-11-09 at 10:15 +, Max Bolingbroke wrote:
 2008/11/9 Johannes Waldmann [EMAIL PROTECTED]:
  NB: Wasn't there a time (before do) when list notation (brackets)
  would work in any monad? And map was a method in Functor,
  and we had class Functor m = Monad m, etc. Well well well times have
  changed.
 
 Sure, I believe the feature was called monad comprehensions. AFAIK
 it was removed because it gave confusing error messages to new users
 of the language (what is this Monad thing? I just want a list of
 stuff!).
 
 List comprehensions really have diverged from being a special do
 notation at the list monad, since you are able to write comprehensions
 like [(x, y) | x - xs | y - ys], and it's not clear how to define
 zip for a monad - but perhaps there is some extension of a monad
 where it makes sense?

As far as I can tell, no one actually uses parallel list comprehensions.
With any luck, the same will be true for generalized list
comprehensions.

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-09 Thread Yitzchak Gale
Derek Elkins wrote:
 As far as I can tell, no one actually uses parallel list comprehensions.
 With any luck, the same will be true for generalized list
 comprehensions.

I second this.

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


[Haskell-cafe] generalized list comprehensions

2008-11-08 Thread Johannes Waldmann

Looking at this funny new feature
http://haskell.org/ghc/docs/6.10.1/html/users_guide/syntax-extns.html#generalised-list-comprehensions
I have just one question - why doesn't this work with the do-notation?

I avoid list comprehensions because I feel that
return belongs at the end, not in front.

If I recall correctly, putting the SQL-select where it belongs
is a slogan used by Hijlsberg to justify the LINQ syntax for C#,
and of course he is right.

Now ghc copies LINQ (syntactically), but stops halfway?

Just wondering - J.W.





signature.asc
Description: OpenPGP digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] generalized list comprehensions

2008-11-08 Thread Max Bolingbroke
2008/11/8 Johannes Waldmann [EMAIL PROTECTED]:
 Looking at this funny new feature
 http://haskell.org/ghc/docs/6.10.1/html/users_guide/syntax-extns.html#generalised-list-comprehensions
 I have just one question - why doesn't this work with the do-notation?

 I avoid list comprehensions because I feel that
 return belongs at the end, not in front.

 If I recall correctly, putting the SQL-select where it belongs
 is a slogan used by Hijlsberg to justify the LINQ syntax for C#,
 and of course he is right.

 Now ghc copies LINQ (syntactically), but stops halfway?

Hi Johannes,

There is no technical reason the syntax could not be extended to do
notation - see the discussion by Michael Adams on the
http://haskell.org/haskellwiki/Simonpj/Talk:ListComp page for a taste
of how that would work (note that his translation is however not
totally correct, IIRC). The only reason that I didn't actually
implement this feature is that neither I nor SPJ could think of a use
case for this syntax outside the list monad. I don't think we
considered the possibility you might use do notation for the list
monad, as it's not an idiom that seems to occur often.

If you can come up with such a use case I could probably find the time
to implement the extra translation steps! On reflection, it does seem
a bit like an annoying irregularity to the implementation.

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


Re: [Haskell-cafe] generalized list comprehensions

2008-11-08 Thread Johannes Waldmann

 I don't think we
considered the possibility you might use do notation for the list
monad, as it's not an idiom that seems to occur often.


depends where you look, I guess. (Such questions could in principle
be answered automatically by browsing the code on hackage?)

As I said, I am avoiding list comprehensions for purely optical reasons
(putting the cart before the horse), so I write do in the list monad.

Of course I prefer let to where for the same reasons,
so for me you could indeed replace guard by where,
and return by select, and x - foo by from x in foo
and it'd look like the real (linq) thing. - Oh, and replace
Monad by Workflow. - Not!

NB: Wasn't there a time (before do) when list notation (brackets)
would work in any monad? And map was a method in Functor,
and we had class Functor m = Monad m, etc. Well well well times have 
changed.





signature.asc
Description: OpenPGP digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe