In Haskell, different sorts of effectful computations can be expressed using monads. Monads for individual effects are fairly well understood. The challenge now is to combine many different effects. Applications manage many kinds of resources (files, network, databases…), handle many types of errors, and run in different environments (production vs testing with mock components). Can that be done while maintaining a reasonable level of separation of concerns?
Currently, a common approach is to use monad transformers and type classes (mtlstyle).
But when you have a big stack of monad transformers, it may not be easy to even
understand what (>>=)
does, because its behavior arises from the composition
of all of these transformers. So the actual control flow of the program is
opaque to us, which can be an obstacle to locating errors and guaranteeing
performance.
Algebraic effects are another approach to combine effects. Whereas with transformers, every monad transformer must be defined from scratch, algebraic effects start from a few core primitives: you have one (parameterized) monad with abilities to “call” an operation and to “handle” such calls. The hope is that those core primitives:
Until now, algebraic effect systems in Haskell used free monads or the continuation monad. Continuations were emulated as closures; this comes with a level of indirection whose cost is difficult to mitigate. The newly implemented delimited continuations primops let us directly manipulate native continuations.
This post uses delimited continuations to implement programs with various effects. The usual culprits:
The example programs leveraging this mini effect library will look like your
standardfare monadic code. What makes them interesting is that, operationally,
they are all in the IO
monad. Unlike with monad transformers, adding a new
effect does not change the underlying monad, so code that doesn’t use that
effect does not pay a price for it. Another notable consequence is that
“unlifting” abstractions like UnliftIO
or MonadBaseControl
are no longer
relevant: there is nothing to “unlift” if you never leave IO
.
The abstraction layer of algebraic effects over continuations is so thin that I
just use prompt
and control0
directly, but the bits that are “operations”
and the bits that are “handlers” are clearly identifiable. The system
implemented here is untyped as far as effects are concerned, but features
named handlers as a mitigating alternative;
a complete effect system which would keep track of what operations each
computation may call and would provide safe primitives to define new effects is
left as an exercise for the reader.
This post is written in Literate Haskell (source code). It can be compiled using the development version of GHC (or GHC 9.6 if it has been released).
$ ghc 20230102delcontexamples.lhs mainis DelContExamples.main o runtests
$ ./runtests
All tests passed!
{# LANGUAGE
BangPatterns,
BlockArguments,
DerivingStrategies,
GADTs,
GeneralizedNewtypeDeriving,
MagicHash,
UnboxedTuples #}
module DelContExamples where
import qualified Control.Exception as E
import Control.Exception.Base (NoMatchingContinuationPrompt(..))
import Data.Either
import Data.Foldable (for_)
import Data.Functor (void)
import Data.Functor.Sum (Sum(..))
import Data.Maybe (fromMaybe, maybe)
import System.IO.Unsafe
import System.Environment
import GHC.Exts (PromptTag#, newPromptTag#, prompt#, control0#)
import GHC.IO (IO(..))
import GHC.Stack (HasCallStack)
import Prelude hiding (log)
Capturing continuations is the power of the continuation monad, in which we can embed all other monads. It’s the mother of all monads.
Mom
is defined identically to IO
, but its only operations are the new
delimited continuation primitives.
newtype Mom a = Mom (IO a)
deriving newtype (Functor, Applicative, Monad)
The available operations wrap the RTS primitives newPromptTag#
,
prompt#
and control0#
.
 Unsafe primitives
data PromptTag a = PromptTag (PromptTag# a)
newPromptTag :: Mom (PromptTag a)
newPromptTag = Mom (IO (\s > case newPromptTag# s of
# s', tag #) > (# s', PromptTag tag #)))
(
prompt :: PromptTag a > Mom a > Mom a
prompt (PromptTag tag) (Mom (IO m)) = Mom (IO (prompt# tag m))
control0 :: PromptTag a > ((Mom b > Mom a) > Mom a) > Mom b
control0 (PromptTag tag) f =
Mom (IO (control0# tag (\k > case f (\(Mom (IO a)) > Mom (IO (k a))) of Mom (IO b) > b)))
The boxing of the continuation k
in control0
could be avoided by
introducing a new type for continuations, replacing (Mom b > Mom a)
.
I’m not sure whether there is much to gain from that optimization.
I leave it like this for simplicity.
prompt
and control0
, “goto” with extra steps?When a function terminates normally, it returns its result to its caller,
its predecessor in the call stack. prompt
lets you prepare another return point
earlier in the call stack, and control0
returns to that point. What happens
to all the stack frames that were skipped that way? They are copied to the heap so they
can be restored later.
In more concrete terms, when you call control0 t f :: Mom b
, the caller expects a
result of some type b
. It is assumed that you have previously set up a
prompt t :: Mom a > Mom a
in the call stack with the same tag t :: PromptTag a
.
The slice of the stack up to that prompt t
is unwinded and stored as a function
continue :: Mom b > Mom a
(IO b > IO a
).
prompt t
is popped off the stack, and the program carries on as f continue
.
It sounds completely insane the first time you learn about it, it’s like “goto” with extra steps. And yet, when you get down to it, delimited continuations have rather clean semantics, both operationally and denotationally. The implementation was a surprisingly small change in GHC.
The changes required to implement
— The GHC Proposalprompt#
andcontrol0#
are relatively minimal. They only impact the RTS, and they do not require any changes to existing functionality. Though capturing portions of the RTS stack may seem like a radical proposition, GHC actually already does it when raising an asynchronous exception to avoid the need to duplicate work for any blackholed thunks. In fact, getting that right is significantly more subtle than implementingcontrol0#
, which is quite straightforward in comparison.
The richness of continuations, both theoretically and practically, suggests that these control operators are not as arbitrary as they seem.
The code in this post can be split in two levels. Librarylevel code uses the delimited
continuation primitives to implement effects—operations and handlers, and userlevel
code uses those effects in example programs.
Without direct access to delimited continuations, userlevel code cannot
observe any mutation, so it will be safe to use the following pure run
function.
 Look Ma', no IO!
run :: Mom a > Maybe a
run (Mom m) = unsafePerformIO
E.catch (Just <$> m) \NoMatchingContinuationPrompt > pure Nothing) (
Hiding the delimited continuations primitives avoids the danger of duplicating
and observing the creation of fresh PromptTag
s in a pure context.
Some partiality remains (Maybe
) due to potentially mismatched
control0#
calls. Such errors would be prevented by a type system for effects,
which is beyond the scope of this post.
On prompt#
, control0#
, and newPromptTag#
:
On the continuation monad:
To begin, let’s implement exceptions using delimited continuations.
This effect has an operation throw
and a handler catch
.
We first declare the uninterpreted operation Throw
as a constructor
in a functor. The parameter a
is ignored by exceptions; it will be
used by other effects.
data Exception e a
= Throw e
We wrap this constructor in a userfacing function throw
.
Every throw
should have a matching catch
, and we ensure this
by requiring a tag
that identifies the corresponding catch
.
The exact type of tag
will be revealed in a moment.
control0
uses that tag
to look up the matching catch
in the call stack,
and returns to it with the exception e
wrapped in Throw
.
The underscore is the continuation, which is the slice of the stack below the
catch
, which is thus discarded.
throw :: Exception e % r > e > Mom a
throw tag e = control0 tag \_ > pure (Op (Throw e))
The type of catch
should also look familiar, with the novelty that the
handled computation f
expects a tag—so that it may call throw
.
In catch f onThrow
, a fresh tag
is generated, then
f tag
either (1) returns normally, and its result is wrapped in Pure a
,
or (2) f tag
throws an exception wrapped in Op (Throw e)
.
We then return the result or apply the handler onThrow
accordingly.
catch :: (Exception e % a > Mom a) > (e > Mom a) > Mom a
catch f onThrow = do
tag < newPromptTag
handle tag (f tag)
where
handle tag action = do
next < prompt tag (Pure <$> action)
case next of
Op (Throw e) > onThrow e
Pure a > pure a
You might have guessed that the Exception e % a
tag is just a PromptTag
.
More surprisingly, the tag index involves a free monad.
For exceptions, Free (Exception e) a
is equivalent to Either e a
:
we expect the computation under prompt
to produce either an exception e
or
a result a
. More generally, for an effect expressed as a functor f
,
things will be set up exactly so that handlers will be matching on a
computation/tree of type Free f r
.
type f % r = PromptTag (Free f r)
data Free f r
= Op (f (Free f r))
 Pure r
Using catch
, we can implement try
.
try :: (Exception e % Either e a > Mom a) > Mom (Either e a)
try f = catch (\tag > Right <$> f tag) (\e > pure (Left e))
The explicit tags serve as a form of capabilities, handles that functions
take as explicit arguments, granting the permission to use the associated
effects. This partly makes up for the lack of effect typing.
It’s not watertight: you can easily capture the tag to call throw
outside of
try
/catch
. But from a nonadversarial perspective, this mechanism may
prevent quite a few mistakes.
testThrow :: IO ()
testThrow = do
assert (isRight' (run (try (\_ > pure "Result"))))
assert (isLeft' (run (try (\exc > throw exc "Error"))))
where
isRight' = maybe False isRight
isLeft' = maybe False isLeft
 Minimalistic unit testing framework
assert :: HasCallStack => Bool > IO ()
assert True = pure ()
assert False = error "Assertion failed"
Algebraic effects are also known as “resumable exceptions”, extending exceptions with the ability to continue the computation right where the exception was thrown.
The next simplest effect after exceptions is to produce some output.
Like Throw
, we represent the Output
operation as a constructor,
containing the value to output, and now also a continuation.
data Out o a
= Output o (Mom () > Mom a)
The output
wrapper is similar to throw
, additionally storing the
continuation in the Output
constructor.
The expected argument of the continuation continue
is a computation which is
to replace the operation call.
When we call output o :: Mom ()
, that call “bubbles
up” like an exception, gets caught by a handler, and the call gets replaced by
pure ()
or some other Mom ()
computation.
output :: Out o % r > o > Mom ()
output tag o = control0 tag \continue > pure (Op (Output o continue))
A synonym specialized to strings.
log :: Out String % r > String > Mom ()
log = output
An infinite output stream of the Fibonacci sequence.
fibonacci :: Out Int % r > Mom a
fibonacci out = fib 0 1
where
fib !a !b = do
output out a
fib b (a + b)
Run a computation lazily and collect its output in a list.
collect :: (Out o % () > Mom ()) > [o]
collect f = runList do
tag < newPromptTag
handle tag (Pure <$> f tag)
where
handle tag action = do
next < prompt tag action
case next of
Op (Output o continue) >
pure (o : runList (handle tag (continue (pure ()))))
Pure () > pure []
runList = fromMaybe [] . run
testFibonacci :: IO ()
testFibonacci =
assert (take 8 (collect fibonacci)
== [0, 1, 1, 2, 3, 5, 8, 13])
The big selling point of algebraic effects is that effects can be
combined smoothly. We can thus use log
to trace the
execution flow of a program using throw
and catch
without further ceremony.
This looks like your usual monadic program. The point is that everything lives
in the same monad Mom
(which is operationally equal to IO
),
so you do not have to worry about “lifting” or “unlifting” anything through a
transformer: the semantics of (>>=)
do not change with every new effect, and
there isn’t the problem that “lifting” catch
and other operations that are
actually handlers is counterintuitive for many transformers, if possible at all.
To be fair, there remain
difficulties in this area even with
algebraic effects.
tracedCatch :: Out String % r > Mom Bool
tracedCatch out = catch this onThrow
where
this exc = do
log out "Start"
_ < throw exc "Boom"
log out "This is unreachable"
pure False
onThrow msg = do
log out ("Error: " ++ msg)
pure True
testTracedCatch :: IO ()
testTracedCatch =
assert (collect (void . tracedCatch) ==
"Start"
[ "Error: Boom" ]) ,
There can also be different ways of handling an effect. The following handler discards output instead of collecting it, for example to ignore debugging logs.
discardOutput :: (Out o % a > Mom a) > Mom a
discardOutput f = do
tag < newPromptTag
handle tag (Pure <$> f tag)
where
handle tag action = do
next < prompt tag action
case next of
Op (Output _o continue) > handle tag (continue (pure ()))
Pure a > pure a
testDiscard :: IO ()
testDiscard =
assert (run (discardOutput tracedCatch) == Just True)
Dually, there is an effect to request some input.
data In i a
= Input (Mom i > Mom a)
The input
call is expected to return a result i
. As before, the type of the
input _
operation must coincide with the domain Mom i
of the continuation.
input :: In i % r > Mom i
input tag = control0 tag \continue > pure (Op (Input continue))
Output the cumulative sum of an input stream.
Like fibonacci
, this is an infinite loop in IO
.
It gets broken by control0
in input
.
Until now, an infinite loop in IO
would either have to be broken by an
exception (which makes it not actually infinite), or have to involve
concurrency.
csum :: In Int % r > Out Int % r > Mom a
csum inp out = go 0
where
go !acc = do
n < input inp
let acc' = acc + n
output out acc'
go acc'
Supply a list of inputs and stop when we run out.
listInput :: [i] > (In i % a > Mom a) > Mom (Maybe a)
listInput is f = do
tag < newPromptTag
catch (\exc > handle exc tag is (Pure <$> f tag))
> pure Nothing)
(\() where
handle exc tag is action = do
next < prompt tag action
case next of
Op (Input continue)
 i : is' < is > handle exc tag is' (continue (pure i))
 otherwise > handle exc tag [] (continue (throw exc ()))
Pure a > pure (Just a)
testCsum :: IO ()
testCsum =
assert ((collect \out >
void $ listInput [1 .. 5] \inp >
csum inp out
== [1, 3, 6, 10, 15]) )
The input and output effect can be combined in a streaming fashion, alternating execution between the consumer and the producer.
Feed the output of one computation into the input of the other. Terminate whenever one side terminates, discarding the other.
connect :: (Out x % a > Mom a) > (In x % a > Mom a) > Mom a
connect producer consumer = do
out < newPromptTag
inp < newPromptTag
handleI out inp (Pure <$> producer out) (Pure <$> consumer inp)
where
handleI out inp produce consume = do
next < prompt inp consume
case next of
Op (Input continue) > handleO out inp produce continue
Pure a > pure a
handleO out inp produce consuming = do
next < prompt out produce
case next of
Op (Output o continue) >
handleI out inp (continue (pure ())) (consuming (pure o))
Pure a > pure a
Connect two copies of the cumulative sum process: compute the cumulative sum of the cumulative sum.
csum2 :: In Int % () > Out Int % () > Mom ()
csum2 inp out = connect (\out' > csum inp out') (\inp' > csum inp' out)
testConnect :: IO ()
testConnect =
assert ((collect \out >
void $ listInput [1 .. 5] \inp >
csum2 inp out
== [1, 4, 10, 20, 35]) )
What sets IO
apart from ST
and Mom
is that it can change the world.
We can define handlers to send output and receive input from the real world.
The result of these handlers must be in IO
.
Text output can be printed to stdout
.
printOutput :: (Out String % () > Mom ()) > IO ()
printOutput f = momToIO do
tag < newPromptTag
handle tag (Pure <$> f tag)
where
handle tag action = do
next < prompt tag action
case next of
Op (Output o continue) > pure do
putStrLn o
momToIO (handle tag (continue (pure ())))
Pure () > pure (pure ())
momToIO = fromMaybe (pure ()) . run
We can forward input from stdin
into a
consumer computation.
readInput :: (In String % () > Mom ()) > IO ()
readInput f = momToIO do
tag < newPromptTag
handle tag (Pure <$> f tag)
where
handle tag action = do
next < prompt tag action
case next of
Op (Input continue) > pure do
i < getLine
momToIO (handle tag (continue (pure i)))
Pure () > pure (pure ())
momToIO = fromMaybe (pure ()) . run
A drawback of this implementation is that for a computation that features both
input and output, these handlers are awkward to compose.
We can coerce IO
to Mom
so readInput
can be composed with printOutput
,
but that is a hacky solution that makes the type Mom
a lie (it’s not supposed
to have side effects). A better solution may be to combine effects before
interpreting them in IO
all at once.
No effect tutorial would be complete without the state effect.
data State s a
= Get (Mom s > Mom a)
 Put s (Mom () > Mom a)
get :: State s % r > Mom s
get tag = control0 tag \continue > pure (Op (Get continue))
put :: State s % r > s > Mom ()
put tag s = control0 tag \continue > pure (Op (Put s continue))
Statepassing, no mutation.
runState :: s > (State s % a > Mom a) > Mom (s, a)
runState s0 f = do
tag < newPromptTag
handle tag s0 (Pure <$> f tag)
where
handle tag s action = do
next < prompt tag action
case next of
Op (Get continue) > handle tag s (continue (pure s))
Op (Put s' continue) > handle tag s' (continue (pure ()))
Pure a > pure (s, a)
incr :: State Int % r > Mom ()
incr st = do
n < get st
put st (n + 1)
Again, combining state with logging is effortless, because effects live in the same underlying monad.
logState :: Out String % r > State Int % s > Mom ()
logState out st = do
n < get st
log out (show n)
incr2 :: Out String % r > State Int % s > Mom ()
incr2 out st = do
incr st
logState out st
incr st
logState out st
testState :: IO ()
testState = do
assert ((collect \out > runState 0 (incr2 out) *> pure ()) == ["1", "2"])
assert (run (discardOutput \out > runState 0 (incr2 out)) == Just (2, ()))
The examples above are quite sequential in nature.
Mom
can also replace the list monad.
Choose one element in a list.
data Nondet a where
Choose :: [x] > (Mom x > Mom a) > Nondet a
choose :: Nondet % r > [x] > Mom x
choose tag xs = control0 tag \continue > pure (Op (Choose xs continue))
nameTheorems :: Nondet % r > Mom String
nameTheorems nd = do
name1 < choose nd ["Church", "Curry"]
name2 < choose nd ["Turing", "Howard"]
result < choose nd ["thesis", "isomorphism"]
pure (name1 ++ "" ++ name2 ++ " " ++ result)
Use the output effect to stream all results of a nondeterministic computation. Here, the continuation is not used linearly: it is called once for every element in the given list.
enumerate :: (Nondet % a > Mom a) > Out a % r > Mom ()
enumerate f out = do
tag < newPromptTag
handle tag (Pure <$> f tag)
where
handle tag action = do
next < prompt tag action
case next of
Op (Choose xs continue) > for_ xs (handle tag . continue . pure)
Pure a > output out a
testEnumerate :: IO ()
testEnumerate = do
assert (collect (enumerate nameTheorems) ==
"ChurchTuring thesis"
[ "ChurchTuring isomorphism"
, "ChurchHoward thesis"
, "ChurchHoward isomorphism"
, "CurryTuring thesis"
, "CurryTuring isomorphism"
, "CurryHoward thesis"
, "CurryHoward isomorphism"
, ])
Earlier, the streaming handler connect
interleaved execution of one consumer
and one producer thread. Here is a cooperative concurrency effect that lets us
dynamically fork any number of threads and interleave them.
data Conc a
= Fork (Mom ()) (Mom () > Mom a)
 Yield (Mom () > Mom a)
Fork a thread to run the given computation.
fork :: Conc % r > Mom () > Mom ()
fork tag thread = control0 tag \continue > pure (Op (Fork thread continue))
Cooperative concurrency: threads must yield explicitly.
yield :: Conc % r > Mom ()
yield tag = control0 tag \continue > pure (Op (Yield continue))
A thread that repeats an output value three times.
simpleThread :: Out String % r > Conc % s > Int > Mom ()
simpleThread out conc n = do
log out (show n)
yield conc
log out (show n)
yield conc
log out (show n)
yield conc
Interleave 111
, 222
, 333
.
interleave123 :: Out String % r > Conc % s > Mom ()
interleave123 out conc = do
fork conc (simpleThread out conc 1)
fork conc (simpleThread out conc 2)
fork conc (simpleThread out conc 3)
A roundrobin scheduler. handle
keeps track of a queue of threads.
It runs the first thread until the next event. If the thread yields,
its continuation is pushed to the end of the queue. If the thread
forks another thread, the forked thread is pushed to the end of the queue,
and we continue in the main thread (forking does not yield).
If the thread terminates, we remove it from the queue.
runConc :: (Conc % () > Mom ()) > Mom ()
runConc f = do
tag < newPromptTag
handle tag [Pure <$> f tag]
where
handle tag [] = pure ()
handle tag (thread : threads) = do
next < prompt tag thread
case next of
Op (Yield continue) > handle tag (threads ++ [continue (pure ())])
Op (Fork th continue) > handle tag (continue (pure ()) : threads ++ [Pure <$> th])
Pure () > handle tag threads
testInterleave :: IO ()
testInterleave =
assert ((collect \out > runConc \conc > interleave123 out conc)
== ["1", "2", "3", "1", "2", "3", "1", "2", "3"])
Primitive delimited continuation in Haskell give us the power to jump around the stack to implement many kinds of effects. Under the hood, those operations live in the IO monad, grounding effectful code in a familiar execution model.
For those new to the topic, I hope that these examples may serve as a good starting point to experiment with delimited continuations and algebraic effects in Haskell.
The system implemented here is as rudimentary as it gets. To define new effects and handlers, we use the new primitives directly, which is dangerous. This was deliberate to provide material to familiarize oneself with those primitives. Moreover, on the one hand, a type system to keep track of the scope of delimited continuations is a nontrivial ask. On the other hand, the examples here all follow a regular structure, so there is probably a way to encapsulate the primitives, trading off some expressiveness for a safe interface to define new effects and handlers.
Named handlers—via prompt tags—occupy an interesting spot in the scale of safety guarantees. It is imperfect, even very easy to circumvent. But if you’re not working against it, it is still a neat way to prevent simple mistakes. This system can be reinforced further using rank2 polymorphism, a technique described in:
Interestingly, prompt tags were not part of the original proposal, and they are not used by eff, the effect system which gave rise to Alexis King’s GHC proposal. Prompt tags were added during the feedback process to make the primitives typesafe by default.
Now is an exciting time for algebraic effects/delimited continuations, as they are making their way into industrial languages: Haskell, OCaml, WebAssembly.
main :: IO ()
main = do
testThrow
testFibonacci
testTracedCatch
testDiscard
testCsum
testConnect
testState
testEnumerate
testInterleave
putStrLn "All tests passed!"
QuantifiedConstraints
is an extension from GHC 8.6 that lets us
use forall
in constraints.
It lets us express constraints for instances of higherkinded types like Fix
:
newtype Fix f = Fix (f (Fix f))
deriving instance (forall a. Eq a => Eq (f a)) => Eq (Fix f)
Other solutions existed previously, but they’re less elegant:
deriving instance Eq (f (Fix f)) => Eq (Fix f)
instance Eq1 f => Eq (Fix f) where ...
It also lets us say that a monad transformer indeed transforms monads:
class (forall m. Monad m => Monad (t m)) => MonadTrans t where
lift :: m a > t m a
(Examples lifted from the GHC User Guide on QuantifiedConstraints
, section Motivation.)
One restriction is that the conclusion of a quantified constraint cannot mention a type family.
type family F a
 (forall a. C (F a))  Illegal type family application in a quantified constraint
A quantified constraint can be thought of as providing a local instance, and they are subject to a similar restriction on the shape of instance heads so that instance resolution may try to match required constraints with the head of existing instances.
Type families are not matchable: we cannot determine whether an applied
type family F a
matches a type constructor T
in a manner satisfying the
properties required by instance resolution (“coherence”). So type families
can’t be in the conclusion of a type family.
To legalize type families in quantified constraints, all we need is a class synonym:
class C (F a) => CF a
instance C (F a) => CF a
That CF a
is equivalent to C (F a)
, and forall a. CF a
is legal.
Since GHC 9.2, Step 1 alone solves the problem. It Just Works™. And I don’t know why.
Before that, for GHC 9.0 and prior, we also needed to hold the compiler’s hand and tell it how to instantiate the quantified constraint.
Indeed, now functions may have constraints of the form forall a. CF a
,
which should imply C (F x)
for any x
.
Although CF
and C (F x)
are logically related, when C (F x)
is required,
that triggers a search for instances of the class C
, and not the CF
which
is provided by the quantified constraint.
The search would fail unless some hint is provided to the compiler.
When you require a constraint C (F x)
, insert a type annotation mentioning
the CF x
constraint (using the CF
class instead of C
).
_ { C (F x) available here } :: CF x => _
Inside the annotation (to the left of ::
), we are given CF x
, from which C (F x)
is inferred as a superclass. Outside the annotation, we are requiring CF x
,
which is trivially solved by the quantified constraint forall a. CF a
.
 Mixing quantified constraints with type families 
class C a
type family F a
 forall a. C (F a)  Nope.
class C (F a) => CF a  Class synonym
instance C (F a) => CF a
 forall a. CF a  Yup.
 Some provided function we want to call.
f :: C (F t) => t
 A function we want to implement using f.
g :: (forall a. CF a) => t
g = f  OK on GHC >= 9.2
g = f :: CF t => t  Annotation needed on GHC <= 9.0
The part of that type annotation that really matters is the constraint. The rest of the type to the right of the arrow is redundant. Another way to write only the constraint uses the following identity function with a fancy type:
with :: forall c r. (c => r) > (c => r)
with x = x
So you can supply the hint like this instead:
g :: forall t. (forall a. CF a) => t
g = with @(CF t) f
What do I need that trick for? It comes up in generic metaprogramming.
Imagine deriving Functor
for Generic
types (no Generic1
, which is not as
general as you might hope). One way is to implement the following class on
generic representations:
class RepFmap a a' rep rep' where
repFmap :: (a > a') > rep > rep'
A type constructor f :: Type > Type
will be a Functor
when its
generic representation (Rep
) implements RepFmap a a'
…
for all a
, a'
.
 Class synonym for generically derivable functors
class (forall a. Generic (f a), forall a a'. RepFmap a a' (Rep (f a) ()) (Rep (f a') ())) => GFunctor f
instance ...  idem (class synonym)
 Wait a second...
But that is illegal, because the type family Rep
occurs in the conclusion of
a quantified constraint.
Time for the trick! We give a new name to the conclusion:
class RepFmap a a' (Rep (f a) ()) (Rep (f a') ()) => RepFmapRep a a' f
instance ...  idem (class synonym)
And we can use it in a quantified constraint:
 Now this works!
class (forall a. Generic (f a), forall a a'. RepFmapRep a a' f) => GFunctor f
instance ...  idem (class synonym)
To obtain the final generic implementation of fmap
, we wrap repFmap
between to
and from
.
gfmap :: forall f a a'. GFunctor f => (a > a') > f a > f a'
gfmap f =
with @(RepFmapRep a a' f)  Handholding for GHC <= 9.0
to @_ @() . repFmap f . from @_ @()) (
Et voilà.
If you’ve followed all of that, there’s one other way you might try defining
gfmap
without QuantifiedConstraints
, by just listing the three constraints
actually needed in the body of the function.
 Dangerous gfmap!
gfmap ::
Generic (f a) =>
Generic (f a') =>
RepFmap a a' (Rep (f a) ()) (Rep (f a') ()) =>
a > a') > f a > f a'
(gfmap f = to @_ @() . repFmap f . from @_ @()
This is okay as long as it is only ever used to implement fmap
as in:
fmap = gfmap
Any other use voids a guarantee you didn’t know you expected.
The thing I haven’t told you is that RepFmap
is implemented with…
incoherent instances!^{1} In fact, this gfmap
may behave differently
depending on how it is instantiated at compile time.
For example, for a functor with a field of constant type:
data T a b = C Int a b
deriving Generic
gfmap @(T a) @b @b'
where a
, b
and b'
are distinct type variables
behaves like fmap
should. But gfmap @(T Int) @Int @Int
will unexpectedly apply its argument function to every field.
They all have type Int
, so a function Int > Int
can and will be applied to
all fields.
I could demonstrate this if I had implemented RepFmap
…
Luckily, there is a more general version of this “dangerous gfmap
” readily
available in my library
genericfunctor.
It can be very incoherent, but if you follow some rules, it can also be very
fun to use.
gsolomap
^{2} is a function from genericfunctor that can implement
fmap
, and much more.
fmapT :: (b > b') > T a b > T a b'
fmapT = gsolomap
Map over the first parameter if you prefer:
firstT :: (a > a') > T a b > T a' b
firstT = gsolomap
Or map over both type parameters at once:
bothT :: (a > a') > T a a > T a' a'
bothT = gsolomap
I don’t know what to call this, but gsolomap
also does what you might guess
from this type:
watT ::
a > a') >
(T (a , a ) ((a > a') > Maybe a ) >
T (a', a') ((a' > a ) > Maybe a')
watT = gsolomap
It’s important to specialize gsolomap
with distinct type variables
(a
and a'
).
You cannot refactor code by inlining a function if its body uses gsolomap
,
as it risks breaking that requirement.
For an example of surprising result caused by incoherence, apply the fmapT
defined above to some concrete arguments. See how the result changes then you
replace fmapT
with its definition, gsolomap
.
fmapT ((+1) :: Int > Int) (C 0 0 0) == C 0 0 1 :: T Int Int
gsolomap ((+1) :: Int > Int) (C 0 0 0) == C 1 1 1 :: T Int Int  Noooooo...
(Gist of those gsolomap
(counter)examples)
This is why gfmap
’s signature should use quantified constraints:
this guarantees that when the RepFmap
constraint is solved,
the first two parameters are going to be distinct type variables,
thanks to the universal quantification (forall a a'
).
Thus, incoherence is hidden away.
Following that recipe, genericfunctor contains safe implementations of
Functor
, Foldable
, Traversable
, Bifunctor
, and Bitraversable
.
In particular, the type of gfmap
guarantees that it has a unique
inhabitant satisfying gfmap id = id
, and this property is quite
straightforward to check by visual inspection of the implementation.
After all, gfmap
will essentially do one of three things:
(1) it will be id
on types that don’t mention the type parameters
in its function argument a > a'
, (2) it will apply the provided function
f
, or (3) it will fmap
(or bimap
, or dimap
) itself through a type
constructor. In all cases (with some inductive reasoning for (3)),
if f = id
, then gfmap f = id
.
gfmap f = id
gfmap f = f
gfmap f = fmap (gfmap f)
The dangerous gfmap
(without QuantifiedConstraints
) or gsolomap
fail this
property, because the extra occurrences of a
and a'
in its constraint make
their signatures have a different “shape” from fmap
.
The tradeoff is that those safe functions can’t do the same crazy things
as gsolomap
above.
Combining my two favorite topics, I’ve always wanted to mechanize combinatorics in Coq.^{2} An immediate challenge is to formalize the idea of “set”.^{3} We have to be able to define the set of things we want to count. It turns out that there are at least two ways of encoding sets in type theory: sets as types, and sets as predicates. They are suitable for defining different classes of operations: sums (disjoint union) are a natural operation on types, while unions and intersections are naturally defined on predicates.
The interplay between these two notions of sets, and finiteness, will then let us prove the standard formula for the cardinality of unions, aka. the binary inclusionexclusion formula:
#X ∪ Y = #X + #Y  #X ∩ Y
From Coq Require Import ssreflect ssrbool.
Set Implicit Arguments.
The obvious starting point is to view a type as the set of its inhabitants.
How do we count its inhabitants?
We will say that a set A
has cardinality n
if there is a bijection between
A
and the set {0 .. n1}
of natural numbers between 0
and n1
.
A bijection is a standard way to represent a onetoone correspondence
between two sets, with a pair of inverse functions.
We define the type bijection A B
as a record containing the two functions
and a proof of their inverse relationship.
Record is_bijection {A B} (to : A > B) (from : B > A) : Prop :=
{ from_to : forall a, from (to a) = a
; to_from : forall b, to (from b) = b }.
Record bijection (A B : Type) : Type :=
{ bij_to : A > B
; bij_from : B > A
; bij_is_bijection :> is_bijection bij_to bij_from }.
Infix "<>" := bijection (at level 90) : type_scope.
We say that A
and B
are isomorphic when there exists a bijection between
A
and B
. Isomorphism is an equivalence relation: reflexive, symmetric,
transitive.^{4}
Definition bijection_refl {A} : A <> A.
Admitted. (* Easy exercise *)
Definition bijection_sym {A B} : (A <> B) > (B <> A).
Admitted. (* Easy exercise *)
Definition bijection_trans {A B C} : (A <> B) > (B <> C) > (A <> C).
Admitted. (* Easy exercise *)
Infix ">>>" := bijection_trans (at level 40).
Our “bijective” definition of cardinality shall rely on a primitive,
canonical family of finite types {0 .. n1}
that is taken for granted.
We can define them as the following sigma type, using the familiar set
comprehension notation, also known as ordinal
in mathcomp:
Definition fin (n : nat) : Type := { p  p < n }.
An inhabitant of fin n
is a pair of a p : nat
and
a proof object of p < n
. Such proofs objects are unique for a given
p
and n
, so the first component uniquely determines the second component,
and fin n
does have exactly n
inhabitants.^{5}
We can now say that a type A
has cardinality n
if there is a bijection
between A
and fin n
, i.e., there is an inhabitant of A <> fin n
.
Note that this only defines finite cardinalities, which is fine for doing
finite combinatorics. Infinity is really weird so let’s not think about it.
As a sanity check, you can verify the cardinalities of the usual suspects,
bool
, unit
, and Empty_set
.
Definition bijection_bool : bool <> fin 2.
Admitted. (* Easy exercise *)
Definition bijection_unit : unit <> fin 1.
Admitted. (* Easy exercise *)
Definition bijection_Empty_set : Empty_set <> fin 0.
Admitted. (* Easy exercise *)
A type A
is finite when it has some cardinality n : nat
.
When speaking informally, it’s common to view finiteness as a property,
a thing that a set either is or is not. To prove finiteness
is merely to exhibit the relevant data: a number to be the cardinality,
and an associated bijection (which we call an enumeration of A
,
enum
for short).
Hence we formalize “finiteness” as the type of that data.
Record is_finite (A : Type) : Type :=
{ card : nat
; enum : A <> fin card }.
Further bundling is_finite A
proofs with their associated set A
, we obtain
a concept aptly named “finite type”.^{6} A finite type is a type A
paired with
a proof of is_finite A
.
Record finite_type : Type :=
{ ft_type :> Type
; ft_is_finite :> is_finite ft_type }.
We leverage coercions (indicated by :>
) to lighten the notation of
expressions involving finite_type
.
The first coercion ft_type
lets us use a finite_type
as a Type
.
So if E : finite_type
, we can write the judgement that
“e
is an element of E
” as e : E
, which implicitly expands to
the more cumbersome e : ft_type E
.
Similarly, the second coercion ft_is_finite
lets us access
the evidence of finiteness without naming that field. In particular,
we can write the cardinality of E : finite_type
as card E
,
as if card
were a proper field of E
rather than the nested record it
actually belongs to. This is a convenient mechanism for overloading,
letting us reuse the name card
(inality) even though records technically
cannot have fields with the same name.
With that, we define #A
as sugar for card A
:
Notation "'#' A ''" := (card A).
Declare Scope fintype_scope.
Delimit Scope fintype_scope with fintype.
Bind Scope fintype_scope with finite_type.
The phrase “cardinality of a set” suggests that cardinality is an inherent property of sets. But now we’ve defined “finite type” essentially as a tuple where the cardinality is just one component. What’s to prevent us from putting a different number there, for the same underlying type?
We can prove that this cannot happen. Cardinality is unique: any two finiteness proofs for the same type must yield the same cardinality.
(The proof is a little tedious and technical.)
Theorem card_unique {A} (F1 F2 : is_finite A) : card F1 = card F2.
Admitted. (* Intermediate exercise *)
A slightly more general result is that isomorphic types (i.e., related by
a bijection) have the same cardinality. It can first be proved
in terms of is_finite
, from which a corollary in terms of finite_type
follows.
Theorem card_bijection {A B} (FA : is_finite A) (FB : is_finite B)
: (A <> B) > card FA = card FB.
Admitted. (* Like card_unique *)
Theorem card_bijection_finite_type {A B : finite_type}
: (A <> B) > #A = #B.
Proof.
apply card_bijection.
Qed.
The converse is also true and useful: two types with the same cardinality are isomorphic.
Theorem bijection_card {A B} (FA : is_finite A) (FB : is_finite B)
: card FA = card FB > (A <> B).
Admitted. (* Easy exercise *)
Theorem bijection_card_finite_type {A B : finite_type}
: #A = #B > (A <> B).
Proof.
apply bijection_card.
Qed.
The sum of sets is also known as the disjoint union.
Inductive sum (A B : Type) : Type :=
 inl : A > A + B
 inr : B > A + B
where "A + B" := (sum A B) : type_scope.
sum
is a binary operation on types. We must work to
make it an operation on finite types.
There is a bijection between fin n + fin m
(sum of sets)
and fin (n + m)
(sum of nats).
Definition bijection_sum_fin {n m} : fin n + fin m <> fin (n + m).
Admitted. (* Intermediate exercise *)
The sum is a bifunctor.
Definition bijection_sum {A A' B B'}
: (A <> B) > (A' <> B') > (A + A' <> B + B').
Admitted. (* Easy exercise *)
Combining those facts, we can prove that the sum of two finite sets is finite (finite_sum
),
and the cardinality of the sum is the sum of the cardinalities (card_sum
).
Definition is_finite_sum {A B} (FA : is_finite A) (FB : is_finite B)
: is_finite (A + B) :=
{ card := #FA + #FB
; enum := bijection_sum (enum FA) (enum FB) >>> bijection_sum_fin }.
Definition finite_sum (A B : finite_type) : finite_type :=
{ ft_type := A + B ; ft_is_finite := is_finite_sum A B }.
Infix "+" := finite_sum : fintype_scope.
Theorem card_sum {A B : finite_type} : #(A + B)%fintype = #A + #B.
Proof.
reflexivity.
Qed.
The cartesian product has structure dual to the sum.
Inductive prod (A B : Type) : Type :=
 pair : A > B > A * B
where "A * B" := (prod A B) : type_scope.
fin n * fin m <> fin (n * m)
.Definition bijection_prod_fin {n m} : fin n * fin m <> fin (n * m).
Admitted. (* Intermediate exercise *)
Definition bijection_prod {A A' B B'}
: (A <> B) > (A' <> B') > (A * A' <> B * B').
Admitted. (* Easy exercise *)
Definition is_finite_prod {A B} (FA : is_finite A) (FB : is_finite B)
: is_finite (A * B) :=
{ card := #FA * #FB
; enum := bijection_prod (enum FA) (enum FB) >>> bijection_prod_fin }.
Definition finite_prod (A B : finite_type) : finite_type :=
{ ft_type := A * B ; ft_is_finite := is_finite_prod A B }.
Infix "*" := finite_prod : fintype_scope.
Theorem card_prod {A B : finite_type} : #(A * B)%fintype = #A * #B.
Proof.
reflexivity.
Qed.
Two other common operations on sets are union and intersection.
However, those operations don’t fit in the view of sets as types.
While set membership x ∈ X
is a proposition, type inhabitation x : X
is
a judgement, which is a completely different thing,^{7} so we need a different
approach.
The idea of set membership x ∈ X
as a proposition presumes that x
and X
are entities that exist independently of each other. This suggests
that there is some “universe” that elements x
live in, and the
sets X
under consideration are subsets of that same universe.
We represent the universe by a type A
, and sets (i.e., “subsets of the universe”)
by predicates on A
.
Definition set_of (A : Type) := (A > bool).
Hence, if x : A
is an element of the universe, and X : set A
is a set
(subset of the universe), we will denote set membership x ∈ X
simply as X x
(x
satisfies the predicate X
).
Those predicates are boolean, i.e., decidable. This is necessary in several
constructions and proofs here, notably to prove that the union or intersection
of finite sets is finite. We rely on a coercion to implicitly convert booleans
to Prop
: is_true : bool >> Prop
, which is exported by ssreflect
.
Those common set operations correspond to the usual logical connectives.
Section Operations.
Context {A : Type}.
Definition union' (X Y : set_of A) : set_of A := fun a => X a  Y a.
Definition intersection' (X Y : set_of A) : set_of A := fun a => X a && Y a.
Definition complement' (X : set_of A) : set_of A := fun a => negb (X a).
End Operations.
Define the familiar infix notation for union and intersection.
Declare Scope set_of_scope.
Delimit Scope set_of_scope with set_of.
Bind Scope set_of_scope with set_of.
Infix "∪" := union' (at level 40) : set_of_scope.
Infix "∩" := intersection' (at level 40) : set_of_scope.
Again, we will characterize finite sets using bijections to fin n
.
We first transform the set X
into a type to_type X
, so we can form
the type of bijections to_type X <> fin n
. Like fin
, we define
to_type A
as a sigma type. Thanks to the predicate X
being boolean,
there is at most one proof p : X a
for each a
, so the type
{ a : A  X a }
has exactly one inhabitant for each inhabitant a : A
satisfying X a
.
Definition to_type {A : Type} (X : set_of A) : Type := { a : A  X a }.
Coercion to_type : set_of >> Sortclass.
We obtain a notion of finite set by imitating the structure of finite_type
.
The setaspredicate X
is finite if the setastype to_type X
is finite.
Record finite_set_of (A : Type) : Type :=
{ elem_of :> set_of A
; fso_is_finite :> is_finite (to_type elem_of)
}.
Similarly, a finite_type_of
can be coerced to a finite_type
.
Definition to_finite_type {A} (X : finite_set_of A) : finite_type :=
{ ft_type := elem_of X
; ft_is_finite := X }.
Coercion to_finite_type : finite_set_of >> finite_type.
We then prove that the union and intersection of finite sets are finite. This is actually fairly challenging, since proving finiteness means to calculate the cardinality of the set and to construct the associated bijection. Unlike sum and product, there is no simple formula for the cardinality of union and intersection. One candidate may seem to be the binary inclusionexclusion formula:
#X ∪ Y = #X + #Y  #X ∩ Y
But that only gives the cardinality of the union in terms of the intersection, or vice versa, and we don’t know either yet.
Rather than constructing the bijections directly, we decompose the proof.
The intuition is that X ∪ Y
and X ∩ Y
can easily be “bounded” by known
finite sets, namely X + Y
and X
respectively. By “bounded”, we mean that
there is an injection from one set to the other.
The standard definition of injectivity is via an implication
f x = f y > x = y
. However, a better definition for our purposes
comes from a onesided inverse property: a function f : A > B
is
a section if there exists another function g : B > A
(called a retraction)
such that g (f x) = x
.
Every section is an injection, but the converse requires the law of excluded
middle.
Record is_section {A B} (to : A > B) (from : B > A) : Prop :=
{ s_from_to : forall a, from (to a) = a }.
Record section (A B : Type) : Type :=
{ s_from : A > B
; s_to : B > A
; s_is_section : is_section s_from s_to }.
The point is that, given a section to a finite set, section A (fin n)
,
we can construct a bijection A <> fin m
for some m
, that is smaller than
n
. We formalize this result with a proofrelevant sigma type.
Definition section_bijection (A : Type) (n : nat)
: section A (fin n) > { m & A <> fin m }.
Admitted. (* Hard exercise *)
This construction is rather involved. It is much more general than when we were looking specifically at union and intersection, but at the same time it is easier to come up with as it abstracts away the distracting details of those operations.
Now there is a section from X ∪ Y
to X + Y
,
and from X ∩ Y
to X
.
Definition section_union {A} (X Y : set_of A)
: section (X ∪ Y)%set_of (X + Y).
Admitted. (* Easy exercise *)
Definition section_intersection {A} (X Y : set_of A)
: section (X ∩ Y)%set_of X.
Admitted. (* Easy exercise *)
We can then rely on the finiteness of X
and X + Y
to extend those
sections to fin n
for some n
via the following theorem:
Theorem section_extend (A B C : Type)
: section A B > (B <> C) > section A C.
Admitted. (* Easy exercise *)
Definition section_union' {A} (X Y : finite_set_of A)
: section (X ∪ Y)%set_of (fin (#X + #Y)).
Proof.
eapply section_extend.
 apply section_union.
 apply is_finite_sum.
Qed.
Definition section_intersection' {A} (X Y : finite_set_of A)
: section (X ∩ Y)%set_of (fin #X).
Proof.
eapply section_extend.
 apply section_intersection.
 apply enum.
Qed.
Finally, by section_bijection
, we obtain finiteness proofs of union'
and
intersection'
, which let us define union
and intersection
properly as operations
on finite sets.
Theorem is_finite_union {A} {X Y : set_of A}
(FX : is_finite X) (FY : is_finite Y)
: is_finite (X ∪ Y)%set_of.
Proof.
refine { enum := projT2 (section_bijection _) }.
eapply (section_extend (B := X + Y)%type).
 apply section_union.
 apply (is_finite_sum FX FY).
Qed.
Theorem is_finite_intersection {A} {X Y : set_of A}
(FX : is_finite X) (FY : is_finite Y)
: is_finite (X ∩ Y)%set_of.
Proof.
refine { enum := projT2 (section_bijection _) }.
eapply section_extend.
 apply section_intersection.
 apply (enum FX).
Qed.
Definition union {A} (X Y : finite_set_of A) : finite_set_of A :=
{ fso_is_finite := is_finite_union X Y }.
Definition intersection {A} (X Y : finite_set_of A) : finite_set_of A :=
{ fso_is_finite := is_finite_intersection X Y }.
Declare Scope fso_scope.
Delimit Scope fso_scope with fso.
Bind Scope fso_scope with finite_set_of.
Infix "∪" := union (at level 40) : fso_scope.
Infix "∩" := intersection (at level 40) : fso_scope.
Hereafter, ∪
and ∩
will denote finite unions and intersections.
#[local] Open Scope fso_scope.
#X ∪ Y = #X + #Y  #X ∩ Y
To prove that formula, it’s probably not a good idea to look at how ∪
and ∩
compute their cardinalities. A better idea is to construct a bijection, which
implies an equality of cardinalities by card_bijection
.
To start, subtractions are bad, so we rewrite the goal:
#X ∪ Y + #X ∩ Y = #X + #Y
Now we look for a bijection (X ∪ Y) + (X ∩ Y) <> X + Y
.
It gets a bit tricky because of the dependent types.
Definition inclusion_exclusion_bijection {A} (X Y : finite_set_of A)
: (X ∪ Y)%set_of + (X ∩ Y)%set_of <> X + Y.
Admitted. (* Hard exercise *)
Isomorphic sets have the same cardinality (by theorem card_bijection_finite_type
).
The resulting equation simplifies to the binary inclusionexclusion identity,
because #A + B
equals #A + #B
definitionally.
So the proof consists simply of applying that theorem with the above bijection.
Theorem inclusion_exclusion {A} (X Y : finite_set_of A)
: #X ∪ Y + #X ∩ Y = #X + #Y.
Proof.
apply (@card_bijection_finite_type ((X ∪ Y) + (X ∩ Y)) (X + Y)).
apply inclusion_exclusion_bijection.
Qed.
To formalize mathematics, it’s often useful to revisit our preconceptions about fundamental concepts. To carry out even basic combinatorics in type theory, it’s useful to distinguish two views of the naive notion of set.
For example, when we say “union”, we really mean one of two things depending on the context. Either the sets are obviously disjoint, so we really mean “sum”: this corresponds to viewing sets as types. Or we implicitly know that the two sets contain the same “type” of elements a priori, so the overlap is something we have to worry about explicitly: this corresponds to viewing sets as predicates on a given universe.
Ironically, when making restaurant reservations, I still occasionally forget to count myself.↩︎
The code from this post is part of this project I’ve started here. Also check out Brent Yorgey’s thesis: Combinatorial Species and Labelled Structures (2014).↩︎
Speaking of sets, it’s important to distinguish naive set theory from axiomatic set theory. Naive set theory is arguably what most people think of when they hear “set”. It is a semiformal system for organizing mathematics: there are sets, they have elements, and there are various operations to construct and analyze sets, but overall we don’t think too hard about what sets are (hence, “semiformal”). When this blog post talks about sets, it is in the context of naive set theory. Axiomatic set theory is formal, with rules that are clear enough to be encoded in a computer. The name “axiomatic set theory” is a stroke of marketing genius, establishing it as the “standard” way of formalizing naive set theory, and thus, all of mathematics, as can be seen in most introductory courses on formal logic. Historically, Zermelo’s set theory was formulated at around the same time as Russell’s type theory, and type theory is at the root of currently very active areas of programming language theory and formal methods.↩︎
Bijections actually form a groupoid (a “proofrelevant equivalence relation”).↩︎
We could also have defined fin
as the inductive type of bounded naturals,
which is named Fin.t
in the standard library. Anecdotal experience suggests
that the sigma type is more beginnerfriendly. But past a certain level
of familiarity, I think they are completely interchangeable.
Inductive fin' : nat > Type :=
 F0 : fin' 1
 FS : forall n, fin' n > fin' (S n).
The definition of fin
as a sigma type relies on details of the definition of
the order relation _ < _
. Other definitions may allow the proposition p < n
to be inhabited by multiple proof objects, causing fin n
to have “more” than
n
inhabitants unless they are collapsed by proof irrelevance.↩︎
mathcomp has a different but equivalent definition of fintype
.↩︎
… if you know what those words mean.↩︎
rewrite
expressions using a relation other
than equality. Some setup is required to ensure that such a proof step is allowed.
One important obligation is to prove Proper
theorems for the various functions
in our library. For example, a theorem like
#[global]
Instance Proper_f : Proper ((==) ==> (==)) f.
unfolds to forall x y, x == y > f x == f y
, meaning that f
preserves some relation (==)
,
so that we can “rewrite x
into y
under f
”. Such a theorem must be registered as an
instance so that the rewrite
tactic can find it via type class search.
Where does the word “proper” come from?
How does Proper ((==) ==> (==)) f
unfold to forall x y, x == y > f x == f y
?
You can certainly unfold the Coq definitions of Proper
and ==>
and voilà,
but it’s probably more fun to tell a proper story.
It’s a story in two parts:
Some of the theorems discussed in this post are formalized in this snippet of Coq.
Partial equivalence relations are equivalence relations that are partial. 🤔
In an equivalence relation, every element is at least related to itself by reflexivity. In a partial equivalence relation, some elements are not related to any element, not even themselves. Formally, we simply drop the reflexivity property: a partial equivalence relation (aka. PER) is a symmetric and transitive relation.
Class PER (R : A > A > Prop) :=
{ PER_symmetry : forall x y, R x y > R y x
; PER_transitivity : forall x y z, R x y > R y z > R x z }.
We may remark that an equivalence relation is technically a “total” partial equivalence relation.
An equivalent way to think about an equivalence relation on a set is as a partition of that set into equivalence classes, such that elements in the same class are related to each other while elements of different classes are unrelated. Similarly, a PER can be thought of as equivalence classes that only partially cover a set: some elements may belong to no equivalence class.
Exercise: define the equivalence classes of a PER; show that they are disjoint.
The equivalence classes of a PER R : A > A > Prop
are sets of the form C x = { y ∈ A  R x y }
.
Given two equivalence classes C x
and C x'
, we show that these sets are
either equal or disjoint. By excluded middle:
Either R x x'
, then R x y > R x' y
by symmetry and transitivity,
so y ∈ C x > y ∈ C x'
, and the converse by the same argument.
Therefore C x = C x'
.
Or ~ R x x'
, then we show that ~ (R x y /\ R x' y)
:
R x y
and R x' y
,R x x'
by symmetry and transitivity,~ R x x'
, contradiction.Hence, ~ (y ∈ C x /\ y ∈ C x')
, therefore C x
and C x'
are disjoint.
(I wouldn’t recommend trying to formalize this in Coq, because equivalence classes are squarely a settheoretic concept. We just learn to talk about things differently in type theory.)
A setoid is a set equipped with an equivalence relation. A partial setoid is a set equipped with a PER.
PERs are useful when we have to work in a set that is “too big”.
A common example is the set of functions on some setoid.
For instance, consider the smallest equivalence relation (≈)
on three elements
{X, X', Y}
such that X ≈ X'
.
Intuitively, we want to think of X
and X'
as “the same”, so that the set
morally looks like a twoelement set.
How many functions {X, X', Y} > {X, X', Y}
are there? If we ignore the
equivalence relation, then there are 3^{3} functions. But if we think
of {X, X', Y}
as a twoelement set by identifying X
and X'
, there should
be 2^{2} functions.
The actual set of functions {X, X', Y} > {X, X', Y}
is “too big”:
it contains some “bad” functions which break the illusion that X
and X'
are the same, for example by mapping X
to X
and X'
to Y
;
(* A bad function *)
bad X = X
bad X' = Y
bad Y = Y
it contains some “duplicate” functions, for example the constant functions
const X
and const X'
should be considered the same since X ≈ X'
.
To tame that set of functions, we equip it with the PER R
where
R f g
if forall x y, x ≈ y > f x ≈ g y
.
Definition R f g : Prop := forall x y, x ≈ y > f x ≈ g y.
That relation R
has the following nice features:
Bad functions are not related to anything: forall f, not (R bad f)
.
Duplicate functions are related to each other: R (const X) (const X')
.
Having defined a suitable PER, we now know to ignore the “bad” unrelated elements and to identify elements related to each other. Those remaining “good” elements are called the proper elements.
A proper element x
of a relation R
is one that is related to itself: R x x
.
This is how the Proper
class is defined in Coq:
(* In the standard library: From Coq Require Import Morphisms *)
Class Proper {A} (R : A > A > Prop) (x : A) : Prop :=
proper_prf : R x x.
Note that properness is a notion defined for any relation, not only PERs. This story could probably be told more generally. But I think PERs make the motivation more concrete, illustrating how relations let us not only relate elements together, but also weed out badly behaved elements via the notion of properness.
The restriction of a relation R
to its proper elements is reflexive.
Hence, if R
is a PER, its restriction is an equivalence relation.
In other words, a PER is really an equivalence relation with an oversized
carrier.
Exercise: check that there are only 4 functions {X, X', Y} > {X, X', Y}
if we ignore the nonproper functions and we equate functions related to each
other by R
.
The equivalence classes are listed in the following table, one per row, with
each subrow giving the mappings of one function for X
, X'
, Y
. There are
4 equivalence classes spanning 15 functions, and 12 “bad” functions that don’t
belong to any equivalence classes.
X X' Y

1 X X X 1
X X X' 2
X X' X 3
X X' X' 4
X' X X 5
X' X X' 6
X' X' X 7
X' X' X' 8

2 X X Y 9
X X' Y 10
X' X Y 11
X' X' Y 12

3 Y Y X 13
Y Y X' 14

4 Y Y Y 15

Bad X Y X 16
X Y X' 17
X' Y X 18
X' Y X' 19
X Y Y 20
X' Y Y 21
Y X X 22
Y X X' 23
Y X' X 24
Y X' X' 25
Y X Y 26
Y X' Y 27
Exercise: given a PER R
, prove that an element is related to itself by R
if and only if it is related to some element.
Theorem Prim_and_Proper {A} (R : A > A > Prop) :
PER R >
forall x, (R x x <> exists y, R x y).
(Solution)
The relation R
defined above for functions {X, X', Y} > {X, X', Y}
is an instance of a general construction. Given two sets D
and C
,
equipped with relations RD : D > D > Prop
and RC : C > C > Prop
(not necessarily equivalences or PERs), two functions f, g : D > C
are respectful if they map related elements to related elements.
Thus, respectfulness is a relation on functions, D > C
, parameterized by
relations on their domain D
and codomain C
:
(* In the standard library: From Coq Require Import Morphisms *)
Definition respectful {D} (RD : D > D > Prop)
{C} (RC : C > C > Prop)
(f g : D > C) : Prop :=
forall x y, RD x y > RC (f x) (g y).
(Source)
The respectfulness relation is also cutely denoted using (==>)
, viewing it as
a binary operator on relations.
Notation "f ==> g" := (respectful f g) (right associativity, at level 55)
: signature_scope.
(Source)
For example, this lets us concisely equip a set of curried functions
E > D > C
with the relation RE ==> RD ==> RC
.
Respectfulness provides a pointfree notation to construct relations on
functions.
(RE ==> RD ==> RC) f g
<>
forall s t x y, RE s t > RD x y > RC (f s x) (g t y)
Respectfulness on D > C
can be defined for any relations on D
and C
.
Two special cases are notable:
If RD
and RC
are PERs, then RD ==> RC
is a PER on D > C
(proof),
so this provides a concise definition of extensional equality on functions
(This was the case in the example above.)
If RD
and RC
are preorders (reflexive, transitive),
then the proper elements of RD ==> RC
are exactly the monotone functions.
Now consider the proper elements of a respectfulness relation. Recalling the earlier definition of properness, it transforms a (binary) relation into a (unary) predicate:
Proper : (A > A > Prop) > (A > Prop)
While we defined respectfulness as a binary relation above, we shall also say
that a single function f
is respectful when it maps related elements to
related elements. The following formulations are equivalent; in fact, they are
all the same proposition by definition:
forall x y, RD x y > RC (f x) (f y)
=
respectful RD RC f f
=
(RD ==> RC) f f
=
Proper (RD ==> RC) f
The properness of a function f
with respect to the respectfulness relation
RD ==> RC
is exactly what we need for rewriting. We can view f
as
a “context” under which we are allowed to rewrite
its arguments along the
domain’s relation RD
, provided that f
itself is surrounded by a context
that allows rewriting along the codomain’s relation RC
.
In a proof, the goal may be some proposition in which f x
occurs, P (f x)
,
then we may rewrite
that goal into P (f y)
using an assumption RD x y
,
provided that Proper (RD ==> RC) f
and Proper (RC ==> iff) P
,
where iff
is logical equivalence, with the infix notation <>
.
Definition iff (P Q : Prop) : Prop := (P > Q) /\ (Q > P).
Notation "P <> Q" := (iff P Q).
Respectful functions compose:
Proper (RD ==> iff) (fun x => P (f x))
=
forall x y, RD x y > P (f x) <> P (f y)
And that, my friends, is the story of how the concept of “properness” relates to the proof technique of generalized rewriting.
Another general construction of relations on functions is the “pointwise
relation”. It only assumes a relation on the codomain RC : C > C > Prop
.
Two functions f, g : D > C
are related pointwise by RC
if
they map each element to related elements.
(* In the standard library: From Coq Require Import Morphisms *)
(* The domain D is not implicit in the standard library. *)
Definition pointwise_relation {D C} (RC : C > C > Prop)
(f g : D > C) : Prop :=
forall x, RC (f x) (g x).
(* Abbreviation (not in the stdlib) *)
Notation pr := pointwise_relation.
(Source)
This is certainly a simpler definition: pointwise_relation RC
is equivalent to eq ==> RC
, where eq
is the standard intensional equality
relation.
One useful property is that pointwise_relation RC
is an equivalence relation
if RC
is an equivalence relation.
In comparison, we can at most say that RD ==> RC
is a PER if RD
and
RC
are equivalence relations. It is not reflexive as soon as RD
is bigger
than eq
(the smallest equivalence relation) and RC
is smaller than the total
relation fun _ _ => True
.
In Coq, the pointwise_relation
is also used for rewriting under lambda
abstractions. Given a higherorder function f : (E > F) > D
,
we may want to rewrite f (fun z => M z)
to f (fun z => N z)
,
using a relation forall z, RF (M z) (N z)
, where the function bodies M
and/or N
depend on z
so the universal quantification is necessary to bind
z
in the relation. This can be done using the setoid_rewrite
tactic,
after having proved a Proper
theorem featuring pointwise_relation
:
#[global]
Instance Proper_f : Proper (pointwise_relation RF ==> RD) f.
One disadvantage of pointwise_relation
is that it is not compositional.
For instance, it is not preserved by function composition:
Definition compose {E D C} (f : D > C) (g : E > D) : E > C :=
fun x => f (g x).
Theorem not_Proper_compose :
not
(forall {E D C}
(RD : D > D > Prop) (RC : C > C > Prop),
Proper (pr RC ==> pr RD ==> pr RC)
(compose (E := E))).
Instead, at least the first domain of compose
should be quotiented by RD ==> RC
instead:
#[global]
Instance Proper_compose {E D C}
(RD : D > D > Prop) (RC : C > C > Prop) :
Proper ((RD ==> RC) ==> pr RD ==> pr RC)
(compose (E := E)).
We can even use ==>
everywhere for a nicerlooking theorem:
#[global]
Instance Proper_compose' {E D C} (RE : E > E > Prop)
(RD : D > D > Prop) (RC : C > C > Prop) :
Proper ((RD ==> RC) ==> (RE ==> RD) ==> (RE ==> RC))
compose.
Exercise: under what assumptions on relations RD
and RC
do
pointwise_relation RD
and RC ==> RD
coincide on the set of proper elements
of RC ==> RD
?
Theorem pointwise_respectful {D C} (RD : D > D > Prop) (RC : C > C > Prop)
: Reflexive RD > Transitive RC >
forall f g, Proper (RD ==> RC) f > Proper (RD ==> RC) g >
pointwise_relation RC f g <> (RD ==> RC) f g.
(Link to proof)
This table summarizes the above comparison:
pointwise_relation 
respectful (==> ) 


is an equivalence  yes  no 
allows rewriting under binders  yes  no 
respected by function composition  no  yes 
Respectfulness lets us describe relations RD ==> RC
on functions
using a notation that imitates the underlying type D > C
.
More than a cute coincidence, this turns out to be a key component of
Reynolds’s interpretation of types as relations:
==>
is the relational interpretation of the function type constructor >
.
Building upon that interpretation, we obtain free theorems to
harness the power of parametric polymorphism.
Free theorems provide useful properties for all polymorphic functions of
a given type, regardless of their implementation. The canonical example is the
polymorphic identity type ID := forall A, A > A
. A literal reading of that
type is that, well, for every type A
we get a function A > A
. But this
type tells us something more: A
is abstract to the function, it cannot
inspect A
, so the only possible implementation is really the identity
function fun A (x : A) => x
. Free theorems formalize that intuition.
The type ID := forall A, A > A
is interpreted as the following relation
RID
:
Definition RID (f g : forall A, A > A) : Prop :=
forall A (RA : A > A > Prop), (RA ==> RA) (f A) (g A).
where we translated forall A,
to forall A RA,
and A > A
to RA ==> RA
.
The parametricity theorem says that every typed term t : T
denotes a proper element of the corresponding relation RT : T > T > Prop
,
i.e., RT t t
holds. “For all t : T
, RT t t
” is the “free theorem”
for the type T
.
The free theorem for ID
says that any function f : ID
satisfies RID f f
.
Unfold definitions:
RID f f
=
forall A (RA : A > A > Prop) x y, RA x y > RA (f A x) (f A y)
Now let z : A
be an arbitrary element of an arbitrary type,
and let RA := fun x _ => x = z
. Then the free theorem instantiates to
x = z > f A x = z
Equivalently,
f A z = z
that says exactly that f
is extensionally equal to the identity function.
A New Look at Generalized Rewriting in Type Theory, Mathieu Sozeau, JFR 2009
R E S P E C T  Find Out What It Means To The Coq Standard Library, Lucas Silver, PLClub blog 2020
From Coq Require Import Arith Lia.
Set Primitive Projections.
Set Implicit Arguments.
Set Maximal Implicit Insertion.
Set Contextual Implicit.
First, define the type of lists.
Lists are made of Cons
(::
) and Nil
. As it is a recursive type, we
also have to decide whether to make it inductive, so that only finite lists
can be constructed, or coinductive, so that lists might also be infinite
sequences of Cons
. We start by introducing the type’s base functor
ColistF a _
, presenting the two list constructors without recursion.
We obtain the coinductive type Colist a
as a fixed point of
ColistF a : Type > Type
.
Inductive ColistF (a : Type) (x : Type) :=
 Nil : ColistF a x
 Cons : a > x > ColistF a x
.
CoInductive Colist (a : Type) : Type :=
Delay { force : ColistF a (Colist a) }.
Thus the type Colist a
has a destructor
force : Colist a > ColistF a (Colist a)
(the final coalgebra of ColistF a
)
and a constructor Delay : ColistF a (Colist a) > Colist a
.
This ceremony may look all mysterious if you’re new to this; after living with
coinductive types for a while, you will assimilate their philosophy of
“destructors first”—unlike inductive types’ “constructors first”.
Add Printing Constructor Colist.
Declare Scope colist_scope.
Delimit Scope colist_scope with colist.
Local Open Scope colist_scope.
Some familiar notations, []
for Nil
and ::
for Cons
.
Notation "'[' ']'" := Nil : colist_scope.
Notation "x :: xs" := (Cons x xs) : colist_scope.
Recursive definitions involving lists mostly look as you would expect in
Coq as in any functional programming language,
but every output list is wrapped in an explicit Delay
, and every input
list of a match
is wrapped in a force
. It’s as if you were
handling lazy data structures in an eagerly evaluated programming language.
Coq is a pure and total language, so evaluation order doesn’t
matter as much as in partial languages, but the operational semantics
is still careful to not reduce coinductive definitions unless they are
forced.
Here is the map
function that any selfrespecting type of list must provide.
CoFixpoint map {a b} (f : a > b) (xs : Colist a) : Colist b := Delay
match force xs with
 [] => []
 x :: xs => f x :: map f xs
end.
Another example is the list nats
of all natural numbers.
It relies on the more general definition of lists of numbers
greater than an arbitrary natural number n
.
CoFixpoint nats_from (n : nat) : Colist nat := Delay
(n :: nats_from (S n)).
Definition nats := nats_from 0.
Let’s put that aside for now. We will be needing map
and nats
later.
We will now say “infinite lists” in an informal youknowwhatImean sense, as we explore different ways of making it more formal, which will have their own names.
A list is infinite when it never ends with a Nil
. But in constructive mathematics
we never say never—it’s not even obvious how you could even say it in
this instance. A list is infinite when it, and its tails, always evaluate to a Cons
.
A more “incremental” rephrasing of the above is that a list xs
is infinite
when xs
evaluates to a Cons
, and its tail is also infinite. That definition
of infinite lists is recursive, so that you can “unfold” it iteratively to
establish that every tail evaluates to a Cons
. But because it is recursive,
it’s not a priori welldefined.
Let us forget about “is infinite” for a second, and talk more generally about
properties P
that somehow subscribe to that definition: if xs
satisfies
P
, then xs
evaluates to a Cons
, and the tail of xs
satisfies P
. Let
us call such a P
a neverending invariant.
Definition Neverending_invariant {a} (P : Colist a > Prop) : Prop :=
forall xs, P xs > exists x xs', force xs = Cons x xs' /\ P xs'.
The intuition is that if xs
satisfies any neverending invariant P
,
then xs
must be infinite. This leads to our first characterization of
infinite lists, “neverending” lists.
A list is neverending when it satisfies some neverending invariant.
Definition Neverending {a} (xs : Colist a) : Prop :=
exists (P : Colist a > Prop),
Neverending_invariant P /\ P xs.
The key property that makes the notion of neverending lists
useful is the following unfolding lemma:
a neverending list is a Cons
, and its tail is neverending.
Note: you can hover and click on the tactics in proof scripts
(Proof. ... Qed.
) to see the intermediate proof states.^{2}
Lemma unfold_Neverending {a} (xs : Colist a)
: Neverending xs >
exists x xs',
force xs = Cons x xs' /\ Neverending xs'.
Proof.
intros NE.
unfold Neverending in NE.
destruct NE as [P [NE Hxs]].
unfold Neverending_invariant in NE.
apply NE in Hxs.
destruct Hxs as [x [xs' [Hxs Hxs']]].
exists x, xs'.
split; [assumption  ].
unfold Neverending.
exists P.
split; [  assumption ].
exact NE.
Qed.
Doesn’t that lemma’s statement remind you of Neverending_invariant
above?
That lemma means exactly that the property of “being neverending” is itself a neverending invariant!
Lemma Neverending_invariant_Neverending {a}
: Neverending_invariant (Neverending (a := a)).
Proof.
unfold Neverending. (* This goal looks funny > *)
exact (@unfold_Neverending a).
Qed.
The definition of Neverending
makes it the weakest
neverending invariant: all neverending invariants imply Neverending
.
Lemma Neverending_weakest {a} (P : Colist a > Prop) (xs : Colist a)
: Neverending_invariant P > P xs > Neverending xs.
Proof.
intros INV H.
unfold Neverending.
exists P.
split; assumption.
Qed.
This is actually an instance of a pretty general way of defining recursive properties (and recursive types, by CurryHoward) without using recursion. You introduce a class of “invariants” identified by the recursive definition, and then you pick the strongest or weakest one, depending on the situation (inductive or coinductive).^{3}
This next property is sufficient but not necessary: a list must be infinite
if it contains infinitely many distinct elements. While this sounds circular,
we care only about defining “infinite lists”, and for that we can
leverage other “infinities” already lying around, like the natural numbers.
Note that an infinite list may not satisfy that property by repeating the same
finitely many elements (e.g., repeat 0
).
One way to show that a set is infinite is to exhibit an injective function from the natural numbers (or any other infinite set): distinct elements are mapped to distinct elements, or conversely, every image element has a unique antecedent.
Definition injective {a b} (f : a > b) : Prop :=
forall x y, f x = f y > x = y.
Now we need to tie those elements to a list, using the membership relation
In
. That relation is defined inductively: an element x
is in a list xs
if
either x
is the head of xs
or x
is in the tail of the list.
Unset Elimination Schemes. (* Don't generate induction principles for us. *)
Inductive In {a : Type} (x : a) (xs : Colist a) : Prop :=
 In_split y ys : force xs = Cons y ys > x = y \/ In x ys > In x xs
.
Lemma In_ind (a : Type) (x : a) (P : Colist a > Prop)
(H : forall xs (y : a) (ys : Colist a),
force xs = y :: ys > x = y \/ (In x ys /\ P ys) > P xs)
: forall xs, In x xs > P xs.
Proof.
fix SELF 2; intros xs [].
eapply H; eauto.
destruct H1; [ left  right ]; auto.
Qed.
Lemma not_In_Nil {a} (x : a) xs : force xs = [] > In x xs > False.
Proof.
intros ? []; congruence.
Qed.
#[global] Hint Resolve not_In_Nil : core.
Naturally, an element cannot be in an empty list. Two distinct elements cannot be in a list of length one. And so on. So if we can prove that infinitely many elements are in a list, then the list must be infinite. Let us call this property “surnumerable”, since it means that we can enumerate a subset of its elements.
A list xs
is surnumerable if there is some injective function
f : nat > a
such that f i
is in xs
for all i
.
Definition Surnumerable {a} (xs : Colist a) : Prop :=
exists f : nat > a,
injective f /\ forall i, In (f i) xs.
Surnumerable
implies Neverending
A simple approach is to prove that Surnumerable
is a neverending invariant,
but that requires decidable equality on a
.
A more general solution considers the invariant satisfied by lists xs
such that Surnumerable (ys ++ xs)
for some finite ys
.
The pigeonhole reasoning for that proof seems challenging,
so I haven’t done it myself.
Theorem Surnumerable_Neverending {a} (xs : Colist a)
: Surnumerable xs > Neverending xs.
Proof.
(* Exercise for the reader. *)
Abort.
Injectivity is not very “constructive”, you have to use a lot of tricks to
recover useful information from it.
In a proof that surnumerability implies neverendingness,
a big part of it is to prove that surnumerability of a list Cons x xs
implies (more or less) surnumerability of its tail xs
.
In other words, given f
which describes an infinite set of elements in
Cons x xs
, and we must construct a new f2
which describes an infinite
set of elements all in xs
.
The challenge is thus to “remove” the head x
from the given injective
function—if x
occurs at all in f
.
This would be easier if we had a pseudoinverse function to point to its
antecedent by f
. The existence of a pseudoinverse is equivalent
to injectivity classically, but it is stronger constructively.
In category theory, a function f
with a pseudoinverse is called a
split mono(morphism).
Definition splitmono {a b} (f : a > b) : Prop :=
exists g : b > a, forall x, g (f x) = x.
We obtain a variant of Surnumerable
using splitmono
instead of injective
.
Definition SplitSurnumerable {a} (xs : Colist a) : Prop :=
exists (f : nat > a),
splitmono f /\ forall i, In (f i) xs.
The pseudoinverse makes the proof of neverendingness much simpler.
Theorem SplitSurnumerable_Neverending {a} (xs : Colist a)
: SplitSurnumerable xs > Neverending xs.
Proof.
intros PN. unfold SplitSurnumerable in PN.
destruct PN as (f & Hf & Hincl).
unfold Neverending.
(* Here is the neverending invariant. *)
exists (fun xs => exists n, forall i, n <= i > In (f i) xs).
split.
 unfold Neverending_invariant.
intros xs_ [n Hn].
destruct (force xs_) as [  x xs'] eqn:Hforce.
+ exfalso. eauto using not_In_Nil.
+ exists x, xs'; split; [ auto  ].
destruct Hf as [g Hf].
exists (max n (S (g x))).
intros i Hi.
specialize (Hn i (Nat.max_lub_l _ _ _ Hi)).
destruct Hn.
rewrite H in Hforce; inversion Hforce; subst; clear Hforce.
destruct H0.
* exfalso. rewrite < H0 in Hi. rewrite Hf in Hi. lia.
* assumption.
 exists 0. auto.
Qed.
Surnumerability may be easier to prove than neverendingness in some situations. A proof that a list is neverending essentially “walks through” the evaluation of the list, but in certain situations the list might be too abstract to inspect, for example when reasoning by parametricity,^{4} and we can only prove the membership of individual elements one by one.
Our last idea is that infinite lists (with element type a
) are in bijection
with functions nat > a
. So we can show that a list is infinite by proving
that it corresponds to a function nat > a
via such a bijection.
We shall use the obvious bijection that sends f
to map f nats
—and
conversely sends an infinite list xs
to a function index xs : nat > a
.
We will thus say that a list xs
is enumerable if it can be written as
map f nats
for some f
.
Before we can state the equation xs = map f nats
, we must choose a notion of
equality. One can be readily obtained via the following coinductive relation,
which corresponds to the relational interpretation of the type Colist
à la Reynolds.^{5} It interprets the type constructor Colist : Type > Type
as a relation transformer RColist : (a > b > Prop) > (Colist a > Colist b > Prop)
,
which can be specialized to an equivalence relation RColist eq
;
we will write it in infix notation as ==
in the rest of the post.
Inductive RColistF {a b} (r : a > b > Prop) xa xb (rx : xa > xb > Prop)
: ColistF a xa > ColistF b xb > Prop :=
 RNil : RColistF r rx [] []
 RCons x xs y ys : r x y > rx xs ys > RColistF r rx (Cons x xs) (Cons y ys)
.
CoInductive RColist {a b} (r : a > b > Prop) (xs : Colist a) (ys : Colist b) : Prop :=
RDelay { Rforce : RColistF r (RColist r) (force xs) (force ys) }.
Notation "x == y" := (RColist eq x y) (at level 70) : colist_scope.
We can now say formally that xs
is enumerable by f
if xs == map f nats
.
Definition Enumerable_by {a} (f : nat > a) (xs : Colist a) : Prop :=
xs == map f nats.
Definition Enumerable {a} (xs : Colist a) : Prop :=
exists f, Enumerable_by f xs.
As mentioned earlier, the equation xs == map f nats
exercises one half of the
bijection between infinite lists and functions on nat
. Formalizing the other
half takes more work, and it will actually let us prove that Neverending
implies Enumerable
.
Neverending
implies Enumerable
Essentially, we need to define an indexing function index : Colist a > nat > a
.
However, this is only welldefined for infinite lists. A better type
will be a dependent type index : forall (xs : Colist a), Neverending xs > nat > a
,
where the input list xs
must be neverending.
Start with a naive definition having the simpler type, which handles partiality with a default value:
Fixpoint index_def {a} (def : a) (xs : Colist a) (i : nat) : a :=
match force xs, i with
 Cons x _, O => x
 Cons _ xs, S i => index_def def xs i
 Nil, _ => def
end.
Given a neverending list, we are able to extract an arbitrary value as
a default—which will be passed to index_def
but never actually be used.
It takes a bit of dependently typed programming, which we dispatch with
tactics. And since we don’t actually care about the result we can keep
the definition opaque with Qed
(instead of Defined
).
Definition head_NE {a} (xs : Colist a) (NE : Neverending xs) : a.
Proof.
destruct (force xs) as [  x xs' ] eqn:Hxs.
 exfalso. apply unfold_Neverending in NE. destruct NE as [? [? []]]. congruence.
 exact x.
Qed.
Combining index_def
and head_NE
, we obtain our index
function.
Definition index {a} (xs : Colist a) (NE : Neverending xs) (i : nat) : a :=
index_def (head_NE NE) xs i.
The remaining code in this post proves that a neverending list xs
is enumerated by index xs
.
This first easy lemma says that index_def
doesn’t depend on the default value
if the list is neverending.
Lemma index_def_Neverending {a} (def def' : a) (xs : Colist a) (i : nat)
: Neverending xs > index_def def xs i = index_def def' xs i.
Proof.
revert xs; induction i; intros * NE; cbn.
all: apply unfold_Neverending in NE.
all: destruct NE as [x [xs' [Hxs NE]]].
all: rewrite Hxs.
all: auto.
Qed.
The next lemma does the heavy lifting, constructing an “equality invariant”
(or “bisimulation”) that must hold between all respective tails of xs
and
map (index xs) nats
, which then implies ==
.
Note that instead of index xs
, we actually write index NE
where NE
is
a proof of Neverending xs
, since index
requires that argument, and xs
can be deduced from NE
’s type.
Lemma Neverending_Enumerable_ {a} (xs : Colist a) (NE : Neverending xs)
(f : nat > a) (n : nat)
: (forall i, f (n+i) = index NE i) >
xs == map f (nats_from n).
Proof.
revert xs NE n; cofix SELF; intros * Hf.
constructor.
assert (NE' := NE).
apply unfold_Neverending in NE'.
destruct NE' as [x [xs' [Hxs NE']]].
rewrite Hxs; cbn.
constructor.
 specialize (Hf 0).
cbn in Hf. rewrite Nat.add_0_r, Hxs in Hf. auto.
 apply SELF with (NE := NE'); clear SELF.
intros i. specialize (Hf (S i)).
cbn in Hf. rewrite Nat.add_succ_r, Hxs in Hf.
cbn; rewrite Hf. unfold index.
apply index_def_Neverending. auto.
Qed.
Here’s the final result. A neverending list xs
is enumerated by index xs
.
Theorem Neverending_Enumerable_by {a} (xs : Colist a) (NE : Neverending xs)
: Enumerable_by (index NE) xs.
Proof.
unfold Enumerable_by, nats.
apply Neverending_Enumerable_ with (NE := NE) (n := 0).
reflexivity.
Qed.
We can repackage the theorem to hide the enumeration function, more closely matching the English sentence “neverendingness implies enumerability”.
Corollary Neverending_Enumerable {a} (xs : Colist a)
: Neverending xs > Enumerable xs.
Proof.
intros NE; eexists; apply (Neverending_Enumerable_by (NE := NE)).
Qed.
The converse holds this time. The main insight behind the proof is that the
property “xs == map f (nats_from n)
for some n
” is a neverending
invariant.
Theorem Enumerable_Neverending {a} (xs : Colist a)
: Enumerable xs > Neverending xs.
Proof.
unfold Enumerable, Enumerable_by. intros [f EB].
unfold Neverending.
exists (fun xs => exists n, xs == map f (nats_from n)).
split.
 unfold Neverending_invariant. intros xs_ [n EB_].
destruct EB_ as [EB_]. cbn in EB_. inversion EB_; subst.
exists (f n), xs0. split; [ auto  ].
exists (S n). assumption.
 exists 0; assumption.
Qed.
I think Neverending
is the most intuitive characterization of infinite lists,
but Enumerable
can be easier to use.
To illustrate the point, let us examine a minimized version of my use case.
Consider an arbitrary function from lists of lists to lists:
join : Colist (Colist a) > Colist a
.
Try to formalize the statement
When join
is applied to a square matrix, i.e., a list
of lists all of the same length, it computes the diagonal.
(NB: An infinite list of infinite lists is considered a square.)
The literal approach is to introduce two functions length
(in the
extended naturals) and diagonal
, so we can translate the above sentence as
follows:
forall (xs : Colist (Colist a)),
(forall row, In row xs > length row = length xs) >
join xs == diagonal xs.
However, this is unwieldly because the definition of diagonal
is not
completely trivial. One will have to prove quite a few propositions about
diagonal
in order to effectively reason about it.
A more parsimonious solution relies on the idea that the “diagonal” is simple
to define on functions f : b > b > a
, as diagonal f := fun x => f x x
.
That leads to the following translation:
forall (f : b > b > a) (xs : Colist b),
join (map (fun x => map (f x) xs) xs) = map (fun x => f x x) xs
It takes a bit of squinting to recognize the original idea, but the upside is that this is now a purely equational fact, without side conditions.
Rather than constrain a general list of lists to be a square,
we generate squares from a binary function f : b > b > a
and a list xs : Colist b
representing the “sides” of the square, containing “coordinates” along one axis.
In particular, we can use xs := nats
as the side of an “infinite square”,
and nats
arises readily from Enumerable
lists.
Any square can be extensionally rewritten in that way.
This theorem requires no adhoc definition like a separate diagonal
function,
and instead we can immediately use general facts about map
both to prove and to use
such a theorem.
Nil
—always evaluates to Cons
.nat
.Print SplitSurnumerable.
(* ⇓ *)
Print Surnumerable.
(* ⇓ *)
Print Neverending.
(* ⇕ *)
Print Enumerable.
Can you think of other characterizations of infinite lists?
Which I’ve used recently in a proof that there is no ZipList monad.↩︎
This is a generalization of the types
Mu
and Nu
as they are named in Haskell. This is also how the paco
library defines coinductive propositions.↩︎
Like in the noziplistmonad proof.↩︎
See also my previous post.↩︎
data Free f a = Pure a  Free (f (Free f a))
Thanks to that, the term “free monads” tends to be confused with that encoding, even though “free monads” originally refers to a representationindependent idea. Dually, there is a final encoding of free monads:
type Free' f a = (forall m. MonadFree f m => m a)
where MonadFree
is the following class:
class Monad m => MonadFree f m where
free :: f (m a) > m a
The two types Free
and Free'
are isomorphic.
An explanation a posteriori is that free monads are unique up to isomorphism.
In this post, we will prove that they are isomorphic more directly,^{1}
in Coq.
In other words, there are two functions:
fromFree' :: Free' f a > Free f a
toFree' :: Free f a > Free' f a
such that, for all u :: Free f a
,
fromFree' (toFree' u) = u  easy
and for all u :: Free' f a
,
toFree' (fromFree' u) = u  hard
(Also, these functions are monad morphisms.)
The second equation is hard to prove because it relies on a subtle
fact about polymorphism. If you have a polymorphic function forall m ...
,
it can only interact with m
via operations provided as parameters—in the
MonadFree
dictionary. The equation crashes down if you can perform
some kind of case analysis on types, such as isinstanceof
in certain
languages. This idea is subtle because, how do you turn this negative property
“does not use isinstanceof
” into a positive, useful fact about the functions
of a language?
Parametricity is the name given to such properties. You can get a good
intuition for it with some practice. For example, most people can convince
themselves that forall a. a > a
is only inhabited by the identity function.
But formalizing it so you can validate your intuition is a more mysterious art.
First, unfolding some definitions, the equation we want to prove will simplify to the following:
foldFree (u @(Free f)) = u @m
where u :: forall m. MonadFree f m => m a
is specialized at Free f
on the
left, at an arbitrary m
on the right, and foldFree :: Free f a > m a
is a certain function we do not need to look into for now.
The main idea is that those different specializations of u
are related
by a parametricity theorem (aka. free theorem).
For all monadsm1
,m2
that are instances ofMonadFree f
, and for any relationr
betweenm1
andm2
, ifr
satisfies$CERTAIN_CONDITIONS
, thenr
relatesu @m1
andu @m2
.
In this case, we will let r
relate u1 :: Free f a
and u2 :: m a
when:
foldFree u1 = u2
As it turns out, r
will satisfy $CERTAIN_CONDITIONS
, so that the
parametricity theorem above applies. This
yields exactly the desired conclusion:
foldFree (u @(Free f)) = u @m
It is going to be a gnarly exposition of definitions before we can even get to the proof, and the only reason I can think of to stick around is morbid curiosity. But I had the proof and I wanted to do something with it.^{2}
From Coq Require Import Morphisms.
Set Implicit Arguments.
Set Contextual Implicit.
Right off the bat, the first hurdle is that we cannot actually write the initial Free
in Coq.
To guarantee that all functions terminate and to prevent logical
inconsistencies, Coq imposes restrictions about what recursive types can be
defined. Indeed, Free
could be used to construct an infinite loop by instantiating
it with a contravariant functor f
. The following snippet shows how we can
inhabit the empty type Void
, using only nonrecursive definitions, so it’s
fair to put the blame on Free
:
newtype Cofun b a = Cofun (a > b)
omicron :: Free (Cofun Void) Void > Void
omicron (Pure y) = y
omicron (Free (Cofun z)) = z (Free (Cofun z))
omega :: Void
omega = omicron (Free (Cofun omicron))
To bypass that issue, we can tweak the definition of Free
into what you might
know as the freer monad, or the operational monad.
The key difference is that the recursive occurrence of Free f a
is no longer
under an abstract f
, but a concrete (>)
instead.
Inductive Free (f : Type > Type) (a : Type) : Type :=
 Pure : a > Free f a
 Bind : forall e, f e > (e > Free f a) > Free f a
.
With that definition, it is no longer necessary for f
to be a functor—it’s
even undesirable because of size issues. Instead, f
should rather be thought
of as a type of “shapes”, containing “positions” of type e
, and that induces
a functor by assigning values to those positions (via the function e > Free f a
here); such an f
is also known as a “container”.
For example, the Maybe
functor consists of two “shapes”: Nothing
, with no
positions (indexed by Void
), and Just
, with one position (indexed by ()
).
Those shapes are defined by the following GADT, the Maybe
container:
data PreMaybe _ where
Nothing_ :: PreMaybe Void
Just_ :: PreMaybe ()
A container extends into a functor, using a construction that some call Coyoneda
:
data Maybe' a where
MkMaybe' :: forall a e. PreMaybe e > (e > a) > Maybe' a
data Coyoneda f a where
Coyoneda :: forall f a e. f e > (e > a) > Coyoneda f a
Freer f a
(where Freer
is called Free
here in Coq) coincides with
Free (Coyoneda f) a
(for the original definition of Free
at the top).
If f
is already a functor, then it is observationally equivalent to Coyoneda f
.
Monad
and MonadFree
The Monad
class hides no surprises. For simplicity we skip the Functor
and Applicative
classes. Like in C, return
is a keyword in Coq, so we have to settle for another name.
Class Monad (m : Type > Type) : Type :=
{ pure : forall {a}, a > m a
; bind : forall {a b}, m a > (a > m b) > m b
}.
(* The braces after `forall` make the arguments implicit. *)
Our MonadFree
class below is different than in Haskell because of the switch
from functors to containers (see previous section).
In the original MonadFree
, the method free
takes an argument of type f (m a)
, where the idea is to “interpret” the outer layer f
, and “carry on” with
a continuation m a
. Containers encode that outer layer without the
continuation.^{3}
Class MonadFree {f m : Type > Type} `{Monad m} : Type :=
{ free : forall {x}, f x > m x }.
(* Some more implicit arguments nonsense. *)
Arguments MonadFree f m {_}.
Here comes the final encoding of free monads. The resemblance to the Haskell code above should be apparent in spite of some funny syntax.
Definition Free' (f : Type > Type) (a : Type) : Type :=
forall m `(MonadFree f m), m a.
Type classes in Coq are simply types with some extra type inference rules to
infer dictionaries. Thus, the definition of Free'
actually desugars to
a function type forall m, Monad m > MonadFree f m > m a
.
A value u : Free' f a
is a function whose arguments are a type
constructor m
, followed by two dictionaries of the Monad
and MonadFree
classes.
We specialize u
to a monad m
by writing u m _ _
, applying u
to the type
constructor m
and two holes (underscores) for the dictionaries, whose
contents will be inferred via type class resolution.
See for example fromFree'
below.
While we’re at it, we can define the instances of Monad
and MonadFree
for
the initial encoding Free
.
Fixpoint bindFree {f a b} (u : Free f a) (k : a > Free f b) : Free f b :=
match u with
 Pure a => k a
 Bind e h => Bind e (fun x => bindFree (h x) k)
end.
#[global]
Instance Monad_Free f : Monad (Free f) :=
{ pure := @Pure f
; bind := @bindFree f
}.
#[global]
Instance MonadFree_Free f : MonadFree f (Free f) :=
{ free A e := Bind e (fun a => Pure a)
}.
To show that those monads are equivalent, we must exhibit a mapping going both ways.
The easy direction is from the final Free'
to the initial Free
: with the
above instances of Monad
and MonadFree
, just monomorphize the polymorph.
Definition fromFree' {f a} : Free' f a > Free f a :=
fun u => u (Free f) _ _.
The other direction is obtained via a fold of Free f
, which allows us to interpret it
in any instance of MonadFree f
: replace Bind
with bind
, interpret the
first operand with free
, and recurse in the second operand.
Fixpoint foldFree {f m a} `{MonadFree f m} (u : Free f a) : m a :=
match u with
 Pure a => pure a
 Bind e k => bind (free e) (fun x => foldFree (k x))
end.
Definition toFree' {f a} : Free f a > Free' f a :=
fun u M _ _ => foldFree u.
In everyday mathematics, equality is a selfevident notion that we take for granted. But if you want to minimize your logical foundations, you do not need equality as a primitive. Equations are just equivalences, where the equivalence relation is kept implicit.
Who even decides what the rules for reasoning about equality are anyway? You decide, by picking the underlying equivalence relation. ^{4}
Here is a class for equality. It is similar to Eq
in Haskell,
but it is propositional (a > a > Prop
) rather than boolean (a > a > Bool
),
meaning that equality doesn’t have to be decidable.
Class PropEq (a : Type) : Type :=
propeq : a > a > Prop.
Notation "x = y" := (propeq x y) : type_scope.
For example, for inductive types, a common equivalence can be defined as
another inductive type which equates constructors and their fields recursively.
Here it is for Free
:
Inductive eq_Free f a : PropEq (Free f a) :=
 eq_Free_Pure x : eq_Free (Pure x) (Pure x)
 eq_Free_Bind p (e : f p) k1 k2
: (forall x, eq_Free (k1 x) (k2 x)) >
eq_Free (Bind e k1) (Bind e k2)
.
(* Register it as an instance of PropEq *)
Existing Instance eq_Free.
Having defined equality for Free
, we can state and prove one half of the
isomorphism between Free
and Free'
.
Theorem to_from f a (u : Free f a)
: fromFree' (toFree' u) = u.
The proof is straightforward by induction, case analysis (which is performed as part of induction), and simplification.
Proof.
induction u. all: cbn. all: constructor; auto.
Qed.
To state the other half of the isomorphism (toFree' (fromFree' u) = u
),
it is less obvious what the right equivalence relation on Free'
should be.
When are two polymorphic values u1, u2 : forall m `(MonadFree f m), m a
equal?
A fair starting point is that all of their specializations must be equal.
“Equality” requires an instance of PropEq
, which must be introduced as an
extra parameter.
(* u1 and u2 are "equal" when all of their specializations
(u1 m _ _) and (u2 m _ _) are equal. *)
Definition eq_Free'_very_naive f a (u1 u2 : Free' f a) : Prop :=
forall m `(MonadFree f m) `(forall x, PropEq (m x)),
u1 m _ _ = u2 m _ _.
That definition is flagrantly inadequate: so far, a PropEq
instance can be
any relation, including the empty relation (which never holds), and the Monad
instance
(as a superclass of MonadFree
) might be unlawful. In our
desired theorem, toFree' (fromFree' u) = u
, the two sides use a priori
different combinations of bind
and pure
, so we expect to rely on laws to
be able to rewrite one side into the other.
In programming, we aren’t used to proving that implementations satisfy their laws,
so there is always the possibility that a Monad
instance is unlawful.
In math, the laws are in the definitions; if something doesn’t satisfy the
monad laws, it’s not a monad. Let’s irk some mathematicians and
say that a lawful monad is a monad that satisfies the monad laws.
Thus we will have one Monad
class for the operations only, and one
LawfulMonad
class for the laws they should satisfy.
Separating code and proofs that way helps to organize things.
Code is often much simpler than the proofs about it, since the latter
necessarily involves dependent types.
Class LawfulMonad {m} `{Monad m} `{forall a, PropEq (m a)} : Prop :=
{ Equivalence_LawfulMonad :> forall a, Equivalence (propeq (a := m a))
; propeq_bind : forall a b (u u' : m a) (k k' : a > m b),
u = u' > (forall x, k x = k' x) > bind u k = bind u' k'
; bind_pure : forall a (u : m a),
bind u (pure (a := a)) = u
; pure_bind : forall a b (x : a) (k : a > m b),
bind (pure x) k = k x
; bind_bind : forall a b c (u : m a) (k : a > m b) (h : b > m c),
bind (bind u k) h = bind u (fun x => bind (k x) h)
}.
The three monad laws should be familiar (bind_pure
, pure_bind
, bind_bind
).
In those equations, “=
” denotes a particular equivalence relation, which is now a
parameter/superclass of the class. Once you give up on equality as a primitive notion,
algebraic structures must now carry their own equivalence relations.
The requirement that it is an equivalence relation also becomes an explicit law
(Equivalence_LawfulMonad
), and we expect that operations (in this case, bind
)
preserve the equivalence (propeq_bind
). Practically speaking, that last fact
allows us to rewrite subexpressions locally, otherwise we could only apply the
monad laws at the root of an expression.
A less naive equivalence on Free'
is thus to restrict the quantification
to lawful instances:
Definition eq_Free'_naive f a (u1 u2 : Free' f a) : Prop :=
forall m `(MonadFree f m) `(forall x, PropEq (m x)) `(!LawfulMonad (m := m)),
u1 m _ _ = u2 m _ _.
That is a quite reasonable definition of equivalence for Free'
. In other circumstances,
it could have been useful. Unfortunately, it is too strong here:
we cannot prove the equation toFree' (fromFree' u) = u
with that interpretation of =
.
Or at least I couldn’t figure out a solution.
We will need more assumptions to be able to apply the parametricity theorem of
the type Free'
. To get there, we must formalize Reynolds’ relational interpretation of types.
The core technical idea in Reynolds’ take on parametricity is to
interpret a type t
as a relation Rt : t > t > Prop
. Then, the
parametricity theorem is that all terms x : t
are related to themselves
by Rt
(Rt x x
is true).
If t
is a polymorphic type, that theorem connects different specializations
of a same term x : t
, and that allows us to formalize arguments that rely on
“parametricity” as a vague idea.
For example, if t = (forall a, a > a)
, then Rt
is the following relation,
which says that two functions f
and f'
are related if for any relation Ra
(on any types), f
and f'
send related inputs (Ra x x'
) to related outputs
(Ra (f a x) (f' a' x')
).
Rt f f' =
forall a a' (Ra : a > a' > Prop),
forall x x', Ra x x' > Ra (f a x) (f' a' x')
If we set Ra x x'
to mean “x
equals an arbitrary constant z0
”
(ignoring x'
, i.e., treating Ra
as a unary relation), the above relation
Rt
amounts to saying that f z0 = z0
, from which we deduce that f
must be
the identity function.
The fact that Rt
is a relation is not particularly meaningful to the parametricity
theorem, where terms are simply related to themselves, but it is a feature of
the construction of Rt
: the relation for a composite type t1 > t2
combines
the relations for the components t1
and t2
, and we could not get the same result
with only unary predicates throughout.^{5} More formally, we define
a relation R[t]
by induction on t
, between the types t
and t'
,
where t'
is the result of renaming all variables x
to x'
in t
(including binders). The two most interesting cases are:
t
starts with a quantifier t = forall a, _
, for a type variable a
.
Then the relation R[forall a, _]
between the polymorphic f
and f'
takes
two arbitrary types a
and a'
to specialize f
and f'
with, and
a relation Ra : a > a' > Prop
, and relates f a
and f' a'
(recursively),
using Ra
whenever recursion reaches a variable a
.
t
is an arrow t1 > t2
, then R[t1 > t2]
relates functions that send
related inputs to related outputs.
In summary:
R[forall a, t](f, f') = forall a a' Ra, R[t](f a)(f' a')
R[a](f, f') = Ra(f, f')
 Ra should be in scope when a is in scope.
R[t1 > t2](f, f') = forall x x', R[t1](x, x') > R[t2](f x, f' x')
That explanation was completely unhygienic, but refer to Reynolds’ paper or Wadler’s Theorems for free! for more formal details.
For sums (Either
/sum
) and products ((,)
/prod
), two values are related if
they start with the same constructor, and their fields are related (recursively).
This can be deduced from the rules above applied to the Church encodings of
sums and products.
While types t : Type
are associated to relations Rt : t > t > Prop
,
type constructors m : Type > Type
are associated to relation transformers
(functions on relations) Rm : forall a a', (a > a' > Prop) > (m a > m a' > Prop)
.
It is usually clear what’s what from the context, so we will often
refer to “relation transformers” as just “relations”.
For example, the initial Free f a
type gets interpreted to the relation RFree Rf Ra
defined as follows. Two values u1 : Free f1 a1
and u2 : Free f2 a2
are related by RFree
if either:
u1 = Pure x1
, u2 = Pure x2
, and x1
and x2
are related (by Ra
); oru1 = Bind e1 k1
, u2 = Bind e2 k2
, e1
and e2
are related, and k1
and k2
are related (recursively).We thus have one rule for each constructor (Pure
and Bind
)
in which we relate each field (Ra x1 x2
in RFree_Pure
; Rf _ _ _ y1 y2
and RFree Rf Ra (k1 x1) (k2 x2)
in RFree_Bind
).
Let us also remark that the existential type e
in Bind
becomes an existential relation Re
in RFree_Bind
.
Inductive RFree {f₁ f₂ : Type > Type}
(Rf : forall a₁ a₂ : Type, (a₁ > a₂ > Prop) > f₁ a₁ > f₂ a₂ > Prop)
{a₁ a₂ : Type} (Ra : a₁ > a₂ > Prop) : Free f₁ a₁ > Free f₂ a₂ > Prop :=
 RFree_Pure : forall (x₁ : a₁) (x₂ : a₂),
Ra x₁ x₂ > RFree Rf Ra (Pure x₁) (Pure x₂)
 RFree_Bind : forall (e₁ e₂ : Type) (Re : e₁ > e₂ > Prop) (y₁ : f₁ e₁) (y₂ : f₂ e₂),
Rf e₁ e₂ Re y₁ y₂ >
forall (k₁ : e₁ > Free f₁ a₁) (k₂ : e₂ > Free f₂ a₂),
(forall (x₁ : e₁) (x₂ : e₂),
Re x₁ x₂ > RFree Rf Ra (k₁ x₁) (k₂ x₂)) >
RFree Rf Ra (Bind y₁ k₁) (Bind y₂ k₂).
Inductive relations such as RFree
, indexed by types with existential
quantifications such as Free
, are a little terrible to work with
outofthebox—especially if you’re allergic to UIP.
Little “inversion lemmas” like the following make them a bit nicer by
reexpressing those relations in terms of some standard building blocks which
leave less of a mess when decomposed.
Definition inv_RFree {f₁ f₂} Rf {a₁ a₂} Ra (u₁ : Free f₁ a₁) (u₂ : Free f₂ a₂)
: RFree Rf Ra u₁ u₂ >
match u₁, u₂ return Prop with
 Pure a₁, Pure a₂ => Ra a₁ a₂
 Bind y₁ k₁, Bind y₂ k₂ =>
exists Re, Rf _ _ Re y₁ y₂ /\
(forall x₁ x₂, Re x₁ x₂ > RFree Rf Ra (k₁ x₁) (k₂ x₂))
 _, _ => False
end.
Proof.
intros []; eauto.
Qed.
Type classes, which are (record) types, also get interpreted in the same way.
Since Monad
is parameterized by a type constructor m
, the relation RMonad
between Monad
instances is parameterized by a relation between two type
constructors m1
and m2
.
Two instances of Monad
, i.e., two values of type Monad m
for some m
, are related
if their respective fields, i.e., pure
and bind
, are related.
pure
and bind
are functions, so two instances are related when they send related inputs
to related outputs.
Record RMonad (m₁ m₂ : Type > Type)
(Rm : forall a₁ a₂ : Type, (a₁ > a₂ > Prop) > m₁ a₁ > m₂ a₂ > Prop)
`{Monad m₁} `{Monad m₂} : Prop :=
{ RMonad_pure : forall (t₁ t₂ : Type) (Rt : t₁ > t₂ > Prop) (x₁ : t₁) (x₂ : t₂),
Rt x₁ x₂ > Rm t₁ t₂ Rt (pure x₁) (pure x₂)
; RMonad_bind : forall (t₁ t₂ : Type) (Rt : t₁ > t₂ > Prop)
(u₁ u₂ : Type) (Ru : u₁ > u₂ > Prop) (x₁ : m₁ t₁) (x₂ : m₂ t₂),
Rm t₁ t₂ Rt x₁ x₂ >
forall (k₁ : t₁ > m₁ u₁) (k₂ : t₂ > m₂ u₂),
(forall (x₁ : t₁) (x₂ : t₂),
Rt x₁ x₂ > Rm u₁ u₂ Ru (k₁ x₁) (k₂ x₂)) >
Rm u₁ u₂ Ru (bind x₁ k₁) (bind x₂ k₂)
}.
MonadFree
also gets translated to a relation RMonadFree
. Related inputs, related outputs.
Record RMonadFree (f₁ f₂ : Type > Type)
(Rf : forall a₁ a₂ : Type, (a₁ > a₂ > Prop) > f₁ a₁ > f₂ a₂ > Prop)
(m₁ m₂ : Type > Type)
(Rm : forall a₁ a₂ : Type, (a₁ > a₂ > Prop) > m₁ a₁ > m₂ a₂ > Prop)
`{MonadFree f₁ m₁} `{MonadFree f₂ m₂} : Prop :=
{ RMonadFree_free : forall (a₁ a₂ : Type) (Ra : a₁ > a₂ > Prop) (x₁ : f₁ a₁) (x₂ : f₂ a₂),
Rf a₁ a₂ Ra x₁ x₂ > Rm a₁ a₂ Ra (free x₁) (free x₂)
}.
Note that RMonad
and RMonadFree
are “relation transformer transformers”, since they
take relation transformers as arguments, to produce a relation between class dictionaries.
We can now finally translate the final Free'
to a relation.
Two values u1 : Free' f1 a1
and u2 : Free' f2 a2
are related
if, for any two monads m1
and m2
, with a relation transformer Rm
,
whose Monad
and MonadFree
instances are related by RMonad
and RMonadFree
,
Rm
relates u1 m1 _ _
and u2 m2 _ _
.
Definition RFree' {f₁ f₂} Rf {a₁ a₂} Ra (u₁ : Free' f₁ a₁) (u₂ : Free' f₂ a₂) : Prop :=
forall m₁ m₂ `(MonadFree f₁ m₁) `(MonadFree f₂ m₂) Rm
(pm : RMonad Rm) (pf : RMonadFree Rf Rm),
Rm _ _ Ra (u₁ m₁ _ _) (u₂ m₂ _ _).
The above translation of types into relations can be automated by a tool such as
paramcoq. However paramcoq currently constructs relations in
Type
instead of Prop
, which got me stuck in universe inconsistencies.
That’s why I’m declaring Prop
relations the manual way here.
The parametricity theorem says that any u : Free' f a
is related to itself
by RFree'
(for some canonical relations on f
and a
). It is a theorem about
the language Coq which we can’t prove within Coq. Rather than postulate it,
we will simply add the required RFree' _ _ u u
assumption to our proposition
(from_to
below).
Given a concrete u
, it should be straightforward to prove that assumption
casebycase in order to apply that proposition.
These “relation transformers” are a bit of a mouthful to spell out,
and they’re usually guessable from the type constructor (f
or m
),
so they deserve a class, that’s a higherorder counterpart to PropEq
(like Eq1
is to Eq
in Haskell).
Class PropEq1 (m : Type > Type) : Type :=
propeq1 : forall a₁ a₂, (a₁ > a₂ > Prop) > m a₁ > m a₂ > Prop.
Given a PropEq1 m
instance, we can apply it to the relation eq
to get a plain relation which seems a decent enough default for PropEq (m a)
.
#[global]
Instance PropEq_PropEq1 {m} `{PropEq1 m} {a} : PropEq (m a) := propeq1 eq.
We previously defined a “lawful monad” as a monad with an equivalence relation
(PropEq (m a)
). To use parametricity, we will also need a monad m
to provide
a relation transformer (PropEq1 m
), which subsumes PropEq
with the instance
just above.^{6} This extra structure comes with additional laws,
extending our idea of monads to “really lawful monads”.
Class Trans_PropEq1 {m} `{PropEq1 m} : Prop :=
trans_propeq1 : forall a₁ a₂ (r : a₁ > a₂ > Prop) x₁ x₁' x₂ x₂',
x₁ = x₁' > propeq1 r x₁' x₂ > x₂ = x₂' > propeq1 r x₁ x₂'.
Class ReallyLawfulMonad m `{Monad m} `{PropEq1 m} : Prop :=
{ LawfulMonad_RLM :> LawfulMonad (m := m)
; Trans_PropEq1_RLM :> Trans_PropEq1 (m := m)
; RMonad_RLM : RMonad (propeq1 (m := m))
}.
Class ReallyLawfulMonadFree f `{PropEq1 f} m `{MonadFree f m} `{PropEq1 m} : Prop :=
{ ReallyLawfulMonad_RLMF :> ReallyLawfulMonad (m := m)
; RMonadFree_RLMF : RMonadFree (propeq1 (m := f)) (propeq1 (m := m))
}.
We inherit the LawfulMonad
laws from before.
The relations RMonad
and RMonadFree
,
defined earlier, must relate m
’s instances of Monad
and MonadFree
,
for the artificial reason that that’s roughly what RFree'
will require.
We also add a generalized transitivity law, which allows us to rewrite
either side of a heterogeneous relation propeq1 r
using the homogeneous
one =
(which denotes propeq1 eq
).
It’s worth noting that there is some redundancy here, that could be avoided
with a bit of refactoring. That generalized transitivity law Trans_PropEq1
implies
transitivity of =
, which is part of the claim that =
is an equivalence
relation in LawfulMonad
. And the bind
component of RMonad
implies
propeq_bind
in LawfulMonad
, so these RMonad
and RMonadFree
laws
can also be seen as generalizations of congruence laws to heterogeneous
relations, making them somewhat less artificial than they may seem
at first.
Restricting the definition of equality on the final free monad Free'
to
quantify only over really lawful monads yields the right notion of equality
for our purposes, which is to prove the from_to
theorem below, validating the
isomorphism between Free
and Free'
.
#[global]
Instance eq_Free' f `(PropEq1 f) a : PropEq (Free' f a) :=
fun u₁ u₂ =>
forall m `(MonadFree f m) `(PropEq1 m) `(!ReallyLawfulMonadFree (m := m)),
u₁ m _ _ = u₂ m _ _.
Quickly, let’s get the following lemma out of the way, which says
that foldFree
commutes with bind
. We’re really saying that foldFree
is
a monad morphism but no time to say it properly. The proof of the
next lemma will need this, but it’s also nice to look at this on its own.
Lemma foldFree_bindFree {f m} `{MonadFree f m} `{forall a, PropEq (m a)} `{!LawfulMonad (m := m)}
{a b} (u : Free f a) (k : a > Free f b)
: foldFree (bindFree u k) = bind (foldFree u) (fun x => foldFree (k x)).
Proof.
induction u; cbn [bindFree foldFree].
 symmetry. apply pure_bind with (k := fun x => foldFree (k x)).
 etransitivity; [  symmetry; apply bind_bind ].
eapply propeq_bind.
* reflexivity.
* auto.
Qed.
Our goal is to prove an equation in terms of eq_Free'
, which gives us
a really lawful monad as an assumption. We open a section to set up
the same context as that and to break down the proof into more digestible pieces.
Section ISOPROOF.
Context {f m} `{MonadFree f m} `{PropEq1 m} `{!ReallyLawfulMonad (m := m)}.
As outlined earlier, parametricity will yield an assumption RFree' _ _ u u
,
and we will specialize it with a relation R
which relates u1 : Free f a
and u2 : m a
when foldFree u1 = u2
. However, RFree'
actually expects a relation
transformer rather than a relation, so we instead define R
to relate
u1 : Free f a1
and u2 : Free f a2
when propeq1 Ra (foldFree u1) u2
,
where Ra
is a relation given between a1
and a2
.
Let R := (fun a₁ a₂ (Ra : a₁ > a₂ > Prop) u₁ u₂ => propeq1 Ra (foldFree u₁) u₂).
The following two lemmas are the “$CERTAIN_CONDITIONS
” mentioned earlier,
that R
must satisfy, i.e., we prove that R
, via RMonad
(resp.
RMonadFree
), relates the Monad
(resp. MonadFree
) instances for Free f
and m
.
Lemma RMonad_foldFree : RMonad (m₁ := Free f) R.
Proof.
constructor; intros.
 cbn. apply RMonad_RLM; auto.
 unfold R. eapply trans_propeq1.
+ apply foldFree_bindFree.
+ eapply RMonad_RLM; eauto.
+ reflexivity.
Qed.
Context (Rf : PropEq1 f).
Context (RMonadFree_m : RMonadFree propeq1 propeq1).
Lemma RMonadFree_foldFree : RMonadFree Rf R.
Proof.
constructor; intros.
 unfold R.
eapply trans_propeq1.
+ apply bind_pure.
+ apply RMonadFree_m. eassumption.
+ reflexivity.
Qed.
End ISOPROOF.
Here comes the conclusion, which completes our claim that toFree'
/fromFree'
is
an isomorphism (we proved the other half to_from
on the way here).
This equation is under an assumption which parametricity promises to
fulfill, but we will have to step out of the system if we want it right now.
Theorem from_to f (Rf : PropEq1 f) a (u : Free' f a)
: RFree' Rf eq u u >
toFree' (fromFree' u) = u.
In the proof, we get the assumption H : RFree' Rf eq u u
, which we apply
to the above lemmas, RMonad_foldFree
and RMonadFree_foldFree
,
using the specialize
tactic. That yields exactly our desired goal.
Proof.
do 2 red; intros.
unfold toFree', fromFree'.
red in H.
specialize (H (Free f) m _ _ _ _ _ RMonad_foldFree (RMonadFree_foldFree RMonadFree_RLMF)).
apply H.
Qed.
If you managed to hang on so far, treat yourself to some chocolate.
To formalize a parametricity argument in Coq, I had to move the goalposts quite a bit throughout the experiment:
It could be interesting to see a “really lawful monad” spelled out fully.
Another similar but simpler exercise is to prove the equivalence between
initial and final encodings of lists. It probably wouldn’t involve “relation
transformers” as much. There are also at least two different variants: is your
final encoding “foldr
” or “fold
”based (the latter mentions monoids, the
former doesn’t)?
I hope that machinery can be simplified eventually, but given the technical sophistication that is currently necessary, prudence is advised when navigating around claims made “by parametricity”.
Church encodings, inductive types, and relational parametricity, by Neel Krishnaswami
Final algebra semantics is observational equivalence, by Max New
Relational parametricity for higher kinds (PDF), by Robert Atkey
Free theorems involving type constructor classes (PDF), by Janis Voigtländer
Parametricity, type equality and higherorder polymorphism (PDF), by Dimitrios Vytiniotis and Stephanie Weirich
Unary parametricity vs binary parametricity, on TCS StackExchange
(F r > r) > r
gives an initial algebra of F
, on CS StackExchange
Answering Iceland_Jack’s question on Twitter.↩︎
That idea is also present in Kiselyov and Ishii’s paper.↩︎
Those who do know Coq will wonder, what about eq
(“intensional equality”)?
It is a fine default relation for firstorder data (nat
, pairs, sums, lists,
ASTs without HOAS). But it is too strong for computations (functions and
coinductive types) and proofs (of Prop
s). Then a common approach is to
introduce extensionality axioms, postulating that “extensional equality implies
intensional equality”. But you might as well just stop right after proving
whatever extensional equality you wanted.↩︎
Well, if you tried you would end up with the unary variant of the parametricity theorem, but it’s much weaker than the binary version shown here. nary versions are also possible and even more general, but you have to look hard to find legitimate uses.↩︎
To be honest, that decision was a little arbitrary. But I’m not
sure making things more complicated by keeping EqProp1
and EqProp
separate
buys us very much.↩︎
Even though I don’t know what a type is, I can still recognize when a paper “is
about types”: the paper usually contains many occurrences of formulas of the form
“t : T
”, where “t
” is some piece of code, some program, and “T
” is one of
these mysterious types. The colon in the middle is of no technical
significance, but it signals some cultural awareness on the part of authors.
Hypothesis: Types are a meme.
My experience is also that things are very very bad when “t : T
” does not hold.
Types are a way to tell right from wrong, for some domainspecific definitions
of correctness.
Hypothesis: Types are specifications.
One idea that really narrows it down for me is that programming languages have types. You can assign types to everything in a language: static types to source code, dynamic types to runtime values.
Another way to look at this is to compare with other forms of specifications. How do you prove a specification? A priori, you could use any method, and all you care about is that it is somehow “sound”, but otherwise the proof method is a black box.
Approaches using “types” seem different. To prove a specification, a typing
judgement “t : T
”, the way forward is to prove more typing judgements by
following the rules of some “type system”. Types tell me both “how to specify
things” and “how to verify things”—by specifying and verifying subthings.
Hypothesis: Types are compositional specifications.
I originally posted this question on the recently created TYPES Zulip server, a spinoff of the TYPES mailing list. Those are nice hangouts for people who like types, whatever you believe they are (and also for getting spammed with CallsForPapers).
Whereas most formal methods are sound for proving the absence of certain bugs, testing is a sound method of finding bugs.↩︎
{# LANGUAGE TypeFamilies, DataKinds, PolyKinds, RankNTypes,
GADTs, TypeOperators, UndecidableInstances #}
import Data.Kind (Type)
import Data.Proxy
Type families in Haskell offer a flavor of dependent types:
a function g
or a type family G
may have a result whose type
F x
depends on the argument x
:
type family F (x :: Type) :: Type
g :: forall x. Proxy x > F x  Proxy to avoid ambiguity
g = undefined  dummy
type family G (x :: Type) :: F x
But it is not quite clear how well features of other “truly” dependently typed languages translate to Haskell. The challenge we’ll face in this post is to do typelevel patternmatching on GADTs indexed by type families.
Sorry if that was a bit of a mouthful. Let me illustrate the problem with
a minimal nonworking example.
You run right into this issue when you try to defunctionalize a dependent
function, such as G
, which is useful to reimplement “at the type level”
libraries that use type families, such as recursionschemes.
First encode G
as an expression, a symbol SG
, denoting a value of type F x
:
type Exp a = a > Type
data SG (x :: Type) :: Exp (F x)
Declare an evaluation function, mapping expressions to values:
type family Eval (e :: Exp a) :: a
Define that function on SG
:
type instance Eval (SG x) = G x
And GHC complains with the following error message (on GHC 8.10.2):
error:
• Illegal type synonym family application ‘F x’ in instance:
Eval @(F x) (SG x)
• In the type instance declaration for ‘Eval’
The function Eval :: forall a. Exp a > a
has two arguments, the type a
,
which is implicit, and the expression e
of type Exp a
.
In the clause for Eval (SG x)
, that type argument a
must be F x
.
Problem: it contains a type family F
.
To put it simply, the arguments in each type instance
must be “patterns”,
made of constructors and variables only, and F x
is not a pattern.
As a minor remark, it is necessary for the constructor SG
to involve a type
family in its result. We would not run into this problem with simpler
GADTs where result types contain only constructors.
 Example of a "simpler" GADT
data MiniExp a where
Or :: Bool > Bool > MiniExp Bool
Add :: Int > Int > MiniExp Int
It’s a problem specific to this usage of type families.
For comparison, a similar valuelevel encoding does compile,
where eval
is a function on a GADT:
data Exp1 (a :: Type) where
SG1 :: forall x. Proxy x > Exp1 (F x)
 Proxy is necessary to avoid ambiguity.
eval :: Exp1 a > a
eval (SG1 x) = g x
You can also try to promote that example as a type family,
only to run into the same error as earlier. The only difference
is that SG1
is a constructor of an actual GADT, whereas
SG
is a type contructor, using Type
as a pseudoGADT.
type family Eval1 (e :: Exp1 a) :: a
type instance Eval1 (SG1 (_ :: Proxy x)) = G x
error:
• Illegal type synonym family application ‘F x’ in instance:
Eval1 @(F x) ('SG1 @x _1)
• In the type instance declaration for ‘Eval1’
Type families in Haskell may have implicit parameters, but they behave like
regular parameters. To evaluate an applied type family, we look for a clause
with matching patterns; the “matching” is done lefttoright, and it’s
not possible to match against an arbitrary function application F x
.
In contrast, in functions, type parameters are implicit, and also irrelevant.
To evaluate an applied function, we jump straight to look at its nontype
arguments, so it’s fine if some clauses instantiate type arguments with type
families.
In Agda, an actual dependentlytyped language, dot patterns generalize that idea: they indicate parameters (not only type parameters) whose values are determined by patternmatching on later parameters.
A different way to understand this is that the constructors of GADTs hold
type equalities that constrain preceding type arguments. For example,
the SG1
constructor above really has the following type:
SG1 :: forall x y. (F x ~ y) => Proxy x > Exp1 y
where the result type is the GADT Eval1
applied to a type variable,
and the equality F x ~ y
turns into a field of the constructor
containing that equality proof.
So those are other systems where our example does work, and type families are just weird for historical reasons. We can hope that Dependent Haskell will make them less weird.
In today’s AlmostDependent Haskell, the above desugaring of GADTs suggests a workaround: type equality allows us to comply with the restriction that the lefthand side of a type family must consist of patterns.
Although there are no constraints in the promoted world to translate (~)
,
type equality can be encoded as a type:
data a :=: b where
Refl :: a :=: a
A type equality e :: a :=: b
gives us a coercion, a function Rewrite e :: a > b
.
There is one case: if e
is the constructor Refl :: a :=: a
,
then the coercion is the identity function:
type family Rewrite (e :: a :=: b) (x :: a) :: b
type instance Rewrite Refl x = x
Now we can define the defunctionalization symbol for G
, using an equality
to hide the actual result type behind a variable y
:
data SG2_ (x :: Type) (e :: F x :=: y) :: Exp y
 SG2_ :: forall y. forall x > F x :=: y > Exp y
We export a wrapper supplying the Refl
proof, to expose the same type
as the original SG
above:
type SG2 x = SG2_ x Refl
 SG2 :: forall x > Exp (F x)
We can now define Eval
on SG2_
(and thus SG2
) similarly to the function
eval
on SG1
, with the main difference being that the coercion is applied
explicitly:
type instance Eval (SG2_ x e) = Rewrite e (G x)
To summarize, type families have limitations which get in the way of patternmatching on GADTs, and we can overcome them by making type equalities explicit.
Thanks to Denis Stoyanov for discussing this issue with me.
]]>So there is a sense in which these are equivalent, but that already presumes that they are not exactly the same. We think about recursion differently than iteration. Hence it may a little surprising when recursion and iteration both appear directly as two implementations of the same interface.
To summarize the main point without all the upcoming category theory jargon,
there is one signature which describes an operator for iteration, recursion, or
maybe a bit of both simultaneously, depending on how you read the symbols ==>
and +
:
iter :: (a ==> a + b) > (a ==> b)
The idea of “iteration” is encapsulated by the following function iter
:
iter :: (a > Either a b) > (a > b)
iter f a =
case f a of
Left a' > iter f a'
Right b > b
iter
can be thought of as a “while” loop.
The body of the loop f
takes some state a
, and either says “continue” with
a new state a'
to keep the loop going, or “break” with a result b
.
We can generalize iter
. It transforms “loop bodies” into “loops”, and rather
than functions, those could be entities in any category. An iteration operator
on some category denoted (==>)
is a function with the following signature:
iter :: (a ==> a + b) > (a ==> b)
satisfying a bunch of laws, with the most obvious one being a fixed point equation:^{1}
iter f = (f >>> either (iter f) id)
where (>>>)
and id
are the two defining components of a category,
and either
is the eliminator for sums (+
).
The technical term for “a category with sums” is a cocartesian category.
class Category k => Cocartesian k where
type a + b  Not fully wellformed Haskell.
either :: k a c > k b c > k (a + b) c
left :: k a (a + b)
right :: k b (a + b)
 Replacing k with an infix (==>)
 either :: (a ==> c) > (b ==> c) > (a + b ==> c)
Putting this all together, an iterative category is a cocartesian category
plus an iter
operation.
class Cocartesian k => Iterative k where
iter :: k a (a + b) > k a b
The fixed point equation provides a pretty general way to define iter
.
For the three in this post, it produces working functions in Haskell.
In theory, properly sorting out issues of nontermination can get hairy.
iter :: (a > Either a b) > (a > b)
iter f = f >>> either (iter f) id
 NB: (>>>) = flip (.)
Recursion also provides an implementation for iter
, but in the opposite category,
(<==)
. If you flip arrows back the right way, this defines a twin interface of
“coiterative categories”. Doing so, sums (+)
become products (*)
.
class Cartesian k => Coiterative k where
coiter :: k (a * b) a > k b a
 with infix notation (==>) instead of k,
 coiter :: (a * b ==> a) > (b ==> a)
We can wrap any instance of Iterative
as an instance of Coiterative
and
vice versa, so iter
and coiter
can be thought of as the same interface in
principle. For particular implementations, one or the other direction may seem
more intuitive.
If we curry and flip the argument,
the type of coiter
becomes (b > a > a) > b > a
,
which is like the type of fix :: (a > a) > a
but with
the functor (b > _)
applied to both the domain (a > a)
and codomain a
: coiter
is fmap fix
.
coiter' :: (b > a > a) > b > a
coiter' = fmap fix
The fixed point equation provides an equivalent definition.
We need to flip (>>>)
into (<<<)
(which is (.)
),
and the dual of either
does not have a name in the standard
library, but it is liftA2 (,)
.
coiter :: ((a, b) > a) > b > a
coiter f = f . liftA2 (,) (coiter f) id
 where 
liftA2 (,) :: (c > a) > (c > b) > (c > (a, b))
That latter definition is mostly similar to the naive definition
of fix
, where fix f
will be reevaluated with every unfolding.
fix :: (a > a) > a
fix f = f (fix f)
We have two implementations of iter
, one by iteration, one by recursion.
Iterative categories thus provide a framework generalizing both iteration and
recursion under the same algebraic rules.
From those two examples, one might hypothesize that iter
models
iteration, while coiter
models recursion. But here is another example
which suggests the situation is not as simple as that.
We start with the category of functors Type > Type
,
which is equipped with a sum:
data (f :+: g) a = L (f a)  R (g a)
But the real category of interest is the Kleisli category of the “monad of free
monads”, i.e., the mapping Free
from functors f
to the free
monads they generate Free f
. That mapping is itself a monad.
data Free f a = Pure a  Lift (f (Free f a))
An arrow f ==> g
is now a natural transformation f ~> Free g
,
i.e., forall a. f a > Free g a
:
 Natural transformation from f to g
type f ~> g = forall a. f a > g a
One intuition for that category is that functors f
are interfaces,
and the free monad Free f
is inhabited by expressions, or programs, using
operations from the interface f
.
Then a natural transformation f ~> Free g
is an implementation of the
interface f
using interface g
. Those operations compose naturally:
given an implementation of f
in terms of g
(f ~> Free g
),
and an implementation of g
in terms of h
(g ~> Free h
),
we can obtain an implementation of f
in terms of h
(f ~> Free h
).
Thus arrows _ ~> Free _
form a category—and that also mostly implies that
Free
is a monad.
We can define iter
in that category. Like previous examples, we can define it
without thinking by using the fixed point equation of iter
.
We will call rec
this variant of iter
, because it actually behaves a lot
like fix
whose name is already taken:
rec :: (f ~> Free (f :+: g)) > (f ~> Free g)
rec f = f >>> either (rec f) id
 where 
>>>) :: (f ~> Free g) > (g ~> Free h) > (f ~> Free h)
(id :: f ~> Free f
either :: (f ~> h) > (g ~> h) > (f :+: g ~> h)
We eventually do have to think about what rec
means.
The argument f ~> Free (f :+: g)
is a recursive implementation of an
interface f
: it uses an interface f :+: g
which includes f
itself.
rec f
composes f
with either (rec f) id
, which is basically some
plumbing around rec f
.
Consequently, rec
takes a recursive program prog :: f ~> Free (f :+: g)
, and
produces a nonrecursive program f ~> Free g
, using that same result to implement
the f
calls in prog
, so only the other “external” calls in g
remain.
That third version of iter
(rec
) has similarities to both of the previous versions
(iter
and fix
).
Obviously, the whole explanation above is given from perspective of
recursion, or selfreferentiality. While fix
simply describes recursion
as fixed points, rec
provides a more elaborate model
based on an explicit notion of syntax using Free
monads.
There is also a connection to the eponymous interpretation of iter
as
iteration. Both iter
and rec
use a sum type (Either
or (:+:)
), representing
a choice: to “continue” or “break” the loop, to “recurse” or “call” an external
function.
That similarity may be more apparent when phrased in terms of lowlevel
“assemblylike” languages, controlflow graphs.
Here, programs consist of blocks of instructions, with “jump” instructions pointing
to other blocks of instructions. Those programs form a category.
The objects, i.e., interfaces, are sets of “program labels” that one can jump to.
A program p : I ==> J
exposes a set of “entry points” I
and a set of “exit
points” J
: execution enters the program p
by jumping to a label in I
, and
exits it by jumping to a label in J
. There may be other “internal jumps”
within such a program, which are not visible in the interface I ==> J
.
The operation iter : (I ==> I + J) > (I ==> J)
takes a program
p : I ==> I + J
, whose exit points are in the disjoint union of I
and J
;
iter p : I ==> J
is the result of linking the exit points in I
to the
corresponding entry points, turning them into internal jumps. With some extra
conditional constructs, we can easily implement “while” loops
(“iter
on _ > _
”) with such an operation.
Simple jumps (“jump to this label”) are pretty limited in expressiveness.
We can make them more interesting by adding return locations to jumps, which
thus become “calls” (“push a frame on the stack and jump to this label”)—to
be complemented with “return” instructions.
That generalization allows us to (roughly) implement rec
,
suggesting that those various interpretations of iter
are maybe not as
different as they seem.
iter :: (a ==> a + b) > (a ==> b)
 specializes to 
iter :: (a > Either a b) > (a > b)
coiter :: ((a, b) > a) > (b > a)
rec :: (f ~> Free (f :+: g)) > (f ~> Free g)
The notion of “iterative category” is not quite standard; here is my version in Coq which condenses the little I could digest from the related literature (I mostly skip a lot and look for equations or commutative diagrams). Those and other relevant equations can be found in the book Iteration Theories: The Equational Logic of Iterative Processes by Bloom and Ésik (in Section 5.2, Definition 5.2.1 (fixed point equation), and Theorems 5.3.1, 5.3.3, 5.3.9). It’s a pretty difficult book to just jump into though. The nice thing about category theory is that such dense formulas can be replaced with pretty pictures, like in this paper (page 7). For an additional source of diagrams and literature, a related notion is that of traced monoidal categories—every iterative category is traced monoidal.↩︎
Data.Sequence
module from the
containers library. I’ve managed to translate most of the module to Coq
so I can start proving stuff.
In this post, I will present some of the changes made in hstocoq to be able
to translate Data.Sequence
.
hstocoq had already been used to verify Data.Set
and Data.IntSet
,
and their map analogues, which are the most commonly used modules of the
containers library.^{1}
The main feature distinguishing Data.Sequence
from those is polymorphic
recursion. There were a couple of smaller issues to solve beyond that, and some
usability improvements made in the process.
As its name implies, Data.Sequence
offers a data structure to represent
sequences. The type Seq a
has a meaning similar to the type of lists [a]
,
but Seq a
supports faster operations such as indexing and concatenation
(logarithmic time instead of linear time). The implementation is actually in
Data.Sequence.Internal
, while Data.Sequence
reexports from it.
The type Seq
is a thin wrapper around the type FingerTree
which is where the fun happens.
FingerTree
is what one might call an irregular recursive type.
In the type declaration of FingerTree
,
the recursive occurrence of the FingerTree
type constructor is applied
to an argument which is not the variable which appears in the lefthand side
of the definition. The righthand side of the type declaration mentions
FingerTree (Node a)
, rather than FingerTree a
itself:
 An irregular type. (Definitions of Digit and Node omitted.)
data FingerTree a
= EmptyT
 Single a
 Deep Int (Digit a) (FingerTree (Node a)) (Digit a)
newtype Elem a = Elem a
newtype Seq a = Seq (FingerTree (Elem a))
Regular recursive types^{2} are much more common. For example, the type of lists,
List a
below, is indeed defined in terms of the same List a
as it appears on the
lefthand side:
 A regular type
data List a = Nil  Cons a (List a)
hstocoq has no trouble translating irregular recursive types such as
FingerTree
; do the naive thing and it just works.
Problems start once we look at functions involving them.
For example, consider a naive recursive size function, sizeFT
:
sizeFT :: FingerTree a > Int
sizeFT EmptyT = 0
sizeFT (Single _) = 1
sizeFT (Deep _ l m r) = sizeDigit l + sizeFT m + sizeDigit r
 This is wrong.
We want to count the number of a
in a given FingerTree a
, but the function
above is wrong. In the recursive call, m
has type FingerTree (Node a)
, so
we are counting the number of Node a
in the subtree m
, when we should
actually count the number of a
in every Node a
, and sum them up.
The function above actually counts the sum of all “digits” in a FingerTree
,
which isn’t a meaningful quantity when trees are viewed as sequences.
While it may seem roundabout, probably the most straightforward way to fix this
function is to first define foldMap
:^{3}
foldMapFT :: Monoid m => (a > m) > FingerTree a > m
foldMapFT _ EmptyT = mempty
foldMapFT f (Single x) = f x
foldMapFT f (Deep _ l m r) = foldMap f l <> foldMapFT (foldMap f) m <> foldMap f r
sizeFT :: FingerTree a > Int
sizeFT = getSum . foldMapFT (\_ > Sum 1)  Data.Monoid.Sum
What makes foldMapFT
unusual (and also sizeFT
even though its behavior is
unexpected) is that its recursive occurrence has a different type than its
signature. On the lefthand side, foldMapFT
is applied to f :: a > m
;
in its body on the righthand side, it is applied to foldMap f :: Node a > m
.
This is what it means for foldMapFT
to be polymorphic recursive: its own
definition relies on the polymorphism of foldMapFT
in order to specialize it
to a different type than its type parameter a
.
In Haskell, type parameters are often implicit; a lot of details are inferred, so we don’t think about them. In Coq, type parameters are plain function parameters. Whenever we write a lambda, if it is supposed to be polymorphic, it will take one or more extra arguments. And now, because of polymorphic recursion, it matters where type parameters are introduced relative to the fixpoint operator.
(* A polymorphic recursive foldMapFT *)
fix foldMapFT (a : Type) (m : Type) (_ : Monoid m) (f : a > m) (t : FingerTree a) : m :=
...
(* Here, foldMapFT : forall a m `(Monoid m), (a > m) > FingerTree a > m *)
(* A nonpolymorphic recursive foldMapFT, won't typecheck *)
fun (a : Type) (m : Type) (_ : Monoid m) =>
fix foldMapFT (f : a > m) (t : FingerTree a) : m :=
...
(* Here, foldMapFT : (a > m) > FingerTree a > m *)
In the body of the first function, foldMapFT
is polymorphic.
In the body of the second function, foldMapFT
is not polymorphic.
As you might have guessed, hstocoq picked the wrong version. I created an edit to make the other choice:
polyrec foldMapFT
# Make foldMapFT polymorphic recursive
The funny thing is that hstocoq internally goes out of its way to factor out the type parameters of recursive definitions, thus preventing polymorphic recursion. This new edit simply skips that step. One could consider just removing that code path, but I didn’t want that change to affect existing code. My gut feeling is that it might still be useful. It’s unlikely that there is one single rule that will work for translating all definitions to Coq, so “hey it works” is good enough for now, and things will improve as more counterexamples show up.
In Coq, functions are total. To define a recursive function, one must provide
a termination annotation justifying that the function terminates.
There are a couple of variants, but the general idea is that some quantity must
“decrease” at every recursive call (and it cannot decrease indefinitely). The
most basic annotation (struct
) names one of the arguments as “the decreasing
argument”.
hstocoq already allowed more advanced annotations to be specified as edits, but not this most basic variant—until I implemented it. It can be inferred in simple situations, but at some point it is still necessary to make it explicit.
When we write a recursive function, we refer to its decreasing argument by its
name, but what really matters is its position in the list of arguments.
For example, here is a recursive function f
with two arguments x
and y
:
fix f x y {struct y} := ...
The annotation {struct y}
indicates that y
, the second argument of f
, is
the “decreasing argument”. The function is welldefined only if all occurrences
of f
in its body are applied to a second argument which is “smaller” than y
in a certain sense.
Otherwise the compiler throws an error.
That the argument is named is a problem when it comes to hstocoq: in Haskell, some arguments don’t have names because we immediately patternmatch on them. When translated to Coq, all arguments are given generated names, and they are renamed/decomposed in the body of every function.
 A recursive function whose second argument is decreasing,
 [] or (x : xs) depending on the branch, but there is no variable to refer to it.
map :: (a > b) > [a] > [b]
map f [] = []
map f (x : xs) = f x : map f xs
hstocoq now allows specifying the decreasing argument by its position in the Haskell definition, i.e., ignoring type parameters. To implement that feature, we have to be a little careful since type parameters in Coq are parameters like any other, so they shift the positions of arguments. That turned out to be a negligible concern because, in the code of hstocoq, type parameters are kept separate from “value” parameters until a very late phase.
termination f {struct 2}
# The second argument of f is decreasing
Another potential solution is to fix the name generation to be more predictable.
The arguments of toplevel functions are numbered sequentially arg_1__
,
arg_2__
, etc., which may be fine, but local functions just keep counting from
wherever that left off (going up to arg_38__
in one case). Maybe they should
also start counting from 1.
More complex termination annotations than struct
involve arbitrary terms
mentioning those variables. For those, there is currently no workaround, one
must use those fragile names to refer to a function’s arguments.
I initially expected that some functions in Data.Sequence
would have to be
shown terminating based on the size of a tree as a decreasing measure, which
involves more sophisticated techniques than justifications based on depth.
In fact, only one function needs such sophistication (thin
, an
internal function used by liftA2
).
As mentioned earlier, the “size” of a FingerTree
is actually a little tricky
to formalize, and that makes it even harder to use as part of such
a termination annotation.
Surprisingly, the naive and “wrong” version of sizeFT
shown earlier also
works as a simpler decreasing measure for this function.
With the above two changes, hstocoq is now able to process quite
a satisfactory fragment of Data.Sequence.Internal
. A few parts are not
handled yet; they require either whole new features or more invasive edits than
I have experience with at the moment.
There remains another issue with the thin
function we just mentioned:
it is mutually recursive with another function.
hstocoq currently does not support the combination of mutually recursive
functions with termination annotations other than the basic one (struct
).
At the very beginning, hstocoq simply refused to process Data.Sequence
because hstocoq doesn’t handle pattern synonyms.
Now it at least skips pattern synonyms with a warning instead of failing.
One still has to manually add edits to ignore declarations that use pattern
synonyms, since it’s not too easy to tell whether that’s the case without
a more involved analysis than is currently done.
The remaining bits are partial functions, internally use partial functions,
or are defined by recursion on Int
and I haven’t looked into how to do it
yet.
Some changes that aren’t strictly necessary to get the job done, but made my life a little easier.
In Haskell, declarations can be written in any order (except when Template Haskell is involved) and they can refer to each other just fine.
In Coq, declarations must be ordered because of the restrictions on recursion. Type classes further complicate this story because of their implicitness: we cannot know whether an instance is used in an expression without type checking, and hstocoq currently stops at renaming.
For now, we have a “best guess” implementation using a “stable topological sort”, trying to preserve an a priori order as much as possible, putting instances before toplevel values, and otherwise ordering value declarations as they appear in the Haskell source. Of course that doesn’t always work, so there are edits to create artificial dependencies between declarations.
It took me a while to notice something wrong with the implementation: independent definitions were sorted in reverse order, which is the opposite of what a “stable sort” should do. The sort algorithm itself was fine: the obvious dependencies were satisfied. And you expect to have things to fix by hand because of the underspecified nature of the problem at that point. So any single discrepancy was easily dismissed as “just what the algorithm does”. But after getting annoyed enough that nothing was where I expected it to be, I went to investigate. The culprit was GHC^{4}: renaming produces a list of declarations in reverse order! This is usually not a problem since the order of declarations should not matter in Haskell^{5}, but in our case we have to sort the declarations in source order before applying the stable topological sort. That ensures that the order in our Coq output is similar to the order in the Haskell input.
In edits files, identifiers must be fully qualified. This prevents ambiguities since edits don’t belong to any one module.
Module names can get quite long. It was tedious to repeat Data.Sequence.Internal
over and over.
There was already an edit to rename a module, but that changes the name of
the file itself and affects other modules using that module.
I added a new edit to abbreviate a module, without those side effects.
In fact, that edit only affects the edits file it is in. The parser expands
the abbreviation on the fly whenever it encounters an identifier, and after the
parser is done, the abbreviation is completely forgotten.
module alias Seq Data.Sequence.Internal
# "Seq" is now an abbreviation of "Data.Sequence.Internal"
Ready, Set, Verify!, IFCP 2018.↩︎
I don’t know whether irregular/regular is conventional terminology, but my intuition to justify those names is that they generalize regular expressions. A regular recursive type defines a set of trees which can be recognized by a finite state machine (a tree automaton; Tree Automata, Techniques and Applications is a comprehensive book on the topic).↩︎
Link to source which looks a bit different for performance reasons.↩︎
Tested with GHC 8.4↩︎
And the AST is annotated with source locations so we don’t get lost.↩︎