
On 8/22/06, John Meacham
wrote: I am not talking about type signatures, I am talking about having to annotate in the middle of a term.
f x y | x `member` map g freeVars y = ....
having to become
f x y | x `member` map g (freeVars y :: [Id]) = ....
There is no need to write such types... In this particular case the type of 'elem' indicates that the argument is a list. I don't think that a polymorphic 'map' function requires any more signatures than, say, '>>='. This certainly is not my experience when I use 'fmap'...
So, I am not saying renaming fmap to map is bad outright, I am just saying that the question is trickier than just the error message problem it was previously stated in terms of.
Do you have an example illustrating what is tricky about 'fmap'? As far as I understand 'map' used to be polymorphic, and later the distinction between 'map' and 'fmap' was specifically introduced to avoid the error messages that may confuse beginners.
-Iavor
No, map was never overloaded--it was list comprehensions that were overloaded as monad comprehensions in Haskell 1.4. That certainly did lead to problems of exactly the sort John M is describing. As for an example of fmap causing trouble, recall the code I posted last week sometime: class Foldable f where fold :: (a -> a -> a) -> a -> f a -> a instance Foldable [] where fold = foldr example = fold (+) 0 (fmap (+1) (return 2)) Here nothing fixes the type to be lists. When I posted this, someone called it contrived because I wrote return 2 rather than [2], which would have fixed the type of fmap to work over lists. But I don't think this is contrived, except perhaps that I reused return from the Monad class, rather than defining a new collection class with overloaded methods for both creating a singleton collection and folding an operator over a collection. This is a natural thing to do, in my opinion, and it leads directly to this example. John

On 8/28/06, John Hughes
As for an example of fmap causing trouble, recall the code I posted last week sometime:
class Foldable f where fold :: (a -> a -> a) -> a -> f a -> a
I'd call this a case of "Foldable" causing trouble. :) Fold is
somewhat specific to the structure of the underlying collection (hence
the numerous fold* functions), map is not.
--
Taral

Hello,
On 8/28/06, John Hughes
No, map was never overloaded--it was list comprehensions that were overloaded as monad comprehensions in Haskell 1.4. That certainly did lead to problems of exactly the sort John M is describing.
I just checked the reports for Haskell 1.3 and 1.4 on the Haskell website and they both state that the method of 'Functor' was 'map'. I only started using Haskell towards the end of 1.4, so I don't have much experience with those versions of the language, but it seems that having an overloaded 'map' was not much of a problem if only a few people noticed.
As for an example of fmap causing trouble, recall the code I posted last week sometime:
class Foldable f where fold :: (a -> a -> a) -> a -> f a -> a
instance Foldable [] where fold = foldr
example = fold (+) 0 (fmap (+1) (return 2))
Here nothing fixes the type to be lists. When I posted this, someone called it contrived because I wrote return 2 rather than [2], which would have fixed the type of fmap to work over lists. But I don't think this is contrived, except perhaps that I reused return from the Monad class, rather than defining a new collection class with overloaded methods for both creating a singleton collection and folding an operator over a collection. This is a natural thing to do, in my opinion, and it leads directly to this example.
I don't think this example illustrates a problem with 'fmap'. The problem here is that we are using both an overloaded constructor (return) and destructor (fold), and so nothing specifies the intermediate representation. The fact that 'map' removed the ambiguity was really an accident. What if we did not need to apply a function to all elements?
example = fold (+) 0 (return 2) It seems that we could use the same argument to reason the 'return' should have the type 'a -> [a]', or that we should not overload 'fold', which with the above type seems to be fairly list specific.
-Iavor

