Binding Types à la carte

Arnaud Spiwack

\(\lambda\)-calculus

data Term
  = Var Id
  | Lam Id Term
  | App Term Term
\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} x\\ \mid \lambda x. u\\ \mid u\,v \end{array}
u,v::=a∣x∣λx.u∣u v\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} x\\ \mid \lambda x. u\\ \mid u\,v \end{array}

Easy, right?

Capture avoiding substitutions

data Term
  = Var Id
  | Lam Id Term
  | App Term Term
\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} x\\ \mid \lambda x. u\\ \mid u\,v \end{array}
u,v::=a∣x∣λx.u∣u v\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} x\\ \mid \lambda x. u\\ \mid u\,v \end{array}
\begin{array}{l} (\lambda x. \lambda x. x) u \leadsto \lambda x. u\\ (\lambda x. \lambda y. x) y \leadsto \lambda y. y \end{array}
(λx.λx.x)u⇝λx.u(λx.λy.x)y⇝λy.y\begin{array}{l} (\lambda x. \lambda x. x) u \leadsto \lambda x. u\\ (\lambda x. \lambda y. x) y \leadsto \lambda y. y \end{array}

Some quicheck later

De Bruijn indices

data Term
  = Var Int
  | Lam Term
  | App Term Term
\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} i\in\mathbb{N}\\ \mid \lambda u\\ \mid u\,v \end{array}
u,v::=a∣i∈N∣λu∣u v\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} i\in\mathbb{N}\\ \mid \lambda u\\ \mid u\,v \end{array}

Ok, now I just need…

Uh… lift substitutions and shift vari…

No, wait… that's shift substitutions and…

Oh, and I must not forget to decrease indices

And then…

No, but seriously. Haskell means types, right?

Typed de Bruijn indices

data Term a
  = Var a
  | Lam (Term (Maybe a))
  | App (Term a) (Term a)
\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} i\in\mathbb{N}\\ \mid \lambda u\\ \mid u\,v \end{array}
u,v::=a∣i∈N∣λu∣u v\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} i\in\mathbb{N}\\ \mid \lambda u\\ \mid u\,v \end{array}
(>>=) ::  Term a -> (a -> Term b) -> Term b

Substitution!

Typed de Bruijn indices

data Term a
  = Var a
  | Lam (Term (Maybe a))
  | App (Term a) (Term a)
\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} i\in\mathbb{N}\\ \mid \lambda u\\ \mid u\,v \end{array}
u,v::=a∣i∈N∣λu∣u v\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} i\in\mathbb{N}\\ \mid \lambda u\\ \mid u\,v \end{array}
instance Functor Term where
  fmap f (Var x) =
    Var (f x)
  fmap f (Lam u) =
    Lam (fmap (fmap f) u)
  fmap f (App u v) =
    App (fmap f u) (fmap f v)
instance Monad Term where
  return = Var

  (Var x) >>= s =
    s x
  (Lam u) >>= s =
    Lam (u >>= traverse s)
  (App u v) >>= s =
    App (u >>= s) (v >>= s)
instance Functor Term where
  fmap f (Var x) =
    Var (f x)
  fmap f (Lam u) =
    Lam (fmap _ u)
  fmap f (App u v) =
    App (fmap f u) (fmap f v)
instance Monad Term where
  return = Var

  (Var x) >>= s =
    s x
  (Lam u) >>= s =
    Lam (u >>= _)
  (App u v) >>= s =
    App (u >>= s) (v >>= s)
f :: a -> b
-----------------------
_ :: Maybe a -> Maybe b
instance Functor Term where
  fmap f (Var x) =
    Var (f x)
  fmap f (Lam u) =
    Lam (fmap (fmap f) u)
  fmap f (App u v) =
    App (fmap f u) (fmap f v)
s :: a -> Term b
-----------------------
_ :: Maybe a -> Term (Maybe b)

Interpreters are algebras

data Term a
  = Var a
  | Lam (Term (Maybe a))
  | App (Term a) (Term a)
