Proposal: Export (#.) and (.#) from Data.Coerce

Daniel Cartwright chessai1996 at gmail.com
Fri Apr 20 19:56:02 UTC 2018


(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
(#.) _ = coerce
{-# INLINE (#.) #-}

(.#) :: Coercible a b => (b -> c) -> (a -> b) -> (a -> c)
(.#) f _ = coerce f
{-# INLINE (.#) #-}

The first of these is exported from Data.Functor.Util, and used in many
places inside of base for efficiency over '.' (compose), However no module
in base actually exports these. I have recently been using Data.Coerce more
frequently and think it would be useful to go ahead and export these from
somewhere in base.

For convenience, I will paste the note about (#.) from Data.Functor.Util:

"Note [Function coercion]
~~~~~~~~~~~~~~~~~~~~~~~

Several functions here use (#.) instead of (.) to avoid potential efficiency
problems relating to #7542. The problem, in a nutshell:

If N is a newtype constructor, then N x will always have the same
representation as x (something similar applies for a newtype deconstructor).
However, if f is a function,

N . f = \x -> N (f x)

This looks almost the same as f, but the eta expansion lifts it--the lhs
could
be _|_, but the rhs never is. This can lead to very inefficient code.  Thus
we
steal a technique from Shachaf and Edward Kmett and adapt it to the current
(rather clean) setting. Instead of using  N . f,  we use  N #. f, which is
just

coerce f `asTypeOf` (N . f)

That is, we just *pretend* that f has the right type, and thanks to the
safety
of coerce, the type checker guarantees that nothing really goes wrong. We
still
have to be a bit careful, though: remember that #. completely ignores the
*value* of its left operand.
"
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20180420/c5646504/attachment.html>


More information about the Libraries mailing list