
Hello! I wonder if we should collect some example code and make it presentable. By that I mean there should be the classification of the example, brief description, and, mainly, sample test data and the expected results. And, of course, implementations for these examples in various generic programming approaches. Incidentally, the `expressibility' section in the library description can simply enumerate which examples the library can implement. _Some_ of the examples may become the part of the benchmarking suite (at this point I'm simply interested in what is possible). Here's what I have gleaned so far, from a couple of SYB papers and the code already in DARCS: generic show: essential type is t -> String [I say essential because there may be additional arguments, say, for type representation] Description: display the term; special processing for Strings, as opposed to general arrays. Category: closed Cartesian [sorry, couldn't resist] I mean, `consumer', reduce a generic term to a value of the fixed type, String. LIGD has the implementation; no test data though. generic size: essential type t -> Int Give the size of a term (in terms of data constructors). The user should be able to assign size matrix to specific data types (like strings). Category: consumer, reduce a generic term to a value of the fixed type, Int. SYB3 example, also used in Smash. I have test data and expected results (part of syb4.hs) This example is quite similar to gshow above; I personally prefer this over gshow, because the Show class already provides the latter, so it's hard to get excited over gshow. Salary Raise: essential type t -> t Transform a term (representing an `organization' or an XML document) into the term of the same type, but with different values of some primitive fields. Ralf's dream example, from SYB1. category: type-preserving transformer Variation: uniform transformation (raise everybody's salary by 10%); or the transformation should affect only specific parts of the term. Transformation can be context-independent (increment each float field by 10%) or context- (that is, traversal history) dependent (increment each float until the money runs out). Test data can be extracted from Ralf's web site. generic minimum: essential type t Provides the 'minimal' value of any term in the universe of discourse. category: pure producer Variation: functional term may or may not be handled. LIGD example. test data can be easily extracted from it. Replace all Ints with Floats in a term: essential type t -> t' where t' = f(t). category: transformer, to a term of a different type. The output type is the function of the input type. variation: replace all Ints with Floats and negate all booleans, in a single traversal (that is, `compose' multiple compatible processing steps) Smash example; test data are available in the syb4.hs generic equality: essential type t -> t -> Bool category: binary function over two generic arguments of the same type. Variation: try essential type t -> t' -> Bool Variation: permit the user supply their own comparison procedure for some data types Variation: local extensibility [as explained in Stefan Holdermans] LIGD example (including specific comparison of integers mod 2). Need test data though. something of the type t1 -> t2 -> t3 where t3 = f(t1, t2). Generalization of zip/zipWith. I have never seen that example. Obviously a lot is missing in the above -- in particular, good names for the examples, and the test data. And the idea how to organize the files with examples and test data within our DARCS repository. Stephanie Weirich wrote:
For the latter, we talk about the ability to use the library with types that contain records nested datatypes higher-kinded types (what kinds?) datatypes with existential components (both of kind type and higher kinds) datatypes with first-class polymorphic components (both of kind type and higher kinds) above with class constraints GADTs (simple, and those that subsume existentials...) datatypes with higher-kinded type arguments
I'd inline this dimension into each of the above example. But we need test data... Cheers, Oleg

Hello oleg, Saturday, October 21, 2006, 12:58:58 PM, you wrote:
something of the type t1 -> t2 -> t3 where t3 = f(t1, t2). Generalization of zip/zipWith. I have never seen that example.
how about generic zip? gzipWith :: (a->b->c) -> C a -> C b -> C c -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

something of the type t1 -> t2 -> t3 where t3 = f(t1, t2). Generalization of zip/zipWith. I have never seen that example.
how about generic zip?
gzipWith :: (a->b->c) -> C a -> C b -> C c
Good example. In Generic Haskell, gzipWith has type gzipWith {| t1 :: *, t2 :: *, t3 :: * |} :: (gzipWith {| t1, t2, t3 |}) => (t1,t2) -> Maybe t3 gzipWith is a rather standard generalisation (except for the Maybe) of gmap, which has type gmap {| t1 :: *, t2 :: * |} :: (gmap {| t1, t2 |}) => t1 -> t2 so it might not exhibit new properties. But maybe it does lead to problems in other approaches. -- Johan

I completely agree that we should collect some example code. I've started to create a testsuite containing a few of the tests that you mention below. However, when designing this suite, we need to be as specific as possible about what a specific example shows, and what "counts" as an implementation of that example. I've got a few starting tests, based on Ralf's webpage and Bruno's "ComparingGP" examples for LIGD, SYB1&2 and RepLib. I'll check these in soon. Stupid question: how do I add to the repository? (I've done "darcs add" and "darcs record", what's next?) Each test is in a separate directory containing a Makefile, source code, and sample output. Saying "make" builds the test with GHC (tested with 6.5.2 on my machine), executes it (saving the output to a file "tmp.stdout") and then compares the output with "test.stdout". Even with these simple test, I have a few questions. The tests I have so far are: geq - generic equality - Must this be "extensible/specializable" to count? (If so, cannot do with LIGD, SYB1/2. gshow - Must this be "extensible/specializable" to count? (If so, cannot do with LIGD, SYB1/2). - Must this match "deriving Show" to count? (If so, should be updated for LIGD.) bits - Must all versions produce the *same* binary format. This seems like a potentially unfair comparison as small details (constructor order in view) can make significant differences. I propose we let each version choose its own binary form, perhaps encouraging each to produce the most compact format possible, while still requiring fromBin . toBin = id. (Currently, SYB doesn't use XBitz because I just copied the example from Ralf's page, but I'd like to change that.) foldTree - An example from Ralf's SYB webpage. Accumulate all ints in a tree. Then accumulate only those ints wrapped with the "Leaf" constructor. paradise - Another of Ralf's examples. Should the LIGD version count? For all of these examples, there is the question of what tests to run for each. geq, gshow, bits and paradise currently work for the "CompanyDatatypes" (I extended LIGD to cover floats). foldTree works for a specific Tree. Perhaps future examples can stress other datatypes. Other extensions that we need are some test harness to run all of these tests and create a summary of which frameworks have which tests. --Stephanie On Oct 21, 2006, at 4:58 AM, oleg@pobox.com wrote:
Hello!
I wonder if we should collect some example code and make it presentable. By that I mean there should be the classification of the example, brief description, and, mainly, sample test data and the expected results. And, of course, implementations for these examples in various generic programming approaches. Incidentally, the `expressibility' section in the library description can simply enumerate which examples the library can implement. _Some_ of the examples may become the part of the benchmarking suite (at this point I'm simply interested in what is possible).
Here's what I have gleaned so far, from a couple of SYB papers and the code already in DARCS:
generic show: essential type is t -> String [I say essential because there may be additional arguments, say, for type representation] Description: display the term; special processing for Strings, as opposed to general arrays. Category: closed Cartesian [sorry, couldn't resist] I mean, `consumer', reduce a generic term to a value of the fixed type, String. LIGD has the implementation; no test data though.
generic size: essential type t -> Int Give the size of a term (in terms of data constructors). The user should be able to assign size matrix to specific data types (like strings). Category: consumer, reduce a generic term to a value of the fixed type, Int. SYB3 example, also used in Smash. I have test data and expected results (part of syb4.hs) This example is quite similar to gshow above; I personally prefer this over gshow, because the Show class already provides the latter, so it's hard to get excited over gshow.
Salary Raise: essential type t -> t Transform a term (representing an `organization' or an XML document) into the term of the same type, but with different values of some primitive fields. Ralf's dream example, from SYB1. category: type-preserving transformer Variation: uniform transformation (raise everybody's salary by 10%); or the transformation should affect only specific parts of the term. Transformation can be context-independent (increment each float field by 10%) or context- (that is, traversal history) dependent (increment each float until the money runs out). Test data can be extracted from Ralf's web site.
generic minimum: essential type t Provides the 'minimal' value of any term in the universe of discourse. category: pure producer Variation: functional term may or may not be handled. LIGD example. test data can be easily extracted from it.
Replace all Ints with Floats in a term: essential type t -> t' where t' = f(t). category: transformer, to a term of a different type. The output type is the function of the input type. variation: replace all Ints with Floats and negate all booleans, in a single traversal (that is, `compose' multiple compatible processing steps) Smash example; test data are available in the syb4.hs
generic equality: essential type t -> t -> Bool category: binary function over two generic arguments of the same type. Variation: try essential type t -> t' -> Bool Variation: permit the user supply their own comparison procedure for some data types Variation: local extensibility [as explained in Stefan Holdermans] LIGD example (including specific comparison of integers mod 2). Need test data though.
something of the type t1 -> t2 -> t3 where t3 = f(t1, t2). Generalization of zip/zipWith. I have never seen that example.
Obviously a lot is missing in the above -- in particular, good names for the examples, and the test data. And the idea how to organize the files with examples and test data within our DARCS repository.
Stephanie Weirich wrote:
For the latter, we talk about the ability to use the library with types that contain records nested datatypes higher-kinded types (what kinds?) datatypes with existential components (both of kind type and higher kinds) datatypes with first-class polymorphic components (both of kind type and higher kinds) above with class constraints GADTs (simple, and those that subsume existentials...) datatypes with higher-kinded type arguments
I'd inline this dimension into each of the above example. But we need test data...
Cheers, Oleg _______________________________________________ Generics mailing list Generics@haskell.org http://www.haskell.org/mailman/listinfo/generics

About the test suite:
geq - generic equality - Must this be "extensible/specializable" to count? (If so, cannot do with LIGD, SYB1/2.
I wouldn't think so. We can compare implementations on some standard types, and let extensibility/specializability be a separate evaluation criterium.
gshow - Must this be "extensible/specializable" to count? (If so, cannot do with LIGD, SYB1/2). - Must this match "deriving Show" to count? (If so, should be updated for LIGD.)
I think that would be a desirable requirement. Yes, I think the LIGD show example should be updated with a function that places parentheses as deriving Show does.
bits - Must all versions produce the *same* binary format. This seems like a potentially unfair comparison as small details (constructor order in view) can make significant differences. I propose we let each version choose its own binary form, perhaps encouraging each to produce the most compact format possible, while still requiring fromBin . toBin = id. (Currently, SYB doesn't use XBitz because I just copied the example from Ralf's page, but I'd like to change that.)
That makes sense. I can imagine requiring exactly the same binary format would lead to some very nasty implementations for some views.
foldTree - An example from Ralf's SYB webpage. Accumulate all ints in a tree. Then accumulate only those ints wrapped with the "Leaf" constructor.
foldTree is maybe better called crushTree (as Ralf L calls it, after a paper by Lambert Meertens many years ago), to avoid confusion with the `algebraic' fold. I agree it would be nice to add generic crush to the test suite. And maybe even generic fold, but I doubt if there is any appraoch with which generic fold can be nicely defined.
paradise - Another of Ralf's examples. Should the LIGD version count?
This is the increase salaries example, isn't it? I prefer to call it something like increase salaries, or raise salaries, as Oleg calls it (I suppose I don't care about my salary anymore in paradise, that is, if I ever get to go there, of course). And should the LIGD version count? Good question. Without `open datatypes' I would think that this example is not implementable in LIGD, since it requires adapting the library, so we maybe should leave it out.
For all of these examples, there is the question of what tests to run for each. geq, gshow, bits and paradise currently work for the "CompanyDatatypes" (I extended LIGD to cover floats). foldTree works for a specific Tree. Perhaps future examples can stress other datatypes.
Other extensions that we need are some test harness to run all of these tests and create a summary of which frameworks have which tests.
I think we have to create test data types in each category of data types you mentioned in a previous message. And possibly multiple data types in the `standard data types' category. Organizing this shootout is quite a task, I hope we'll find a volunteer to organize it. (I'm afraid my time is too divided to do it.) -- Johan

On 27 Oct 2006, at 14:05, Johan Jeuring wrote:
paradise - Another of Ralf's examples. Should the LIGD version count?
This is the increase salaries example, isn't it? I prefer to call it something like increase salaries, or raise salaries, as Oleg calls it (I suppose I don't care about my salary anymore in paradise, that is, if I ever get to go there, of course).
I always thought Ralf meant "killer application" (ie best possible use of the technique) went he said "paradise example", rather than suggesting that salary increases themselves are heavenly. Ralf? Jeremy Jeremy.Gibbons@comlab.ox.ac.uk Oxford University Computing Laboratory, TEL: +44 1865 283508 Wolfson Building, Parks Road, FAX: +44 1865 283531 Oxford OX1 3QD, UK. URL: http://www.comlab.ox.ac.uk/oucl/people/jeremy.gibbons.html

On 10/27/06, Johan Jeuring
Organizing this shootout is quite a task, I hope we'll find a volunteer to organize it. (I'm afraid my time is too divided to do it.)
I am interested in learning more about the relationship between the various generic programming approaches. So I am interested in carrying out this shootout. However I will be busy until December this year so I would only be able to do the shootout from next year. So if no one steps up I will be happy to do it then. Cheers, Alexey

I wonder if we should collect some example code and make it presentable.
I think we should.
By that I mean there should be the classification of the example, brief description, and, mainly, sample test data and the expected results. And, of course, implementations for these examples in various generic programming approaches. Incidentally, the `expressibility' section in the library description can simply enumerate which examples the library can implement. _Some_ of the examples may become the part of the benchmarking suite (at this point I'm simply interested in what is possible).
Here's what I have gleaned so far, from a couple of SYB papers and the code already in DARCS:
generic show: essential type is t -> String [I say essential because there may be additional arguments, say, for type representation] Description: display the term; special processing for Strings, as opposed to general arrays. Category: closed Cartesian [sorry, couldn't resist] I mean, `consumer', reduce a generic term to a value of the fixed type, String. LIGD has the implementation; no test data though.
generic size: essential type t -> Int Give the size of a term (in terms of data constructors). The user should be able to assign size matrix to specific data types (like strings). Category: consumer, reduce a generic term to a value of the fixed type, Int. SYB3 example, also used in Smash. I have test data and expected results (part of syb4.hs) This example is quite similar to gshow above; I personally prefer this over gshow, because the Show class already provides the latter, so it's hard to get excited over gshow.
Maybe not, but gshow is a good example of a function that uses the constructor names of a data type. And I think it is interesting to see how the different approaches provide access to constructor names (and possibly even also data type name, although that is not used in gshow).
Salary Raise: essential type t -> t Transform a term (representing an `organization' or an XML document) into the term of the same type, but with different values of some primitive fields. Ralf's dream example, from SYB1. category: type-preserving transformer Variation: uniform transformation (raise everybody's salary by 10%); or the transformation should affect only specific parts of the term. Transformation can be context-independent (increment each float field by 10%) or context- (that is, traversal history) dependent (increment each float until the money runs out). Test data can be extracted from Ralf's web site.
generic minimum: essential type t Provides the 'minimal' value of any term in the universe of discourse. category: pure producer Variation: functional term may or may not be handled. LIGD example. test data can be easily extracted from it.
Replace all Ints with Floats in a term: essential type t -> t' where t' = f(t). category: transformer, to a term of a different type. The output type is the function of the input type. variation: replace all Ints with Floats and negate all booleans, in a single traversal (that is, `compose' multiple compatible processing steps) Smash example; test data are available in the syb4.hs
generic equality: essential type t -> t -> Bool category: binary function over two generic arguments of the same type. Variation: try essential type t -> t' -> Bool Variation: permit the user supply their own comparison procedure for some data types Variation: local extensibility [as explained in Stefan Holdermans] LIGD example (including specific comparison of integers mod 2). Need test data though.
something of the type t1 -> t2 -> t3 where t3 = f(t1, t2). Generalization of zip/zipWith. I have never seen that example.
Obviously a lot is missing in the above -- in particular, good names for the examples, and the test data. And the idea how to organize the files with examples and test data within our DARCS repository.
I think these are good examples. The only thing I miss is a generic variant of map :: (a->b) -> [a]->[b]. -- Johan

Hello,
something of the type t1 -> t2 -> t3 where t3 = f(t1, t2). Generalization of zip/zipWith. I have never seen that example.
Obviously a lot is missing in the above -- in particular, good names for the examples, and the test data. And the idea how to organize the files with examples and test data within our DARCS repository.
I think these are good examples. The only thing I miss is a generic variant of map :: (a->b) -> [a]->[b].
Though the generic zipWith function would already demonstrate the power of the library --- if you can do generic zipWith, you should be able to do generic map. Cheers, Bruno

something of the type t1 -> t2 -> t3 where t3 = f(t1, t2). Generalization of zip/zipWith. I have never seen that example.
Obviously a lot is missing in the above -- in particular, good names for the examples, and the test data. And the idea how to organize the files with examples and test data within our DARCS repository.
I think these are good examples. The only thing I miss is a generic variant of map :: (a->b) -> [a]->[b].
Though the generic zipWith function would already demonstrate the power of the library --- if you can do generic zipWith, you should be able to do generic map.
Yes, gzipWith can be viewed as a generalisation of map. But it is a bit more complex (with three type variables, and an occurrence of Maybe). Does gzipWith add something if you have gmap? Otherwise I prefer to take gmap. -- Johan

Hi, I filled out the template for Strafunski: http://www.haskell.org/haskellwiki/Libraries_and_tools/Strafunski Any suggestions how to link it in? Regards, Joost -- Dr. ir. Joost Visser | Departamento de Informática phone +351-253-604461 | Universidade do Minho fax +351-253-604471 | mailto:Joost.Visser@di.uminho.pt mobile +351-91-6253618 | http://www.di.uminho.pt/~joost.visser
participants (8)
-
Alexey Rodriguez
-
Bruno Oliveira
-
Bulat Ziganshin
-
Jeremy Gibbons
-
Johan Jeuring
-
Joost Visser
-
oleg@pobox.com
-
Stephanie Weirich