
Hello, In keeping with my small but seemingly extremely controversial suggestions for changes to the Prelude, here's a suggestion which I think is elegant and worth considering for the Haskell' Prelude: Rename fmap to map (like it was in Haskell 1.4), and define (.) as a synonym for it. Additionally, add the instance: instance Functor ((->) e) where map f g x = f (g x) (and hopefully the corresponding Monad instance as well) This has the beautiful effect of unifying the notation for two of the most important things in functional programming: function composition and functorial application, and will hopefully reduce the number of extraneous functor application definitions in the Prelude and libraries. Note that the fusion law for functors: map (f . g) x = map f (map g x) When written in terms of (.) becomes: (f . g) . x = f . (g . x) which means that (.) will still be reliably associative, and that the functor in question is always easily determined by the type of the last thing in any chain of (.)'s. This has a fair level of backwards compatibility obviously, as it's strictly a generalisation on both fronts. I've been playing around with it for a while, and like it quite a lot myself, though it would be more convenient to really use if it was in the Prelude. - Cale

Am Mittwoch, 23. April 2008 23:55 schrieb Cale Gibbard:
[…]
Rename fmap to map
This would be really great! There is no point in having a map just for lists and a general map for functors since the list map is the same as the list instance’s functor map. And identifiers with a single lowercase letter in front or after a lowercase word (fmap, foldr, etc.) are not nice, in my opinion.
(like it was in Haskell 1.4),
It really was this way in Haskell 1.4? Why was it changed?
and define (.) as a synonym for it.
I don’t think that this is reasonable. (.) corresponds to the little circle in math which is a composition. So (.) = (<<<) would be far better.
Additionally, add the instance:
instance Functor ((->) e) where map f g x = f (g x)
(and hopefully the corresponding Monad instance as well)
And hopefully the corresponding Applicative instance as well! Applicative functors are a very nice thing. (So a big “thank you” to Conor and Ross.)
[…]
Best wishes, Wolfgang

2008/4/24 Wolfgang Jeltsch
Am Mittwoch, 23. April 2008 23:55 schrieb Cale Gibbard:
[…]
Rename fmap to map
This would be really great! There is no point in having a map just for lists and a general map for functors since the list map is the same as the list instance's functor map. And identifiers with a single lowercase letter in front or after a lowercase word (fmap, foldr, etc.) are not nice, in my opinion.
(like it was in Haskell 1.4),
It really was this way in Haskell 1.4? Why was it changed?
and define (.) as a synonym for it.
I don't think that this is reasonable. (.) corresponds to the little circle in math which is a composition. So (.) = (<<<) would be far better.
But the realisation here is that composition *is* functor application, for a certain rather important functor. :) - Cale

