Re: class [] proposal Re: [Haskell-cafe] One thought: Num to 0 as ? to list?

2006-08-22 Thread Malcolm Wallace
Bulat Ziganshin [EMAIL PROTECTED] wrote:

 2) allow to use type classes in type declarations like the types
 itself. for example, allow the following:
 
 f :: Num a = a - Int
 write as
 f :: Num - Int
 
 and following:
 
 sequence :: Monad m = [m a] - m [a]
 write as
 sequence :: [Monad a] - Monad [a]

How would you distinguish the class contexts of (for instance)
sequenceLift :: (Monad m, Monad r) = [m a] - r [a]
if it were to be written instead as simply
sequenceLift :: [Monad a] - Monad [a]

And how would one add multiple class constraints to a single type
variable, for instance in:
f :: (Functor m, Monad m) = (a-b) - m [a] - m b

?

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


Re[2]: class [] proposal Re: [Haskell-cafe] One thought: Num to 0 as ? to list?

2006-08-22 Thread Bulat Ziganshin
Hello Malcolm,

Tuesday, August 22, 2006, 4:22:50 PM, you wrote:

 2) allow to use type classes in type declarations like the types
 itself. for example, allow the following:
 
 f :: Num a = a - Int
 write as
 f :: Num - Int
 
 and following:
 
 sequence :: Monad m = [m a] - m [a]
 write as
 sequence :: [Monad a] - Monad [a]

 How would you distinguish the class contexts of (for instance)
 sequenceLift :: (Monad m, Monad r) = [m a] - r [a]
 if it were to be written instead as simply
 sequenceLift :: [Monad a] - Monad [a]

 And how would one add multiple class constraints to a single type
 variable, for instance in:
 f :: (Functor m, Monad m) = (a-b) - m [a] - m b

both your examples cannot be written using proposed syntax

what i propose is not full replacement of existing syntax - quite the
contrary it is just a syntax sugar for most frequent cases of using
classes in function signatures. the key idea is that in most cases we
use only one type class for each type variable, and the same type for
each occurrence of type class in the type:

(+) :: Num - Num - Num

This also simplifies the case when programmer has developed his code
with one concrete type in mind and later decided to transform it into
typeclass. In this case my idea allows to retain old definitions in
most cases (and promoting [] to type class is very typical example
here! we can browse prelude/list module and count how many definitions
need to be changed if [] becomes type class)

This proposal born from my experience of using type classes to make
Streams library more flexible. i found that type signatures using type
classes becomes larger and less readable and thought that they can be
made no more complex than ordinary ones by using this idea. Java/C++
also allows to specify names of abstract classes/interfaces instead of
concrete classes. Haskell's benefit is that general syntax allows to
express more complex restrictions. I propose to combine it with the
OOP-like simple syntax for simple cases (which is 80-90% of total ones)

so, while this proposal is rather minor, i think that it is Good thing


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: Re[2]: class [] proposal Re: [Haskell-cafe] One thought: Num to 0 as ? to list?

2006-08-22 Thread Bryan Burgers

On 8/22/06, Bulat Ziganshin [EMAIL PROTECTED] wrote:

what i propose is not full replacement of existing syntax - quite the
contrary it is just a syntax sugar for most frequent cases of using
classes in function signatures. the key idea is that in most cases we
use only one type class for each type variable, and the same type for
each occurrence of type class in the type:

(+) :: Num - Num - Num

[...]

so, while this proposal is rather minor, i think that it is Good thing


I disagree. As a new learner to Haskell, I already have a hard time
keeping Constructors, Types, and Classes straight. I know what they
all are and what they all do, but sometimes I really have to think
hard to remember which is which in a piece of code. What helps my
understanding is that each has a specific place in the type signature
(which I guess includes 'nowhere' regarding constructors). Being able
to put Classes where Types go would just serve to muddle that
understanding.

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


Re: class [] proposal Re: [Haskell-cafe] One thought: Num to 0 as ? to list?

2006-08-22 Thread Arie Peterson
Hello Bryan,


On 2006-08-22, Bryan Burgers [EMAIL PROTECTED] wrote:
 so, while this proposal is rather minor, i think that it is Good thing

 I disagree. As a new learner to Haskell, I already have a hard time
 keeping Constructors, Types, and Classes straight. I know what they
 all are and what they all do, but sometimes I really have to think
 hard to remember which is which in a piece of code. What helps my
 understanding is that each has a specific place in the type signature
 (which I guess includes 'nowhere' regarding constructors). Being able
 to put Classes where Types go would just serve to muddle that
 understanding.


This is an instance of a general conflict: should we sacrifice nice
notation for ease of learning? You could make a similar case for list
comprehensions, for example: they complicate matters for newcomers (yet
another meaning of brackets and pipe), but once you get used to them, they
may actually simplify code.

