The difference between ($) and application

The operator ($) is often considered an application operator of a lower precedence. Modulo precedence, there seem to be no difference between ($) and `the white space', and so one can quickly get used to treat these operators as being semantically the same. However, they are not the same in all circumstances. I'd like to observe an important case where replacing the application with ($) in a fully-parenthesized expression can lead to a type error.
{-# OPTIONS -fglasgow-exts #-}
module Foo where
data WR = WR (Int -> Int) data W = W (forall a. a->a)
t1 = WR id t2 = W id
We can also write
t1' = WR $ id
However, if we try
t2' = W $ id
we get an error: /tmp/t1.hs:13: Inferred type is less polymorphic than expected Quantified type variable `a' escapes Expected type: (a -> a) -> b Inferred type: (forall a1. a1 -> a1) -> W In the first argument of `($)', namely `W' In the definition of `t2'': t2' = W $ id Incidentally, Hugs -98 gives a quite bizarre error message ERROR "/tmp/t1.hs":13 - Use of W requires at least 1 argument It didn't complain about "WR $ id"... The reasons for that behavior are obvious: the compiler cannot generalize to higher-ranked types when instantiating the type of ($). It makes a difference that the application is a built-in construction, whereas ($) is just a regular function.

On Mon, Dec 13, 2004 at 07:49:00PM -0800, oleg@pobox.com wrote:
The operator ($) is often considered an application operator of a lower precedence. Modulo precedence, there seem to be no difference between ($) and `the white space', and so one can quickly get used to treat these operators as being semantically the same. However, they are not the same in all circumstances. I'd like to observe an important case where replacing the application with ($) in a fully-parenthesized expression can lead to a type error.
I think this post should go under the heading "($) considered harmful". I've been bitten by this, and I never use ($) anymore in place of parentheses because it's too tempting to think of it as syntax. (Of course, it's still useful, by itself or in a slice, as a higher-order operator.) Andrew

On Tue, Dec 14, 2004 at 11:23:24AM +0100, Henning Thielemann wrote:
On Tue, 14 Dec 2004, Andrew Pimlott wrote:
(Of course, it's still useful, by itself or in a slice, as a higher-order operator.)
You can also use 'id' in this cases, right?
I'm thinking of things like zipWith ($) map ($ x) Andrew

Date: Tue, 14 Dec 2004 10:24:15 -0500 From: Andrew Pimlott
Subject: Re: [Haskell-cafe] The difference between ($) and application On Tue, Dec 14, 2004 at 11:23:24AM +0100, Henning Thielemann wrote:
On Tue, 14 Dec 2004, Andrew Pimlott wrote:
(Of course, it's still useful, by itself or in a slice, as a higher-order operator.)
You can also use 'id' in this cases, right?
I'm thinking of things like
zipWith ($) map ($ x)
You can indeed use zipWith id map (`id` x) instead. Look at the types: id :: a -> a ($) :: (a -> b) -> (a -> b) The function ($) is the identity function, restricted to functions. Nevertheless, I find using ($) in such a situation more descriptive than using id. Cheers, Andres

Andres Loeh
The function ($) is the identity function, restricted to functions.
Almost. With the standard definition of f $ x = f x it happens that ($) undefined `seq` () = () id undefined `seq` () = undefined -- __("< Marcin Kowalczyk \__/ qrczak@knm.org.pl ^^ http://qrnik.knm.org.pl/~qrczak/

oleg@pobox.com wrote: [...]
However, if we try
t2' = W $ id
we get an error:
/tmp/t1.hs:13: Inferred type is less polymorphic than expected Quantified type variable `a' escapes Expected type: (a -> a) -> b Inferred type: (forall a1. a1 -> a1) -> W In the first argument of `($)', namely `W' In the definition of `t2'': t2' = W $ id
Incidentally, Hugs -98 gives a quite bizarre error message
ERROR "/tmp/t1.hs":13 - Use of W requires at least 1 argument
This is also the reason we write runST (do ...) instead of runST $ do ... isn't it?
participants (6)
-
Andres Loeh
-
Andrew Pimlott
-
Henning Thielemann
-
Marcin 'Qrczak' Kowalczyk
-
oleg@pobox.com
-
Tom Pledger