PHOAS For Free

As of March 2020, School of Haskell has been switched to read-only mode.

Back in 2008 I wrote an article entitled "Rotten Bananas" about how to convert between the different forms of catamorphisms over "exponential" data types that arise when we go to work with Higher Order Abstract Syntax (HOAS).

Today I want to go back and revisit that post in light of my current understanding of profunctors from working on lens.

My goal today is to go through and reformulate Parametric HOAS slightly differently by using profunctors to tease apart the positive and negative occurences of the type variable.

By doing so, we can show the connection between Fegaras and Sheard's catamorphism and the free monad that laid so close to the surface in the original formulation, and we can derive a variant on Weirich and Washburn's efficient catamorphism by using an alternate encoding of the free monad that I've already blogged about before in my series on "Free Monads for Less".

Folding Invariants

If we take the base functor for an expression type that has both positive and negative occurences of a variable, there isn't much we can do with our standard tools. It isn't even a Functor, so it can't be Foldable or Traversable, Applicative or a Monad.

data ExpF a
  = App a a
  | Lam (a -> a)

To work with it, you can define a rather unsatisfying

class Invariant f where
  invmap :: (a -> b) -> (b -> a) -> f a -> f b
  
instance Invariant ExpF where
  invmap ab ba (App x y) = App (ab x) (ab y)
  invmap ab ba (Lam aa)  = Lam (ab.aa.ba)

I described this in my 2008 post as ExpFunctor, based on a similar operation in Weirich and Washburn. It is packaged up in the invariant package on Hackage as Invariant, with a method named invmap, if you find you really want to use it.

One of my goals today is to show that we can get away without it!

Erik Meijer and Graham Hutton showed in "Bananas in Space" that you can define a catamorphism over that data type if you can also define a corresponding anamorphism that serves as its inverse. E.g. to define a pretty printer for this type with Meijer/Hutton's catamorphism you also need a parser. ಠ__ಠ

newtype Mu f = In { out :: f (Mu f) } 

cata :: Invariant f => (f a -> a) -> (a -> f a) -> Mu f -> a
cata f g (In x) = f (invmap (cata f g) (ana f g) x)

ana :: Invariant f => (f a -> a) -> (a -> f a) -> a -> Mu f
ana f g x = In (invmap (ana f g) (cata f g) (g x))

Fegaras and Sheard showed that if you change the domain of the problem a bit, you can get away with a 'fake' anamorphism, by adding a constructor that you agree never to use, because the anamorphism is only ever used as a right inverse to our catamorphism. They then proceeded to provide a type system for checking this. Adopting the notation from Weirich and Washburn's take on Fegaras and Sheard's catamorphism, this would be:

data Rec f a = Place a | Roll (f (Rec f a))

cata :: Invariant f => (f a -> a) -> Rec f a -> a
cata f (Roll x) = f (invmap (cata f) Place x)
cata f (Place x) = x

You can clearly see that Place forms a right inverse of cata f:

cata f . Place = id

Now you can define smart constructors for the running Exp example, using Roll.

type Exp = Rec ExpF

lam :: (Exp a -> Exp a) -> Exp a
lam f = Roll (Lam f)

app :: Exp a -> Exp a -> Exp a
app x y = Roll (App x y)

Weirich and Washburn noted that you can prevent the accidental use of the type parameter a by quantifying over it.

Finally, Weirich and Washburn reimplemented Rec.

type Rec f a = (f a -> a) -> a

This made cata ridiculously simple:

cata :: (f a -> a) -> Rec f a -> a
cata f x = x f

But we don't have Roll any more, so we need to move the complexity into an explicit roll combinator:

roll :: Invariant f => f (Rec f a) -> Rec f a
roll x f = f (invmap (cata f) place x)

We no longer have Place either, but nothing says (f a -> a) -> a has to use the supplied function, when we know a!

place :: a -> Rec f a
place = const

Then we can see:

type Exp a = Rec ExpF a

lam :: (Exp a -> Exp a) -> Exp a
lam f = roll (Lam f)

app :: Exp a -> Exp a -> Exp a
app x y = roll (App x y)

var :: a -> Exp a
var = place

Again, in particular in both the Fegaras-Sheard and Weirich-Washburn forms, you can denote a closed term safely using

type ClosedExp = forall x. Exp x