However, this need not be a conflict at all. Introductory material can
simply ignore syntactic sugar like list comprehensions and this new
proposal (*). If there are independent tutorials of these extra
features, explaining their meaning in terms of basic haskell, someone
learning haskell can learn to use them one at a time, as s/he encounters
them in the wild.


I agree that it may be complicating to have more than one way to write the
same code. There is a balance between the gained ease of writing (and
reading!) and the burden of having to do a mental translation when
combining code using the different ways, but this should be kept distinct
from the problem of learning Haskell.


(*) In this specific instance one might (ab?)use the additional notation
to create a gentle introduction to type classes in a course/tutorial: one
of the first lessons/chapters could state that the type of '(+)' is 'Num
- Num - Num', where 'Num' means some numeric type (stressing that it
is *the same* type in all three places), only later confessing that this
is actually shorthand for something more elaborate, and that the vague
notion of some numeric type can be made explicit using type classes.


Greetings,

Arie

-- 

Mr. Pelican Shit may be Willy.

  ^
 /e\
 ---


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


Re: class [] proposal Re: [Haskell-cafe] One thought: Num to 0 as ? to list?

2006-08-22 Thread Gene A

Arie said:
{...  This is an instance of a general conflict: should we sacrifice nice
notation for ease of learning? You could make a similar case for list
comprehensions, for example: they complicate matters for newcomers (yet
another meaning of brackets and pipe) ...}


I have to totally agree with that statement, and surely hopeful that
no one takes away the list comprehensions, as a person new to Haskell
that was something that I got the hang of right away.  I've used other
languages for YEARS before I needed or used a given construct, and the
fact that it was there never bothered me much.. I JUST DIDN'T use it.
Now as to the whole namespace part of the argument made by Brian...
well that is another kettle of fish, and I will leave that to guys
with his knowledge.. to cipher out such things... somebody has been
doing a good job on this language so far!

happy day to all,
gene
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: class [] proposal Re: [Haskell-cafe] One thought: Num to 0 as ? to list?

2006-08-22 Thread Brandon Moore

Bulat Ziganshin wrote:

Hello Malcolm,

Tuesday, August 22, 2006, 4:22:50 PM, you wrote:

  

2) allow to use type classes in type declarations like the types
itself. for example, allow the following:

f :: Num a = a - Int
write as
f :: Num - Int

and following:

sequence :: Monad m = [m a] - m [a]
write as
sequence :: [Monad a] - Monad [a]
  
I dislike the way mentioning a class implicitly introduces a new type 
variable. To make the dependency explicit you might make the type that 
is supposed to get the constraint a parameter to the class name, like


sequence :: [Monad m a] - Monad m [a]


e class contexts of (for instance)
sequenceLift :: (Monad m, Monad r) = [m a] - r [a]
if it were to be written instead as simply
sequenceLift :: [Monad a] - Monad [a]


This type could be written like [Monad m a] - Monad r [a]

I think this syntax could be done with associated types, if class Monad 
declared an associated type synonym Monad m, and somehow all instances 
were known to define the synonym equal to the type getting the instance. 
Knowing the type Monad m = m only matters if you want to be able to use 
m and Monad m interchangeably.



And how would one add multiple class constraints to a single type
variable, for instance in:
f :: (Functor m, Monad m) = (a-b) - m [a] - m b

I think it would just be confusing trying to inline constraints, but 
with the associated type interpretation it seems each constrained 
occurrence of a type would add another class constraint to the type, so 
maybe you could write

(a - b) - Monad m [a] - Functor m b.

both your examples cannot be written using proposed syntax

what i propose is not full replacement of existing syntax - quite the
contrary it is just a syntax sugar for most frequent cases of using
classes in function signatures. the key idea is that in most cases we
use only one type class for each type variable, and the same type for
each occurrence of type class in the type:

(+) :: Num - Num - Num
  
I don't like how this repeats the class name. Repetition of the name a 
in Num a = a - a - a is completely different, because the name 'a' is 
just a placeholder for expressing some local sharing in the type.


This reminds me vaguely of the syntax proposed in Daan's paper on MLF, 
where some constraints about polymorphism could be inlined, as in


(x == forall a . a - a) = [x]-String
--
[forall a . a - a] - String

Maybe there's some similarly useful shorthand here?



This also simplifies the case when programmer has developed his code
with one concrete type in mind and later decided to transform it into
typeclass. In this case my idea allows to retain old definitions in
most cases (and promoting [] to type class is very typical example
here! we can browse prelude/list module and count how many definitions
need to be changed if [] becomes type class)
  