On Thursday 24 April 2008, Wolfgang Jeltsch wrote:
I don’t think that this is reasonable. (.) corresponds to the little circle in math which is a composition. So (.) = (<<<) would be far better.
Were I building a library, this might be the direction I'd take things. They're two incompatible generalizations, and you have to decide which is more important to you. For instance, you can generalize from arrows into categories (with objects in *): class Category (~>) where id :: a ~> a (.) :: (b ~> c) -> (a ~> b) -> (a ~> c) And, of course, from this, you get the usual meanings for (->): instance Category (->) where id x = x (f . g) x = f (g x) An example of a Category that isn't an Arrow (I think) is: newtype Op (~>) a b = Op { unOp :: b ~> a } instance Category (~>) => Category (Op (~>)) where id = Op id -- (.) :: (b <~ c) -> (a <~ b) -> (a <~ c) (Op f) . (Op g) = Op (g . f) type HaskOp = Op (->) (Why is this even potentially useful? Well, if you define functors with reference to what two categories they relate, you get (pardon the illegal syntax): map :: (a ~1> b) -> (f a ~2> f b) Which gives you current covariant endofunctors if (~1>) = (~2>) = (->), but it also gives you contravariant endofunctors if (~1>) = (->) and (~2>) = Op (->). Is this a useful way of structuring things in practice? I don't know.) Now, going the (.) = map route, one should note the following Functor instance: instance (Arrow (~>)) => Functor ((~>) e) where -- fmap :: (a -> b) -> (e ~> a) -> (e ~> b) fmap f g = arr f <<< g So, in this case (.) is composition of a pure function with an arrow, but it does not recover full arrow composition. It certainly doesn't recover composition in the general Category class above, because there's no operation for lifting functions into an arbitrary Category (think Op: given a function (a -> b), I can't get a (b -> a) in general). (At a glance, if you have the generalized Functors that reference their associated Categories, you have: map (a ~1> b) -> (e ~3> a) ~2> (e ~3> b) so for (~1>) = (~3>), and (~2>) = (->), you've recovered (.) for arbitrary categories: instance (Category (~>) => Functor ((~>) e) (~>) (->) where map f g = f . g so, perhaps with a generalized Functor, you can have (.) = map *and* have (.) be a generalized composition.) Now, the above Category stuff isn't even in any library that I know of, would break tons of stuff (with the generalized Functor, which is also kind of messy), and I haven't even seriously explored it, so it'd be ridiculous to request going in that direction for H'. But, restricted to the current libraries, if you do want to generalize (.), you have to decide whether you want to generalize it as composition of arrows, or as functor application. The former isn't a special case of the latter (with the current Functor, at least). Generalizing (.) to Arrow composition seems more natural to me, but generalizing to map may well have more uses. -- Dan

2008/4/24 Dan Doel
On Thursday 24 April 2008, Wolfgang Jeltsch wrote:
I don't think that this is reasonable. (.) corresponds to the little circle in math which is a composition. So (.) = (<<<) would be far better.
Were I building a library, this might be the direction I'd take things. They're two incompatible generalizations, and you have to decide which is more important to you.
For instance, you can generalize from arrows into categories (with objects in *):
class Category (~>) where id :: a ~> a (.) :: (b ~> c) -> (a ~> b) -> (a ~> c)
And, of course, from this, you get the usual meanings for (->):
instance Category (->) where id x = x (f . g) x = f (g x)
An example of a Category that isn't an Arrow (I think) is:
newtype Op (~>) a b = Op { unOp :: b ~> a }
instance Category (~>) => Category (Op (~>)) where id = Op id -- (.) :: (b <~ c) -> (a <~ b) -> (a <~ c) (Op f) . (Op g) = Op (g . f)
type HaskOp = Op (->)
(Why is this even potentially useful? Well, if you define functors with reference to what two categories they relate, you get (pardon the illegal syntax):
map :: (a ~1> b) -> (f a ~2> f b)
Which gives you current covariant endofunctors if (~1>) = (~2>) = (->), but it also gives you contravariant endofunctors if (~1>) = (->) and (~2>) = Op (->). Is this a useful way of structuring things in practice? I don't know.)
Now, going the (.) = map route, one should note the following Functor instance:
instance (Arrow (~>)) => Functor ((~>) e) where -- fmap :: (a -> b) -> (e ~> a) -> (e ~> b) fmap f g = arr f <<< g
So, in this case (.) is composition of a pure function with an arrow, but it does not recover full arrow composition. It certainly doesn't recover composition in the general Category class above, because there's no operation for lifting functions into an arbitrary Category (think Op: given a function (a -> b), I can't get a (b -> a) in general).
(At a glance, if you have the generalized Functors that reference their associated Categories, you have:
map (a ~1> b) -> (e ~3> a) ~2> (e ~3> b)
so for (~1>) = (~3>), and (~2>) = (->), you've recovered (.) for arbitrary categories:
instance (Category (~>) => Functor ((~>) e) (~>) (->) where map f g = f . g
so, perhaps with a generalized Functor, you can have (.) = map *and* have (.) be a generalized composition.)
Now, the above Category stuff isn't even in any library that I know of, would break tons of stuff (with the generalized Functor, which is also kind of messy), and I haven't even seriously explored it, so it'd be ridiculous to request going in that direction for H'. But, restricted to the current libraries, if you do want to generalize (.), you have to decide whether you want to generalize it as composition of arrows, or as functor application. The former isn't a special case of the latter (with the current Functor, at least).
Generalizing (.) to Arrow composition seems more natural to me, but generalizing to map may well have more uses.
-- Dan
Right, my own preference in this regard is to generalise in the direction that (<<<) would be a method of Category, which is a generalisation of Arrow. We currently at least have way more Functor instances than Category instances, so it seems sensible to pick the shorter notation for the more common case, but I do strongly think we should start pushing things in this direction. These are all really nice, extremely general ideas which can make libraries nicely uniform. - Cale

Dan Doel wrote:
If you do want to generalize (.), you have to decide whether you want to generalize it as composition of arrows, or as functor application. The former isn't a special case of the latter (with the current Functor, at least).
By annotating functors with the category they operate on, you can reconcile both seemingly different generalizations class Category (~>) => Functor (~>) f where (.) :: (a ~> b) -> (f a -> f b) -- functor application instance Functor (->) [] where (.) = map -- arrow composition instance Category (~>) => Functor (~>) (d ~>) where (.) = (<<<) Regards, apfelmus

Cale Gibbard wrote:
Hello,
In keeping with my small but seemingly extremely controversial suggestions for changes to the Prelude, here's a suggestion which I think is elegant and worth considering for the Haskell' Prelude:
Rename fmap to map (like it was in Haskell 1.4), and define (.) as a synonym for it.
One thing I fear (though that fear may be irrational) is that you get code that looks like "(.) . ((.) . (.) .)". To me, and I expect to many people, map and composition are different things, and used in different ways. If both are written as a dot it will take extra mental effort to decipher the meaning of a program. The potential for writing code that resembles the worst outputs of the @pl lambdabot plugin also becomes larger. Cale: do you have some real world examples of code you wrote using (.) = fmap? Secondly, I am really fond of the Applicative notation <$>, which goes great together with <*>. A lighter notation would be nice, but I see no good way to do that. (Perhaps we need to add syntactic sugar for idiom brackets?) Twan

2008/4/24 Twan van Laarhoven
Cale Gibbard wrote:
Hello,
In keeping with my small but seemingly extremely controversial suggestions for changes to the Prelude, here's a suggestion which I think is elegant and worth considering for the Haskell' Prelude:
Rename fmap to map (like it was in Haskell 1.4), and define (.) as a synonym for it.
One thing I fear (though that fear may be irrational) is that you get code that looks like "(.) . ((.) . (.) .)". To me, and I expect to many people, map and composition are different things, and used in different ways. If both are written as a dot it will take extra mental effort to decipher the meaning of a program. The potential for writing code that resembles the worst outputs of the @pl lambdabot plugin also becomes larger.
This is why I recommend having (.) only be a synonym for map (which would be the method of Functor).
Cale: do you have some real world examples of code you wrote using (.) = fmap?
I haven't used the convention in anything too large, but I've found it rather convenient and natural in the case of, for instance, IO, to be able to write things like map read . lines . getContents. I've played around with it in a lot of small cases and not found ambiguity to be much of a problem. It turns out that the functor is basically always determined by the last thing in the chain of (.) applications, so it remains sensible.
Secondly, I am really fond of the Applicative notation <$>, which goes great together with <*>. A lighter notation would be nice, but I see no good way to do that. (Perhaps we need to add syntactic sugar for idiom brackets?)
Yeah, that's something to think about. I agree that the appearance of <$> mixes well with the other Applicative operators, and should likely remain a part of that library. Adding special syntactic support for Applicative could be very nice though. - Cale

On Thu, Apr 24, 2008 at 6:06 PM, Twan van Laarhoven
Cale Gibbard wrote:
Hello,
In keeping with my small but seemingly extremely controversial suggestions for changes to the Prelude, here's a suggestion which I think is elegant and worth considering for the Haskell' Prelude:
Rename fmap to map (like it was in Haskell 1.4), and define (.) as a synonym for it.
One thing I fear (though that fear may be irrational) is that you get code that looks like "(.) . ((.) . (.) .)". To me, and I expect to many people, map and composition are different things, and used in different ways. If both are written as a dot it will take extra mental effort to decipher the meaning of a program. The potential for writing code that resembles the worst outputs of the @pl lambdabot plugin also becomes larger.
I'd much rather keep composition and functor map separate. I'm still not entirely sure that generalizing (.) to other morphisms in the Category class is a good idea. Function composition gets used a *lot*, and I imagine we'd loose a lot of inlining if it became a class method.
Secondly, I am really fond of the Applicative notation <$>, which goes great together with <*>. A lighter notation would be nice, but I see no good way to do that. (Perhaps we need to add syntactic sugar for idiom brackets?)
As much as I like Applicative, I dislike the name "<*>". To me, it
makes more sense to use "<$>" for <*>, since it's application of
wrapped functions. I've used "$^" as a synonym for fmap (because it's
lifted application).
It would be nice to have sugar for idiom brackets. You can simulate
them with a class, but the result typically doesn't stand out enough
visually as being special syntax.
--
Dave Menendez

2008/4/24 David Menendez
On Thu, Apr 24, 2008 at 6:06 PM, Twan van Laarhoven
wrote: Cale Gibbard wrote:
Hello,
In keeping with my small but seemingly extremely controversial suggestions for changes to the Prelude, here's a suggestion which I think is elegant and worth considering for the Haskell' Prelude:
Rename fmap to map (like it was in Haskell 1.4), and define (.) as a synonym for it.
One thing I fear (though that fear may be irrational) is that you get code that looks like "(.) . ((.) . (.) .)". To me, and I expect to many people, map and composition are different things, and used in different ways. If both are written as a dot it will take extra mental effort to decipher the meaning of a program. The potential for writing code that resembles the worst outputs of the @pl lambdabot plugin also becomes larger.
I'd much rather keep composition and functor map separate. I'm still not entirely sure that generalizing (.) to other morphisms in the Category class is a good idea. Function composition gets used a *lot*, and I imagine we'd loose a lot of inlining if it became a class method.
It should specialise quite nicely. The only places I'd expect you'd lose optimisation would be those which were truly polymorphic applications, which you otherwise couldn't have written as (.) anyway. Someone who knows more about how GHC works might want to comment further, but a simple SPECIALISE pragma for it should do the trick. - Cale
participants (6)
-
apfelmus
-
Cale Gibbard
-
Dan Doel
-
David Menendez
-
Twan van Laarhoven
-
Wolfgang Jeltsch