[Haskell-cafe] arrow notation

Ertugrul Söylemez es at ertes.de
Mon Feb 11 11:30:57 CET 2013


Ross Paterson <ross at soi.city.ac.uk> wrote:

> > Many computations ignore their input value.  You can recognize them
> > by their type:  [...]
>
> Inspection of types is not allowed with GHC's constraint-based type
> checker, which rules out things like this.

Too bad.  Would it be possible to get rid of "-< ()"?


> > ## returnA
> >
> > We don't need it anymore, and it has quite a stupid definition.  Get
> > rid of it in favor of 'id'.
>
> It would be reasonable to redefine returnA = id

Yes, that would be a good start.  For many applications using 'id'
instead of 'arr id' gives a huge performance boost.  In my particular
case (I'm doing wire-based FRP (WFRP)) I often start with a complex
"sum" network of categorical computations:

    c1 . c2 <|> c3 . c4 . (c5 <|> c6) <|> c7

The distinguishing feature of WFRP, what makes it so fast, is that you
can get rid of complexity by recognizing 'id' and 'empty' when they pop
up.  The component computations can "morph" into them over time, for
example

    for 3

is identity-like for three seconds and then switches to 'empty'.  You
can recognize and discard entire subnetworks quickly.


> > ## Operators
> >
> > I often need to mix regular arguments with computation arguments in
> > banana notation:
> >
> >     let f c = f' x y c z
> >     (| f (comp -< v) |)
>
> This wouldn't be legal if f was defined inside the proc.  If the
> arguments come from outside the proc, you could write (permuting the
> arguments)
>
>      (| (f x y z) (comp -< v) |)
>
> If they're defined inside the proc, you'd have something like
>
>      (| f (comp -< v) |) x y z

Of course, and that's the inconvenient part.  You have to write wrapper
functions.  It would be nice, if the bananas would consider
unparenthesized expressions as regular arguments.


> > ## PreArrow
> >
> > All sensible arrows form a family of functors:
> >
> >     instance (Arrow a) => Functor (a b) where
> >         fmap f = (arr f .)
> >
> > But they do more:  Every arrow is a profunctor as defined in the
> > 'profunctors' package:
> >
> >     instance (Arrow a) => Profunctor a where
> >         lmap f = (. arr f)
> >         rmap = fmap
> >
> > That's just what you called PreArrow,
>
> Not so: every arrow has lmap and rmap, but not everything that has an
> lmap also has an rmap.

I see.  You want to get rid of 'arr' altogether.  On one hand that is
desirable.  On the other hand for arrows lmap and rmap are equivalent.
You can define 'arr' given 'lmap':

    arr f = lmap f id

From that you can define fmap.  This leads to the conclusion that as
soon as the arrow notation does more than simple composition you need a
functor anyway.


> > ## Applicative
> >
> > One of the main bottlenecks of arrows is the heavy tuple handling,
> > but most (if not all) arrows form a family of applicative functors.
> > I noticed a huge speedup by moving from arrow style to applicative
> > style where possible:
> >
> >     liftA2 (+) (lmap f c) (fmap g d)
> >
> > is often much faster than:
> >
> >     arr (uncurry (+)) . (c . arr f &&& arr g . d)
> >
> > Besides being more readable it sometimes improved the performance of
> > my code by an order of magnitude.  So perhaps check to see if the
> > category forms an applicative functor.  If it does, you can get
> > along without Arrow entirely.
> >
> > In fact I propose to generalize all the Arrow* classes to Category*
> > classes.
>
> That sounds reasonable.  It's convenient to use simpler classes
> instead of Arrow where possible, but it's not always possible.

The idea is this:  If there are both Arrow and Applicative instances
(can you check this?), the arrow notation could use applicative
combinators instead of arrowic ones where possible:

    proc x' -> do
        f <- comp1 -< x'
        x <- comp2 -< x'
        comp3 -< f x

If this is possible, arrow notation would likely rewrite it to

    comp3 . ((\f x -> f x) <$> comp1 <*> comp2)

and, as a nice bonus, recognize that \f x -> f x is really just id and
optimize the fmap away:

    comp3 . (comp1 <*> comp2)

The pattern is:  A computation composed of subcomputations where each of
them takes the same arrow variable as input.  The corresponding arrow
version is unnecessarily expensive because of the tuple wrapping and
unwrapping,

    comp3 . arr (\(f, x) -> f x) . comp1 &&& comp2

whereas the applicative version is really straightforward and fast.


Greets,
Ertugrul

-- 
Not to be or to be and (not to be or to be and (not to be or to be and
(not to be or to be and ... that is the list monad.
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 836 bytes
Desc: not available
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130211/52443bdd/attachment.pgp>


More information about the Haskell-Cafe mailing list