CPS based functional references

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?

Comments

Ryan Ingramx

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 Ingramx

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)

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.

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.

It appears your formatting is a bit borked...

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.

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 Ingramx
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 Ingramx

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 Ingramx

Also, your regexp for matching code blocks is broken. It seems to skip intervening at-signs. :)

Ryan Ingramx

Just came back to this after a while and was thinking about it again.

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.

Actually, if you inline it and see what happens, the compiler probably optimizes out the intermediate pair. Here's one of the intermediate steps:

compose (second rbd) (first rac)
= \k x -> case x of (a,b)
         -> unFstT $ rac (\c -> FstT $ case (c,b) of (c,b) ->
                unSndT $ rbd (\d -> SndT $ k (c,d)) b) a

Notice the case (c,b) of (c,b) ->; the compiler (or us) can easily remove that and be left with (after some further simplification:

= \k (a,b) -> unFstT $ flip rac a $ \c -> FstT
           $ unSndT $ flip rbd b $ \d -> SndT
           $ k (c,d)
Ryan Ingramx

Although I guess the fmap passed to rac/rbd includes some information about pair manipulation. I guess I need to think about this some more.

Roman BeslikDate: 2011-10-15T16:52Zx

"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." Then it would be (b -> f a) -> (a -> f a). :) It reminds me a f-coalgebra, so it maps coalgebras.

Reply

(optional)
(optional, will not be revealed)
Name a function of type [[a]] -> [a]:
Use > code for code blocks, @code@ for inline code. Some html is also allowed.