\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} i\in\mathbb{N}\\ \mid \lambda u\\ \mid u\,v \end{array}
u,v::=a∣i∈N∣λu∣u v\begin{array}{l} u,v ::= \phantom{a}\\ \phantom{\mid} i\in\mathbb{N}\\ \mid \lambda u\\ \mid u\,v \end{array}
typecheck :: Term a -> (a -> Type) -> Type

I really need an unfix

newtype Mu (f :: * -> *)
  = Roll (f (Mu f))
cata
  :: Functor f
  => (f a -> a) -> Mu f -> a
data ListF a l
  = Nil
  | Cons a l
  deriving Functor

type List a
  = Mu (ListF a)
foldr = cata

Non-uniform data types

data CompleteTree a
  = Complete a
  | More (CompleteTree (a, a))

Non-uniform

data List a
  = Nil
  | Cons a (List a)

Always same a!

We need a fixed point of type \(\star\rightarrow\star\), rather than \(\star\)

A higher \(\mu\)

newtype Mu (h :: (* -> *) -> * -> *) (a :: *)
  = Roll (h (Mu h) a)
cata :: _ => _ -> Mu h a -> a

What should replace functors?

What's an algebra for it?

newtype CompleteTreeF t a
  = Complete a
  | More (t (a, a))

type CompleteTree
  = Mu CompleteTreeF

Algebraic!

It's adventure time!

The category of types

The category of endofunctors

Objects: \(\star\)

Objects: \(f : \star\rightarrow\star\)

Arrows: \(a \rightarrow b\)

Arrows: natural transformations

type f ~> g
  = forall a. f a -> g a

For today:

such that

Functor f

Endofunctors of the category of endofunctors

class
    (forall f. Functor f => Functor (h f))
    => Functor1 (h :: (* -> *) -> * -> *)
  where
    fmap1 :: (Functor f, Functor g) => (f ~> g) -> h f ~> h g
class
    
       Functor1 (h :: (* -> *) -> * -> *)
  where
    fmap1 :: (Functor f, Functor g) => (f ~> g) -> h f ~> h g

Quantified constraint

The return of the catamorphism

cata1
  :: (Functor1 h, Functor f)
   => (h f ~> f) -> Mu h ~> f
cata1 alg (Roll t) = alg $ fmap1 (cata1 alg) t

Oh, wait! What about the monad thing‽

typecheck
  :: Term a -> (a -> Type) -> Type
newtype Assigned r v a
  = Assigned ((a -> v) -> r)
typecheckC
  :: TermF (Assigned Type Type)
  ~> Assigned Type Type

Towards the monad thing

data Term a
  = Var a
  | Lam (Term (Maybe a))
  | App (Term a) (Term a)
(Var x) >>= s =
  s x
(Lam u) >>= s =
  Lam (u >>= traverse s)
(App u v) >>= s =
  App (u >>= s) (v >>= s)
data Either2
  (h :: (* -> *) -> * -> *)
  (j :: (* -> *) -> * -> *)
  (f :: * -> *) (a :: *)
  = Left2 (h f a)
  | Right2  (j f a)

data Var (f :: * -> *) (a :: *)
  = Var a

