[Haskell-cafe] Point-free style
Conor McBride
ctm at cs.nott.ac.uk
Mon Feb 14 12:57:35 EST 2005
Lennart Augustsson wrote:
> Daniel Fischer wrote:
>
>> And could one define
>>
>> \f g h x y -> f (g x) (h y)
>>
>> point-free?
>
> Any definition can be made point free if you have a
> complete combinator base at your disposal, e.g., S and K.
>
> Haskell has K (called const), but lacks S. S could be
> defined as
> spread f g x = f x (g x)
Given (you guessed it)
class Idiom i where
ii :: x -> i x
(<%>) :: i (s -> t) -> i s -> i t
I tend to write
instance Idiom ((->) r) where
ii = const
(<%>) rst rs r = rst r (rs r)
or
instance Idiom ((->) r) where
ii = return
(<%>) = ap
The idiom bracket notation (implemented by ghastly hack) gives
iI f is1 ... isn Ii
= ii f <%> is1 <%> .. <%> isn
:: i t
when f :: s1 -> .. -> sn -> t
is1 :: i s1
..
isn :: i sn
The point is to turn higher-order/effectful things into first-order
applicative things, so
eval :: Expr -> [Int] -> Int
eval (Var j) = (!! j)
eval (Add e1 e2) = iI (+) (eval e1) (eval e2) Ii
-- and so on
The above is a bit pointwise, a bit point-free: the components of
the expression get named explicitly, the plumbing of the environment
is hidden. I get the plumbing for free from the structure of the
computations, which I really think of as first-order things in the
environment idiom, rather than higher-order things in the identity
idiom.
Thomas Jäger wrote:
> Yes, me too. I think obscure point-free style should only be used if a
> type signature makes it obvious what is going on. Occasionally, the
> obscure style is useful, though, if it is clear there is exactly one
> function with a specific type, but tiresome to work out the details
> using lambda expressions. For example to define a map function for the
> continuation monad
>
>>cmap :: (a -> b) -> Cont r a -> Cont r b
Correspondingly, if I were developing the continuation monad, I'd
probably write the monad instance itself in quite a pointy way, with
suggestive (not to say frivolous) identifiers
data Cont a x = Cont {runCont :: (x -> a) -> a}
instance Monad (Cont a) where
return x = Cont $ \ uputX -> uputX x
ugetS >>= ugetTfromS = Cont $ \ uputT ->
runCont ugetS $ \ s ->
runCont (ugetTfromS s) $ \ t ->
uputT t
And then I already have the map operator, liftM. But more generally,
if I wanted to avoid ghastly plumbing or overly imperative-looking
code, I'd perform my usual sidestep
instance Idiom (Cont a) where
ii = return
(<%>) = ap
and now I've got a handy first-order notation. If I didn't already
have map, I could write
mapI :: Idiom i => (s -> t) -> i s -> i t
mapI f is = iI f is Ii
although
mapI = (<%>) . ii
is perhaps too tempting for an old sinner like me.
My rule of thumb is that tunes should be pointwise, rhythms point-free.
And you know the old gag about drummers and drum machines...
Conor
--
http://www.cs.nott.ac.uk/~ctm
More information about the Haskell-Cafe
mailing list