The safety of this is really the subject of the "Boxes Go Bananas" paper.

Based on the observations about the price of substitution into free monads by Janis Voigtländer, one should probably favor Weirich and Washburn's construction if you're going to be doing substitution on your HOAS representation -- and if you're not doing substitution, then why are you using HOAS in the first place?!

Weak HOAS

Everything I've mentioned above is a "strong" HOAS variants. You can perform substitution just by passing in the expression you want.

In weak HOAS (and PHOAS) the decision is made to deal with negative occurences differently than in what we've done so far.

Instead of taking a full Exp a in negative position, we're just going to take an a.

Written monolithically, it would look something like:

data Exp a
  = Var a
  | Lam (a -> Exp a)
  | App (Exp a) (Exp a)

Then our smart constructors change a bit:

lam :: (Exp a -> Exp a) -> Exp a

weakens to

lam :: (a -> Exp a) -> Exp a

We still have both positive and negative occurences of a, but we no longer have Exp occurring in both positive and negative position.

This is particularly popular in the Coq and Agda communities because it can pass the positivity checker, but unlike strong HOAS can be a bit more painful to work with.

Parametric HOAS

Adam Chlipala does a lot of work with Parametric HOAS, which is based on a weak HOAS variant of Weirich and Washburn's Boxes Go Bananas: Encoding Higher-Order Abstract Syntax with Parametric Polymorphism, which I talked about in that post. His Lambda Tamer is based on this model.

One issue is that neither of these really gives us a free Monad, due to the fact that the a occurs in both positive and negative position and so we can't even derive a Functor instance.

Adam's work doesn't really feel this pinch, because in Coq he can define custom tactics for ltac to use and you generally don't try to factor out this pattern into a library, but when you switch to Agda and have to do everything by hand, the lack of common abstractions comes to bite you.

P is for Profunctor

Dan Piponi wrote a nice article on Profunctors in Haskell introducing profunctors to the Haskell community, and they now form the basis of much of lens. Liyang HU also has a more tongue in cheek introduction here on the School of Haskell that he originally presented back in April at a benkyoukai about various libraries of mine in Japan.

To say something is a Profunctor in Haskell is just to say it is contravariant in the first argument and covariant in the second.

class Profunctor p where
  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d

This argument order is a bit reversed from how it is usually tackled in category theory, but by lining things up this way we match up with the variances for Arrow and (->).

For convenience we also provide class methods for:

lmap :: Profunctor p => (a -> b) -> p b c -> p a c
rmap :: Profunctor p => (b -> c) -> p a b -> p a c

Notice when I wrote the Weak HOAS definition, I had to keep it monolithic? To factor out Var / Place, it winds up needing two type parameters, since now both a and Exp a occur inside the expression.

So, if we go back to the start and separate positive and negative occurences of these, we're left with something like

data ExpF a b 
  = App b b 
  | Lam (a -> b)

This forms a valid Profunctor.

instance Profunctor ExpF where
  dimap f g (App x y) = App (g x) (g y)
  dimap f g (Lam h)   = Lam (g.h.f)

PHOAS Is Free

Now we can revisit the Exp we were talking about in the section on Weak HOAS and we can rip apart the old:

data Exp a
  = Var a
  | Lam (a -> Exp a)
  | Abs (Exp a) (Exp a)

into the application of a Fegaras and Sheard free-monad-like construction

data Rec p a b
  = Place b
  | Roll (p a (Rec p a b))

to our base profunctor ExpF, so now

type Exp = Rec ExpF

But now, we're no longer free-monad like, we're actually a free monad!

We can even define this Monad, by cribbing the definition from free.

instance Profunctor p => Monad (Rec p a) where
  return = Place
  Place b  >>= f = f b
  Roll bs >>= f = Roll $ rmap (>>= f) bs

This Monad even performs capture avoiding substitution.

The Fegaras-Sheard catamorphism doesn't change much

cata :: Profunctor p => (p a b -> b) -> Rec p a b -> b
cata phi (Place b)  = b
cata phi (Roll bs) = phi (rmap (cata phi) bs)

However, it now just turns a p a-algebra into a Rec p a-algebra, and doesn't need to use Place at all!

And we get weak HOAS style smart constructors:

lam :: (a -> Exp a b) -> Exp a b
lam f = Roll (Lam f)

app :: Exp a b -> Exp a b -> Exp a b
app x y = Roll (App x y)

Now, var is the only thing that crosses the streams and causes the two type arguments to unify

var :: b -> Exp a b
var = return

Notice the difference between the type of the argument of lam and the signature of var. This causes actual expressions that use any variable they bind to wind up with the types agreeing:

foo :: Exp a a
foo = lam $ \x -> lam $ \y -> app (var x) (var y)

Take The End

Now instead of talking about a closed term in terms of quantifying over a single parameter that can only vary with an isomorphism, we take an end over our Profunctor instead:

type End p = forall x. p x x

iter0 :: Profunctor p => (p a a -> a) -> End (Rec p) -> a
iter0 phi x = cata phi x

I intend to write up a post on how to "read" universal properties as types, to help folks see where this definition for End comes from.

This was the Free monad I just said you probably don't want to use for substitution, so let's go try the other one.

Boxes Go Bananas For Less

Recall Weirich and Washburn's Rec:

type Rec f a = (f a -> a) -> a

When we go to turn that into a Profunctor directly we get stuck.

We could make

newtype Rec p a b = Rec { runRec :: (p a b -> a) -> b }

and get the variances right for a Profunctor.

instance Profunctor p => Profunctor (Rec p) where
  dimap f g (Rec h) = Rec $ \pab2a -> g $ h $ f . pab2a . dimap f g

But this doesn't look much like the instance I derived from Fegaras and Sheard's construction, and doesn't give us a Monad!

They could pull this off because a and b were interchangeable in either direction. We're a bit more constrained.

We could turn to Codensity of my weak variant of the Fegaras-Sheard construction, but as I've blogged about before, Codensity (Free f) is bigger than it needs to be.

Fortunately, that same series ended showing how you can get there with just Yoneda. Armed with that, we can borrow the Church-Free monad and get a Weirich and Wasburn-style Profunctor for Rec.

data Rec p a b = Rec 
  { runRec :: forall r. 
    (b -> r) -> (p a r -> r) -> r 
  }

instance Profunctor p => Profunctor (Rec p) where
  dimap f g m = Rec $ \kp kf -> runRec m (kp.g) (kf.lmap f)

We retain the Monad we won by splitting our type parameters in the weak Fegaras-Sheard variant above:

instance Profunctor p => Monad (Rec p a) where
  return b = Rec $ \ br _ -> br b
  m >>= f  = Rec $ \kp kf -> 
    runRec m (\a -> runRec (f a) kp kf) kf

and we can define the rest of the catamorphism machinery:

type End p = forall x. p x x

cata :: Profunctor p => (p a b -> b) -> Rec p a b -> b
cata phi m = runRec m id phi

roll :: Profunctor p => p a (Rec p a b) -> Rec p a b
roll w = Rec $ \kp kf -> kf (rmap (\r -> runRec r kp kf) w)

iter0 :: Profunctor p => (p a a -> a) -> End (Rec p) -> a
iter0 phi x = cata phi x

Now we can put together our smart constructors

lam :: (a -> Exp a b) -> Exp a b
lam f = roll (Lam f)

app :: Exp a b -> Exp a b -> Exp a b
app x y = roll (App x y)

var :: b -> Exp a b
var = return

and we can build expressions

foo :: Exp a a
foo = lam $ \x -> lam $ \y -> app (var x) (var y)

Conclusion

There is a lot more we can play with here.

Many expression types will admit a Strong instance. Now that we've split the input and output parameters can we perhaps use that or something like it to more easily manipulate environments?

Just like with bound we can build an indexed version of this construction that permits us to write strongly typed EDSLs. That is how PHOAS is usually presented in Coq after all.

There is also probably a lot more to be said about dinaturality here.

I still generally prefer working with bound to working in HOAS these days, because it is much easier to work under lambdas, and it is easier to grab all your free variables using Foldable and Traversable and harder to make mistakes with.

That said it is good to finally be able to merge together the notion of Fegaras and Sheard's construction and the standard free monad.

This also strikes me as a good first step towards being able to turn PHOAS into something that can be encoded usefully in Haskell as a library rather than a design pattern.

-[-](-)Edward Kmett

September 18th, 2013

comments powered by Disqus