(Roll (Left2 (Var x)) >>= s =
  s x
(Roll (Right2 u) >>= s =
  Roll $ Right2 _
u :: h (Mu (Var `Either2` h)) a
s :: a -> Mu (Var `Either2` h) b
--------------------------------
_ :: h (Mu (Var `Either2` h)) b

Strong functors

class Functor f => Strong f where
  strength :: (a, f b) -> f (a, b)
strength :: (f a, b) -> f (a, b)
strength (fa, b) = (,b) <$> fa
class Functor1 h => Strong1 h where
  strength1
    :: (Functor f, Functor g)
    => h f `Compose` g ~> h (f `Compose` g)
class Functor1 h => Strong1 h where
  strength1
    :: (Applicative f, Applicative g)
    => h f `Compose` g ~> h (f `Compose` g)
class Functor1 h => Strong1 h where
  strength1
    :: (Applicative f, Applicative g, Functor i)
    => h f (g a) -> (forall b. f (g b) -> i b) -> h i a
instance Strong1 h => Monad (Mu (Var `Either2` h))

Generic1

class Generic a where
  type Rep a :: *
  from  :: a -> Rep a
  to    :: Rep a -> a
class Generic1 (f :: * -> *) where
  type Rep1 f :: * -> *
  from1  :: f a -> (Rep1 f) a
  to1    :: (Rep1 f) a -> f a

Generic1 binders

| Lam (t (Maybe a))
\leadsto
⇝\leadsto
(t :*: Maybe) a

Strong (by induction)

Traversable

Simply typed \(\lambda\)-calculus

data Type
  = Base
  | Type :-> Type
  deriving (Eq, Show)

data SLamF (f :: * -> *) (a :: *)
  = SAbs_ Type (f (Maybe a))
  | SApp_ (f a) (f a)
  deriving (Generic1, Functor, Functor1, Strong1)

type SLamF' = Var `Either2` SLamF
type SLam a = Mu SLamF' a

{-# COMPLETE SAbs, (::@), SV #-}

pattern SAbs :: Type -> f (Maybe a) -> SLamF' f a
pattern SAbs tau f = Right2 (SAbs_ tau f)
pattern SAbs' tau f = Roll (SAbs tau f)

infixl 9 ::@
pattern (::@) :: f a -> f a -> SLamF' f a
pattern t ::@ u = Right2 (t `SApp_` u)

pattern SV :: a -> SLamF' f a
pattern SV x = Left2 (Var x)
type Typing = Assigned (Maybe Type) Type

typing :: SLamF' Typing ~> Typing
typing (SV x) = Assigned $ \env ->
  return $ env x
typing (SAbs tau f) = Assigned $ \env -> do
  res <- runAssigned f (env <+> tau)
  return $ tau :-> res
typing (u ::@ v) = Assigned $ \env -> do
  tau :-> res <- runAssigned u env
  tau' <- runAssigned v env
  guard (tau == tau')
  return res

typeOf :: SLam a -> (a -> Type) -> Maybe Type
typeOf u = runAssigned $ cata1 typing u

I almost forgot

data SLetF (f :: * -> *) (a :: *)
  = SLet_ (f a) (f (Maybe a))

typingLet :: SLefF Typing ~> Typing
typingLet (SLet_ rhs body) = Assigned $ \env -> do
  tau <- runAssigned rhs env
  runAssigned body (env <+> tau)

typingBoth :: (SLamF' `Either2` SLeftF) Typing ~> Typing
typingBoth = combine typing typingLet
combine
  :: (h f ~> f) -> (j f ~> f)
  -> ((h `Either2` j) f ~> f)
combine algh algj (Left2 u) = algh u
combine algh algj (Right2 v) = algj v

Open induction edition

A ludicrous constraint

instance
  ( Eq a
  , forall b f.
      ( Eq b, forall c.
               Eq c => Eq (f c))
       => Eq (h f b))
  => Eq (Mu h a)

Automatically derived

Up to \(\alpha\)-equivalence

https://hackage.haskell.org/package/unfix-binders

https://skillsmatter.com/conferences/10237-haskell-exchange-2018#skillscasts

https://slides.com/aspiwack/hx2018

Binding Types à la carte

By Arnaud Spiwack

Made with Slides.com

Binding Types à la carte

Imagine you want to write a data type for an abstract syntax tree with binders. You get started, write a function for substitution. Get lost in the renaming story. Ok. You've heard about this de Bruijn index stuff. You get started. But you get lost again in the shifts and the lifts. Wouldn't it be nice if types could help you get all of this binder story right? After all, you're writing Haskell. Arnaud will present a way to do just that: it's like de Bruijn indices, but with types. It also makes it possible to extend types-with-binders piecewise in the same style as the data type à la carte. Interestingly α-equivalent terms are equal in this representation, which is nice if you want to store the terms in tables, or use memoisation. And it all uses algebra! After all, you're writing Haskell. This story involves functors of functors (not a typo), higher catamorphisms, and Generic1 instances (not a typo either), as well as a brand new feature from GHC 8.6: quantified constraint.

  • 1,052

More from Arnaud Spiwack