CPS based functional references

[This post is literate Haskell, download source code here]

I have recently come up with a new way of representing functional references.

As you might recall, functional references (also called lenses) are like a pointer into a field of some data structure. The value of this field can be extracted and modified. For example:

GHCi> get fstF (123,"hey")
123
GHCi> set fstF 456 (123,"hey")
(456,"hey")
GHCi> modify fstF (*2) (123,"hey")
(246,"hey")

where fstF is a functional reference to the first element of a pair. It has the type RefF (a,b) a, i.e. in a 'record' of type (a,b) it points to an a.

Previous representations relied on a record that contained the get and set or the get an modify functions. But there is a much nicer looking representation possible using Functors.


First of all we will need a language extension and some modules:

{-# LANGUAGE Rank2Types #-}
import Control.Applicative
import Control.Monad.Identity

Now the representation for functional references I came up with is:

type RefF a b = forall f. Functor f => (b -> f b) -> (a -> f a)

This type looks a lot like a continuation passing style function, which would be simply (b -> r) -> (a -> r), but where the result is f a instead of any r. With different functors you get different behaviors. With the constant functor we can get the field pointed to:

get :: RefF a b -> a -> b
get r = getConst . r Const

While the identity functor allows a function us to modify the field:

modify :: RefF a b -> (b -> b) -> a -> a
modify r m = runIdentity . r (Identity . m)

set :: RefF a b -> b -> a -> a
set r b = modify r (const b)

As an example of an 'instance', here is the fstF function I used in the introduction:

fstF :: RefF (a,b) a
fstF a_to_fa (a,b) = (\a' -> (a',b)) <$> a_to_fa a

If we had tuple sections it could be written as simply

fstF x (a,b) = (,b) <$> x a


To get access to inner fields, functional references can be composed. So compose fstF fstF points to the first element inner inside the first outer element of a nested pair. One of the things that I like about the cps/functor based representation is that composition is quite beautiful and symmetric:

compose :: RefF b c -> RefF a b -> RefF a c
compose r s = s . r

idF :: RefF a a
idF = id

Let me conclude with the pair operator, called (***) in Control.Arrow. Unfortunately this operator is not as easy to define.

pair :: RefF a c -> RefF b d -> RefF (a,b) (c,d)
pair r s cd_to_fcd (a,b) = some_ugly_code

In fact, the only way I know of implementing pair is by moving back and forth to a get/set representation

 where some_ugly_code =
         let fcd = cd_to_fcd (get r a, get s b)      -- :: f (c,d)
             cd_to_ab (c,d) = (set r c a, set s d b) -- :: (c,d) -> (a,b)
         in fmap cd_to_ab fcd                        -- :: f (a,b)

The problem is that we need to split one function of type (c,d) -> f (c,d) into two, c -> f c and d -> f d, because that is what the left and right arguments expect. Then later, we would need to do the reverse and combine two of these functions again.

Does anyone have a better suggestion for implementing pair?

posted by Twan | 10 comments | tags = /haskell | permalink | rss

Comments

Ryan Ingram wrote
Just take a hint from Control.Arrow: implement in terms of first, second, and compose. There's a little magic in figuring out how to implement "first", but from there, it's easy.

newtype FstT f b a = FstT { unFstT :: f (a,b) }
newtype SndT f a b = SndT { unSndT :: f (a,b) }

first rab m (a,c) = unFstT $ rab (\b -> FstT $ m (b,c)) a second rab m (c,a) = unSndT $ rab (\b -> SndT $ m (c,b)) a

rac *** rbd = compose (first rac) (second rbd)

Ryan Ingram wrote
Oops, forgot the instances:

instance Functor f => Functor (FstT f) where
  fmap f (FstT p) = FstT (fmap (\(a,b) -> (f a, b)) p)
instance Functor f => Functor (SndT f) where
  fmap f (SndT p) = SndT (fmap (\(a,b) -> (a, f b)) p)
Twan van Laarhoven wrote
That looks good.

I had tried a similar approach myself, but I made a mess of it. You make it look much simpler :)

One disadvantage is that pair is still done in two steps, first the first element is transformed and than the second (or the other way around). I.e. you go from f (a,b) to f (c,b) to f (c,d). You construct a pair, only to destroy it again layer.

porges wrote
I think this is even nicer if we give RefF a different name (with TypeOperators):
type a :- b = forall f. Functor f => (b -> f b) -> (a -> f a)
get :: (a :- b) -> (a -> b)
get r = getConst . r Const
modify :: (a :- b) -> (b -> b) -> (a -> a)
modify r m = runIdentity . r (Identity . m)
set :: (a :- b) -> b -> (a -> a)
set r b = modify r (const b)
fstF :: (a,b) :- a
fstF f (a,b) = (\a' -> (a',b))  f a
compose :: (b :- c) -> (a :- b) -> (a :- c)
compose r s = s . r
idF :: a :- a
idF = id

In this, we have a category formed with compose/idF, and get is something I've been using like this:

class Category (~>) => RealCategory (~>) where
    ($) :: (a ~> b) -> (a -> b)

That is, $ 'realizes' an arrow in the category as a true Haskell function that can be applied to something.

porges wrote
It appears your formatting is a bit borked...
Twan van Laarhoven wrote
Your RealCategory is a nice idea.

I didn't use type operators, the Category class or other classes to keep the presentation simple. For a real system we should eventually use something like a RefCategory class, see overloading functional references.

I also don't think these Functor based references are the best choice in practice. Something like

newtype Ref a b = Ref (a -> (b, a -> b))

would have less overhead.

Porges wrote
Interesting, I must admit to not having really read your blog before so it seems I'm covering some stuff you've already done :)

I would love to see what a re-implementation of the Haskell Prelude along these and other more recent lines of development (such as Edward Kmett's category work) would look like.

Ryan Ingram wrote
You make it look much simpler :)

To be fair, it took me the better part of an hour to come up with that answer. :)

Ryan Ingram wrote
So, I think you are right that the functor version is overkill, and here's why:

data AnyF b a = AnyF b (b -> a)
instance Functor (AnyF b) where
    fmap f (AnyF b k) = AnyF b (f . k)

mkAnyF :: b -> AnyF b b
mkAnyF b = AnyF b id

anyRef :: (a -> AnyF b a) -> Ref a b
anyRef k m a = fmap f $ m b where
    AnyF b f = k a

refAny :: Ref a b -> (a -> AnyF b a)
refAny r a = r mkAnyF a

pair rac rbd m (a,b) = fmap (f *** g) $ m (c,d) where
    AnyF c f = refAny rac a
    AnyF d g = refAny rbd b

The insight here is that by parametricity, the only operations that ref mk a can do to create the f a it has to return is to call the mk function with some argument, and then fmap on the result with some b -> a function to convert from f b to f a.

So, we can just store those two values: the argument to mk, and the functions passed to fmap, and we've encompassed everything that a reference can possibly do. This is exactly what AnyF does. Since there is an isomorphism between RefF a b and a -> AnyF b a, we might as well use the version without the overloading overhead.

Ryan Ingram wrote
Also, your regexp for matching code blocks is broken. It seems to skip intervening at-signs. :)
[http://... or mailto:you@wherever] (optional)
(optional)
To prove you are not a bot:
What number appears in the name of this blog? (hint: the answer is 21)


Empty lines separate paragraphs. Use @code@ for inline code, and > code for code blocks.