On 8/28/06, John Hughes
wrote: No, map was never overloaded--it was list comprehensions that were overloaded as monad comprehensions in Haskell 1.4. That certainly did lead to problems of exactly the sort John M is describing.
I just checked the reports for Haskell 1.3 and 1.4 on the Haskell website and they both state that the method of 'Functor' was 'map'. I only started using Haskell towards the end of 1.4, so I don't have much experience with those versions of the language, but it seems that having an overloaded 'map' was not much of a problem if only a few people noticed.
-Iavor
Good Lord, I'd forgotten that! So I'm afraid I've also forgotten the details of the arguments that led to fmap being introduced--maybe others can fill them in. But I wouldn't conclude from that that "only a few people noticed" and so it would be OK to overload map again. On the contrary, it seems we had plenty of experience with an overloaded map--it was in the language for two and a half years, and two language versions. In the light of that experience, the Haskell 98 committee evidently decided that overloading map was a mistake, and introduced fmap for the overloaded version. Now, this was an incompatible change, and the Haskell committee was always very wary of making such changes--so there must have been a weight of experience suggesting that overloading map really was a mistake. It wouldn't have been changed on the basis of abstract discussions of small examples. My own bad experiences with list overloading were with monad comprehensions, but others must have had bad experiences with overloaded map also. Given that it's been tried--and tried so thoroughly--and then abandoned, I would be very wary of reintroducing it. We didn't simplify things in Haskell 98 for the sake of it--we simplified things because users were complaining that actually using the language had become too complex, that there were too many corners to stumble on. I think we did a good job--certainly, the Haskell community began growing considerably faster once Haskell 98 came out. So I'd be very nervous about undoing some of the simplifications we made at that time. John

On Tue, Aug 29, 2006 at 07:58:58AM +0200, John Hughes wrote:
[Iavor wrote:]
I just checked the reports for Haskell 1.3 and 1.4 on the Haskell website and they both state that the method of 'Functor' was 'map'.
Good Lord, I'd forgotten that! So I'm afraid I've also forgotten the details of the arguments that led to fmap being introduced--maybe others can fill them in.
http://www.cs.chalmers.se/~rjmh/Haskell/Messages/Decision.cgi?id=362

I don't really have the stamina to keep up with discussions like this. I have a bit more now than the first time round, so here's some more... On 2006-08-29 at 07:58+0200 "John Hughes" wrote:
On the contrary, it seems we had plenty of experience with an overloaded map--it was in the language for two and a half years,
During which there were fewer users, as you note below.
and two language versions. In the light of that experience, the Haskell 98 committee evidently decided that overloading map was a mistake, and introduced fmap for the overloaded version.
One might say that your experience persuaded the committee to do this.
Now, this was an incompatible change, and the Haskell committee was always very wary of making such changes--so there must have been a weight of experience suggesting that overloading map really was a mistake.
For teaching, yes.
It wouldn't have been changed on the basis of abstract discussions of small examples. My own bad experiences with list overloading were with monad comprehensions, but others must have had bad experiences with overloaded map also. Given that it's been tried--and tried so thoroughly--and then abandoned, I would be very wary of reintroducing it.
I don't think you can conclude that from the evidence available (ie the link, posted by Ross Paterson, to the discussion at the time)
We didn't simplify things in Haskell 98 for the sake of it--we simplified things because users were complaining that actually using the language had become too complex, that there were too many corners to stumble on.
This is where I most heartily disagree. Whatever the arguments for and against, what was done was /not/ a simplification of the language. I cannot see how it can be argued that a language where * the functorial map has three names (fmap, liftM and map) at different types * and the general functorial map (fmap) can be applied only to some Monads (the ones where an instance has explicitly given) is simpler than a language where * the functorial map is called map. Your argument that teaching the former language is simpler is very strong and I don't dispute it, but it is not, I think, a reason to require that people who want to use the language to have to put up with remembering extra complexity. Once one knows what functors and monads are (and no one can call themselves an expert Haskell programmer who does not), one should not have to think "does this Monad have an instance of Functor, or must I use liftM?" or is this function /really/ meant to work only on lists, or can I replace map with fmap and get it to work on something else (and then find that it requires copying out the whole definition because it also uses ++ or something). Yes, it makes perfect sense to have
mapList = (map :: (a->b) -> [a] -> [b])
in a prelude somewhere for teaching purposes, but aren't people eventually taught that mapList is just a specialised version of map, ++ is `mplus` specialised to lists (etc), and that one should think in terms of defining operations that are as generally useful as possible? At which point don't some of them start to wish that they could just type ++ instead of mplus? I certainly do. If it were just a question of map and fmap, I might agree that the cost would outweigh the benefit, but there's a whole swathe of functions for which I'd rather see the nicer names used for the more general versions, and clumsier ones for the versions specialised to lists for teaching purposes. We would all benefit from better error messages, but that's a different problem.
I think we did a good job--certainly, the Haskell community began growing considerably faster once Haskell 98 came out.
I'm not sure there's a causal relationship there. If the growth was anything above linear, it would be growing faster later whether or not Haskell 98 had an effect. Even if Haskell 98 was the cause, it's far from obvious that this particular change was the one that made the difference... and if it did, it may not have done so for a good reason. If you make the language easier to understand it may well become more popular (there are plenty of awfully popular awful languages out there for more or less that reason), but if it's at the expense of unnecessarily complex programmes, we shouldn't be applauding ourselves too much. In addition, it seems likely that as more and more people get a deeper understanding of Functors, Applicators and Monads, we'll find better ways of teaching them. Jón -- Jón Fairbairn Jon.Fairbairn at cl.cam.ac.uk