This really isn't much easier than changing things to use
type classes. Instead of replacing the concrete type with the name of a 
class, you could replace the concrete type with a variable (maybe just 
change the case of the first letter) and add a constraint. Any editor 
smarter than ed should be able to automate either operation. (even sed, 
and pretty trivially if you don't handle multi-line type signatures)



This proposal born from my experience of using type classes to make
Streams library more flexible. i found that type signatures using type
classes becomes larger and less readable and thought that they can be
made no more complex than ordinary ones by using this idea. Java/C++
also allows to specify names of abstract classes/interfaces instead of
concrete classes. Haskell's benefit is that general syntax allows to
express more complex restrictions. I propose to combine it with the
OOP-like simple syntax for simple cases (which is 80-90% of total ones)

so, while this proposal is rather minor, i think that it is Good thing
In general, the proposal reminds me a bit of the shorthand proposed in 
Daan Leijen's paper on MLF, available at

http://www.cs.uu.nl/~daan/pubs.html#qmlf

It's a nice type system, but for this message all that matters is that 
MLF handles polymorphism using constraints like
(x = forall a . a - a) or (y = forall a . a - a), which appear in a 
type at the same place as class constraints. His shorthand is to allow 
the right side of a constraint to be embedded directly into a type, 
without naming it at all,
if there is only a single occurrence, and the type is left of an arrow 
for an = constraint, or right for a = constraint, e.g.


(x = forall a . a - a, y = forall a . a - a) = [x] - [y]
---
[forall a . a - a] - [forall a . a - a]

(yes, MLF handles impredicative types quite nicely. Daan's paper shows 
how to add type classes to MLF, making it easy to work with types like 
[forall a . (Show a) = a], and if I read correctly even to infer the 
types in

x1 = [] :: forall a . [a]
x2 = const : x1 :: [forall a b. a - b - a]
x3 = min : x2 :: [forall a . (Ord a) - a - 

Re[2]: class [] proposal Re: [Haskell-cafe] One thought: Num to 0 as ? to list?

2006-08-22 Thread Bulat Ziganshin
Hello Arie,

Tuesday, August 22, 2006, 7:24:34 PM, you wrote:
 I disagree. As a new learner to Haskell, I already have a hard time
 keeping Constructors, Types, and Classes straight. I know what they
 all are and what they all do, but sometimes I really have to think
 hard to remember which is which in a piece of code. What helps my
 understanding is that each has a specific place in the type signature
 (which I guess includes 'nowhere' regarding constructors). Being able
 to put Classes where Types go would just serve to muddle that
 understanding.


 (*) In this specific instance one might (ab?)use the additional notation
 to create a gentle introduction to type classes in a course/tutorial: one
 of the first lessons/chapters could state that the type of '(+)' is 'Num
- Num - Num', where 'Num' means some numeric type (stressing that it
 is *the same* type in all three places), only later confessing that this
 is actually shorthand for something more elaborate, and that the vague
 notion of some numeric type can be made explicit using type classes.

to be exact, it is intended usage - like in the OOP model, Num or []
can specify not only concrete type - it's something that can have
subtypes. so, meaning of

(+) :: Num - Num - Num
or
sequence :: [Monad a] - Monad [a]
or
hTell :: SeekableStream - IO Integral

is simple and straightforward. And it's the _advanced_ material that
identifiers used here may be not only defined by type declarations,
but also by class declarations, and moreover - some of already studied
type names denote classes actually.

Subtyping introduced in very natural (at least for OOP souls) way. We
may, for example, have functions:

doit :: MemBuf - IO Int
hRequestBuf :: MemoryStream - IO Int
hTell :: SeekableStream - IO Integral

and call doit - hRequestBuf - hTell and then return result, and all
will work fine because MemBuf is subclass of MemoryStream that is
subclass of SeekableStream while Int is subclass of Integral. We can
describe whole type hierarchy as having types at leafs and type classes
at internal nodes


As an example that clears my idea the following is function signatures
from one my module:

copyStream :: (BlockStream h1, BlockStream h2, Integral size)
   = h1 - h2 - size - IO ()
copyToMemoryStream :: (BlockStream file, MemoryStream mem, Integral size)
   = file - mem - size - IO ()
copyFromMemoryStream :: (MemoryStream mem, BlockStream file, Integral size)
 = mem - file - size - IO ()
saveToFile :: (MemoryStream h) =  h - FilePath - IO ()
readFromFile :: FilePath - IO MemBuf

As one can see, there is only one function that don't uses classes,
and another one that can't be written using this syntax, another 3 is
just created for using this proposal. I don't say that such ratio is
typical, but at least i have a large number of polymorphic functions
in my library and found the way to simplify most of their signatures:

copyStream :: BlockStream* - BlockStream** - Integral - IO ()
copyToMemoryStream :: BlockStream - MemoryStream - Integral - IO ()
copyFromMemoryStream :: MemoryStream - BlockStream - Integral - IO ()
saveToFile :: MemoryStream - FilePath - IO ()
readFromFile :: FilePath - IO MemBuf

i think that second block of signatures is an order of magnitude more
readable

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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