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}

\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}

\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}

\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}

\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}

\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}

\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}

\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