I haven't really been able to follow this entire thread, but I'd just
like to note here that I agree completely with Jón's take here on the
map issue. It's almost embarassing to have to tell people that there
are 3 functions in the basic libraries which do exactly the same thing
up to type signature. The issue with choosing fmap or liftM is even
worse. I usually go with fmap because it's in the Prelude and seems
more general anyway, but then, some monads aren't in Functor so I need
to be careful about creating class contexts with both Monad and
Functor constraints. Please, let's fix this. Nice general interfaces
are good. While we're at it, let's split MonadZero and MonadPlus --
the decision to merge them was not well thought-out, and a lot of
expressive power in type signatures is lost there.
I'm not sure I agree with Jón's earlier sentiment with regards to
taking everything out of the Prelude and requiring the user to import
many separate modules though. :) While the idea of producing as clean
a language as possible is attractive, the most commonly used list,
monad, and IO functionality is pretty nice to have available without
extra imports. It would also be nice to have all the usual instances
handy straight away.
In any case, it's probably a good idea to at least have those things
in separate modules, and then possibly reexported by the Prelude, as
far as structuring things goes.
I think it would be reasonable to expect the Prelude to include enough
things to provide for basic idiomatic Haskell programming, as it
(mostly) does currently. I already tend to import Data.List and
Control.Monad preemptively, but I should probably be more careful and
take note of which things I should be nagging people to move upward.
At the very least, join should be a member of the Monad class, so it
ought to be there. :)
Lists essentially take the place of loops in Haskell, and even in C,
you don't need to do an #include to get 'for'. I think the issue is
basically one of striking a balance between cleanliness of design, and
ability to write quick (1 to 10 line) programs conveniently.
Over time, the standard practice of writing Haskell code changes too.
For example things like the monad instance for ((->) e) (that is, the
lightweight reader monad) are becoming more popular -- to the point
where I'd mostly feel comfortable asking to have that put in the
Prelude. (All the people who hang around in #haskell have likely
picked up a few idioms from the @pl lambdabot module though -- perhaps
we're a biased sample ;)
- Cale
On 30/08/06, Jon Fairbairn
I don't really have the stamina to keep up with discussions like this. I have a bit more now than the first time round, so here's some more...
On 2006-08-29 at 07:58+0200 "John Hughes" wrote:
On the contrary, it seems we had plenty of experience with an overloaded map--it was in the language for two and a half years,
During which there were fewer users, as you note below.
and two language versions. In the light of that experience, the Haskell 98 committee evidently decided that overloading map was a mistake, and introduced fmap for the overloaded version.
One might say that your experience persuaded the committee to do this.
Now, this was an incompatible change, and the Haskell committee was always very wary of making such changes--so there must have been a weight of experience suggesting that overloading map really was a mistake.
For teaching, yes.
It wouldn't have been changed on the basis of abstract discussions of small examples. My own bad experiences with list overloading were with monad comprehensions, but others must have had bad experiences with overloaded map also. Given that it's been tried--and tried so thoroughly--and then abandoned, I would be very wary of reintroducing it.
I don't think you can conclude that from the evidence available (ie the link, posted by Ross Paterson, to the discussion at the time)
We didn't simplify things in Haskell 98 for the sake of it--we simplified things because users were complaining that actually using the language had become too complex, that there were too many corners to stumble on.
This is where I most heartily disagree. Whatever the arguments for and against, what was done was /not/ a simplification of the language.
I cannot see how it can be argued that a language where
* the functorial map has three names (fmap, liftM and map) at different types
* and the general functorial map (fmap) can be applied only to some Monads (the ones where an instance has explicitly given)
is simpler than a language where
* the functorial map is called map.
Your argument that teaching the former language is simpler is very strong and I don't dispute it, but it is not, I think, a reason to require that people who want to use the language to have to put up with remembering extra complexity. Once one knows what functors and monads are (and no one can call themselves an expert Haskell programmer who does not), one should not have to think "does this Monad have an instance of Functor, or must I use liftM?" or is this function /really/ meant to work only on lists, or can I replace map with fmap and get it to work on something else (and then find that it requires copying out the whole definition because it also uses ++ or something).
Yes, it makes perfect sense to have
mapList = (map :: (a->b) -> [a] -> [b])
in a prelude somewhere for teaching purposes, but aren't people eventually taught that mapList is just a specialised version of map, ++ is `mplus` specialised to lists (etc), and that one should think in terms of defining operations that are as generally useful as possible?
At which point don't some of them start to wish that they could just type ++ instead of mplus? I certainly do. If it were just a question of map and fmap, I might agree that the cost would outweigh the benefit, but there's a whole swathe of functions for which I'd rather see the nicer names used for the more general versions, and clumsier ones for the versions specialised to lists for teaching purposes.
We would all benefit from better error messages, but that's a different problem.
I think we did a good job--certainly, the Haskell community began growing considerably faster once Haskell 98 came out.
I'm not sure there's a causal relationship there. If the growth was anything above linear, it would be growing faster later whether or not Haskell 98 had an effect. Even if Haskell 98 was the cause, it's far from obvious that this particular change was the one that made the difference... and if it did, it may not have done so for a good reason. If you make the language easier to understand it may well become more popular (there are plenty of awfully popular awful languages out there for more or less that reason), but if it's at the expense of unnecessarily complex programmes, we shouldn't be applauding ourselves too much.
In addition, it seems likely that as more and more people get a deeper understanding of Functors, Applicators and Monads, we'll find better ways of teaching them.
Jón
-- Jón Fairbairn Jon.Fairbairn at cl.cam.ac.uk
_______________________________________________ Haskell-prime mailing list Haskell-prime@haskell.org http://www.haskell.org/mailman/listinfo/haskell-prime

Cale Gibbard wrote:
While we're at it, let's split MonadZero and MonadPlus -- the decision to merge them was not well thought-out, and a lot of expressive power in type signatures is lost there.
This should be split into three classes, "MonadZero", "MonadPlus" and "MonadOr" owing to variations in instances of the current MonadPlus. See: http://haskell.org/haskellwiki/MonadPlus http://haskell.org/haskellwiki/MonadPlus_reform_proposal -- Ashley Yakeley Seattle WA

Indeed, I agree.
On 30/08/06, Ashley Yakeley
Cale Gibbard wrote:
While we're at it, let's split MonadZero and MonadPlus -- the decision to merge them was not well thought-out, and a lot of expressive power in type signatures is lost there.
This should be split into three classes, "MonadZero", "MonadPlus" and "MonadOr" owing to variations in instances of the current MonadPlus.
See: http://haskell.org/haskellwiki/MonadPlus http://haskell.org/haskellwiki/MonadPlus_reform_proposal
-- Ashley Yakeley Seattle WA
_______________________________________________ Haskell-prime mailing list Haskell-prime@haskell.org http://www.haskell.org/mailman/listinfo/haskell-prime

Cale Gibbard wrote:
Indeed, I agree.
While we're at it, I'd like to see the Arrow class a bit more thinly sliced. Something like this: class Compositor a where identity :: a b b (>>>) :: a b c -> a c d -> a b d class Compositor a => Arrow a where pure :: (b -> c) -> a b c class Arrow a => ArrowProduct a where (&&&) :: a b c -> a b c' -> a b (c, c') -- derived: first :: a b c -> a (b, d) (c, d) second :: a b c -> a (d, b) (d, c) (***) :: a b c -> a b' c' -> a (b, b') (c, c') class Arrow a => ArrowCoproduct a where (|||) :: a b d -> a c d -> a (Either b c) d -- derived: left :: a b c -> a (Either b d) (Either c d) right :: a b c -> a (Either d b) (Either d c) (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c') class (ArrowProduct a,ArrowCoproduct a) => ArrowFull a etc. -- Ashley Yakeley Seattle WA
participants (7)
-
Ashley Yakeley
-
Cale Gibbard
-
Iavor Diatchki
-
John Hughes
-
Jon Fairbairn
-
Ross Paterson
-
Taral