This post will *not* be about Haskell but rather focus on Kotlin. My dayjob is half Haskell half Kotlin (and a tiny bit of Typescript) so I frequently have to write Kotlin code. Kotlin is certainly no Haskell but it does adress *some* of the *worst* pain points of Java and lets you sort-of write code in a functional style. Even if you’re not familiar with Kotlin but with other “modern” programming languages you should be able to follow along. Also, there is nothing specific to Kotlin in this post that you couldn’t (with relative ease) implement in any other “modern” mainstream programming language. I’ll keep the code as simple and “obvious” as possible. You can find a quick overview of the Kotlin syntax here.

Many algorithms are most naturally expressed using recursion, but the JVM is just not very good at this since it quickly runs out of stack frames. You can of course always increase the JVM stack size but this hampers the portability and safety of the code when deployed.

A special case of recursion is called **tail-recursion**. A tail-recursive function has recursive calls *only immediately after a return*. Or as stated in this StackOverflow answer:

… the return value of any given recursive step is the same as the return value of the next recursive call.

For (a contrived) example:

Such functions can be optimized into an iterative style through *tail-recursion optimization*. You can probably imagine in your head how to rewrite `countdown`

above using just a loop, and the same general transformation can be done by a compiler. In fact, Kotlin is capable of tail-recursion optimization but there is not always an easy way to express an algorithm with tail-recursion only. Instead, we can rewrite our recursive code using **trampolines**. Wikipedia has this to say about trampolines:

… a trampoline is a loop that iteratively invokes thunk-returning functions (continuation-passing style). A single trampoline suffices to express all control transfers of a program; a program so expressed is trampolined, or in trampolined style; converting a program to trampolined style is trampolining. Programmers can use trampolined functions to implement tail-recursive function calls in stack-oriented programming languages.

There are multiple blog posts out there (this, that and this one) explaining trampolines (typically in Javascript), but what they all fail to mention (as does wikipedia) is that trampolines can in fact *also* be used to express recursive functions in general, and not *only* tail-recursive functions. We’ll see how shortly but first an example of trampolining a function.

It is straightforward to port existing recursive code to trampolined code. For example the factorial function^{1}.

Note that it is *not* tail-recursive, because the last statement in the recursive case is not simply a recursive call but is “guarded” underneath the multiplication.

We can rewrite `factorial`

with trampolines as such:

```
fun tfactorial(n: Long): Trampoline<Long> =
if (n <= 1) done(n)
else delay(fun () = tfactorial(n - 1)).flatMap(fun (m) = done(m * n))
fun fact(n: Long) = tfactorial(n).run()
```

If you’re not familiar with Kotlin, the most foreign syntax for you is probably the anonymous (lambda) functions. The `fun () = ...`

argument to `delay`

introduces an anonymous function^{2} that doesn’t depend on its arguments and computes `tfactorial(n - 1)`

thus effectively delaying the execution of the recursive call to `tfactorial`

. The expression `fun (m) = done(m * n)`

binds `m`

to the result of recursive call on which we call `flatMap`

.

I’ll explain the meaning of the combinators soon, so don’t be scared if it is non-obvious! Note that the structure of the code remains the same as in the un-trampolined version, but we wrap the branches in the appropriate trampoline combinators and use `flatMap`

to use the result of a recursive call.

The examples we’ve seen so far are rather easy to rewrite in an iterative style. A slightly more involved example is the (inorder) `map`

function defined on (unlabeled) binary trees:

```
fun <A, B> map(tree: Tree<A>, f: (A) -> B): Tree<B> = when (tree) {
is Tree.Leaf -> Tree.Leaf(f(tree.item))
is Tree.Node -> {
val left = map(tree.left, f)
val right = map(tree.right, f)
Tree.Node(left, right)
}
}
```

Implementing this without recursion is a bit more difficult. Once you get the trick it’s not too complicated but essentially you’ll have invented a specialized version of a trampoline! The iterative version also lacks the declarative nature of the recursive formulation. With trampolines we can retain the recursive structure of the algorithm while avoiding overflowing the stack.

The principle of a trampoline is that instead of expressing the recursion directly in Kotlin we instead build up a data structure that encodes the recursion. Upon evaluation we then manually maintain a stack on which we store the continuations. We use a loop to iterate through the computation without using the JVM’s function stack.

Before we begin, we need a proper stack data structure. Kotlin’s built-in list is unfortunately terrible for this purpose, so we’ll quickly handroll our own.

```
sealed class ConsList<out A> {
object Nil : ConsList<Nothing>()
data class Cons<A>(val hd: A, val tl: ConsList<A>) : ConsList<A>()
fun unsafeHead(): A = when (this) {
Nil -> throw RuntimeException("unsafeHead: head on empty list")
is Cons -> hd
}
fun unsafeTail(): ConsList<A> = when (this) {
Nil -> throw RuntimeException("unsafeTail: tail on empty list")
is Cons -> tl
}
val isEmpty get() = this is Cons
}
val nil = Nil
infix fun <T>T.cons(l: ConsList<T>): ConsList<T> = Cons(this, l)
```

This is just a standard persistent linked list and a helper “infix” function used to extend it at its head.

A trampoline is built using three combinators:

`done`

encodes a base case in the recursive computation.`delay`

encodes a recursive call that does not depend on any other recursive calls. It delays the recursive call by placing it under a function with unit domain (that is, a function that just ignores its result, also called a*thunk*or a*suspension*).`flatMap`

lets you continue with the computation after the result of a recursive call.

I’ve not written down the type signatures, but perhaps you can spot that a trampoline forms a monad! It’s not important but an interesting aside.

We can encode these combinators in Kotlin as such:

```
sealed class Trampoline<out T> {
private data class Done<out T>(val t: T) : Trampoline<T>() {}
// Delay is a specialization of FlatMap but improves performance
private data class Delay<out T>(
val suspension: () -> Trampoline<T>
) : Trampoline<T>()
private data class FlatMap<T, out U>(
val waitFor: Trampoline<T>,
val cont: (T) -> Trampoline<U>
) : Trampoline<U>()
fun <U> flatMap(to: (T) -> Trampoline<U>): Trampoline<U> = FlatMap(this, to)
}
fun <T> done(t: T): Trampoline<T> = Done(t)
fun <T> delay(suspension: () -> Trampoline<T>): Trampoline<T> = Delay(suspension)
// or just FlatMap(done(Unit), { suspension() })
```

The `Delay`

constructor is not strictly necessary in terms of expressivity, since it can be encoded in terms of `FlatMap`

. However, it does allow a significant performance improvement since we can avoid allocating a continuation on the stack.

Now we can define how to run a trampolined computation. This is the signature:

The backbone of the algorithm is a while loop that runs until the trampoline is `Done`

*and* there are no continuations left. We keep track of the current result (call it `r`

) which initially is `tramp`

. We’ll define `stack`

to be a list of continuations to be run after a recursive call is `done`

. Now it is a simple matter of inspecting the current result `r`

:

- If
`r`

is`Done`

then- If there are continuations in
`stack`

then pop the first one and call it with`r.t`

. Then set`stack`

to be the rest. - Otherwise we are done and we return the result inside
`r`

.

- If there are continuations in
- If
`r`

is`Delay`

then we force the suspension and set`r`

to be the resulting trampoline. - If
`r`

is`FlatMap`

then we pop`r.cont`

on the continuation stack and set`r = r.waitFor`

.

Here is the full Kotlin code:

```
fun <T> run(tramp: Trampoline<T>): T {
var r = tramp as Trampoline<Any>
var stack: ConsList<(Any) -> Trampoline<Any>> = nil
while (true) {
when (r) {
is Done ->
if (stack.isEmpty) {
return r.t as T
} else {
r = stack.unsafeHead()(r.t)
stack = stack.unsafeTail()
}
is Delay -> {
r = r.suspension()
}
is FlatMap<*, *> -> {
stack = (r.cont as (Any) -> Trampoline<Any>) cons stack
r = r.waitFor as Trampoline<Any>
}
}
}
}
```

Unfortunately we have to subvert Kotlin’s type system in order to implement this, because it lacks heterogenous lists. It is perfectly safe though since a continuation will always be called with a result of the type it expects.

To show it off on a slightly more complicated example, here is the Fibonacci function:

```
fun fib(n: Long): Trampoline<Long> =
if (n <= 1)
done(n)
else delay (fun () = fib(n - 1)).flatMap (fun (n1) =
fib(n - 2).flatMap(fun (n2) = done(n1 + n2))
)
```

If we code-golf it a bit, use Kotlins lambda notation and add a few helper combinators we can also express it in an “applicative” style:

```
fun fib2(n: Long): Trampoline<Long> =
if (n <= 1)
done(n)
else delay { fib2(n - 1) }.zip(fib2(n - 2)).map { (n1, n2) -> n1 + n2 }
```

That’s it! Trampolined code does not run as fast as natively recursive code of course. `FlatMap`

is the biggest sinner since it requires allocating a continuation on the (heap-allocated) stack. While it may not be super performant, trampolined code is completely guarded against stack-overflow errors! If you can catch `StackOverFlowError`

s (or their equivalent) in your language, you can even run an un-trampolined version first and then resort to the trampolined algorithm if you run out of stack space.

There are other approaches to implementing trampolines. For example Scalaz directly composes trampolines when `flatMap`

ing and PureScript uses a (much more complicated) technique described in Reflection without Remorse. I can’t speak to their performance characteristics compared to the approach I’ve delineated here, and I don’t have the time for a proper comparison. They’re probably faster but this approach wins on simplicity in my opinion.

Converting normal recursive code to trampolined code is in general not difficiult:

- base cases are wrapped in
`done`

. - recursive calls are wrapped in
`delay`

. - if you need to depend on the result of a recursive call, call
`flatMap`

on it and define the rest of your computation in the lambda function.

As such, we can write our recursive algorithms and then later mechanically trampoline them to get rid of those pesky `StackOverflowError`

s.

Of course, the factorial function can be implemented simply and effectively with both loops and tail-recursion but we’ll use its recursive formulation here for expositional purposes.↩

Kotlin has some much more ergonomic syntax for lambda functions but I felt this was clearer in case the reader is not familiar with Kotlin.↩

This post is about implementing coverage checking of pattern matches using Haskell. It does not involve any super-advanced type-level trickery, so as long you're somewhat comfortable with monad transformers you should be fine.

Pattern matching coverage on generalized algebraic data types is a complicated problem, and has seen many attempts at a solution in recent years. In contrast, pattern matching on ordinary ADTs is often simply mentioned as a trivial matter and delegated to a footnoote. When I recently had to implement a coverage checking algorithm in a Haskell-like language *without* GADTs, I found that there was a dearth of information (which was not paywalled) on how to go about such a problem. Specifically, I needed to disallow not only non-exhaustive matches but also redundant matches. Eventually, I devised a solution that is a small modification of a well-known algorithm. I don't expect that there is anything academically novel about my modification, but I do wish that I hadn't spent so much time searching in vain for a ready-made solution. This blog post is my attempt at rectifying this state of affairs for those that come after me!

When dealing with pattern matching clauses, we can typically encounter two kinds of problems:

The clauses are non-exhaustive; for example

In this example, we have clearly not dealt with the case where`xs`

is a cons constructed list. If we accept such a match we can introduce divergence into our language very easily.There are one or more redundant clauses; for example

In this example, the last branch is essentially dead code, as it will never be reached.

The only information I could find on the internet on coverage checking was Conor McBride's great StackOverflow answer which explains the core idea behind Lennart Augustsson's technique for compiling pattern matches. I also found a kindred spirit in Tim Humphries who had encountered the same lack of information and devised an algorithm using tries.

The problem was that I could not get McBride's explanation to account for *redundant pattern matches*. McBride explains how to use the algorithm to flag *overlapping patterns*, but this is too strong a requirement. For example,

would be flagged as an issue, since `xs'`

strictly overlaps with `[]`

. But this is rarely what we want since we often use catch-all patterns for convenience.

While I only took a cursory look at Tim Humphries' implementation, it did not appear to make any attempt at checking anything beyond exhaustivity, so I could not steal his code shamelessly either.

After pouring over McBride's explanation for many hours, I eventually discovered how to modify it to suit my needs by introducing just a tiny bit of extra state.

With that out of the way, let us start modeling our problem in Haskell.

Since this is a literate Haskell file, we'll kick things off with some obligatory language extensions and imports.

```
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
import Control.Monad.Except (ExceptT, runExceptT, MonadError, throwError)
import Control.Monad.State (StateT, runStateT, MonadState, get, modify)
import Control.Monad.Reader (Reader, runReader, MonadReader, asks, local)
import Data.Foldable (foldlM)
import Control.Monad (replicateM)
import Data.Maybe (catMaybes)
```

None of these extensions or imports should worry you right now.

We need to define the language of types and patterns we'll be working on. Lets keep it simple.

```
data Type
= TConstr String
deriving (Eq, Show)
data Pattern ident
= PBind ident
| PMatch String [Pattern ident]
deriving (Eq, Show)
```

Types are just an open set of nullary type constructors. So for example `Unit`

or `Boolean`

or `IntList`

. Our language does not have polymorphism, but the algorithm will work fine with a bit of extra machinery for polymorphic types as well (demonstration).

Patterns are only slightly more complicated. A pattern can *bind* a value or it can *match* (destructure) a value. As an example, the clauses in

would be encoded as

We'll refrain from use infix pattern-operators like `(:)`

and instead use their "ordinary" prefix-form names (e.g. `Cons`

for `(:)`

) just to simplify our implementation and presentation.

You'll notice that `Pattern`

is parameterized over `ident`

. We use this to distinguish patterns with user-given names and fresh machine-generated names.

Disclaimer: just to be absolutely clear, this algorithm is mostly due to Augustsson and just a small extension of the outline provided by Conor McBride's StackOverflow answer. I don't pretend to have invented anything novel.

Here is a sketch of how the algorithm works.

The expression \(q\, \mathsf{coveredBy}\, ρ\) checks if an "ideal pattern" \(q\) is covered by a list of actual patterns \(ρ\). The ideal pattern starts off being a simple name-binding pattern, and is further refined when needed through the algorithm.

- If \(ρ\) is the empty list, then we cannot cover \(q\) and the match is not exhaustive.
- If there is a substitution of variables \(υ\) in \(q\) such that \(υ\, q\) (\(υ\) applied to \(q\)) equals \(\mathsf{head}(ρ)\) then:
- If the substitution \(υ\) is an
*injective renaming of variables*, then we know that \(q\) is fully covered by \(\mathsf{head}(ρ)\). Such a substitution only maps variables to variables. - Otherwise, then there is a mapping in \(υ\) that maps a variable \(x_1\) to a constructor. For each constructor \(c_i\) of \(x_1\)'s type, apply the substitution \(\left[x_1 ↦ c_i\right]\) to \(q\) giving \(q'\), and solve \(q'\, \mathsf{coveredBy}\, ρ\).

- If the substitution \(υ\) is an
- If no such substitution exists, then \(q\) cannot be covered by \(\mathsf{head}(ρ)\) and so we recurse with \(q\, \mathsf{coveredBy}\, \mathsf{tail}(ρ)\).

The algorithm above will not detect redundant patterns, but before we extend it to do so, let us see an example:

This gives the problem `xs coveredBy [Nil, Cons x' xs']`

We start comparing `xs`

to `Nil`

. There is a valid substitution \(υ\), namely `[xs ↦ Nil]`

. Since `Nil`

is not a variable, \(υ\) is not injective, so we have to "split" on `xs`

with each list constructor, giving us problems:

```
Nil coveredBy [Nil, Cons x' xs']
Cons a´ b´ coveredBy [Nil, Cons x' xs']
```

Here, `a´`

and `b´`

are fresh names, so we postfix them with a tick for clarity.

The first sub-problem has a solution of the empty substitution (which is injective) so we can discharge that. The second sub-problem will first try to find a substitution to unify `Cons a´ b´`

and `Nil`

, but no such substitution exists, so we'll discard `Nil`

and move on to the next pattern.

`Cons a´ b´ coveredBy [Cons x' xs']`

There is an obvious injective substitution, namely `[a´ ↦ x', b´ ↦ xs']`

, and the algorithm terminates with success.

In McBride's answer, he shows how to detect any *overlapping* patterns. Whenever we discharge a case through an injective substitution, we can check that there are no other covering patterns in our list. To use his example:

```
xs coveredBy [Nil, ys]
Nil coveredBy [Nil, ys] <-- overlap with ys
Cons a´ b´ coveredBy [Nil, ys]
```

But this is not what we really want, since we want to permit catch-all patterns. My solution was to simply keep track of how many times a clause was used to discharge an ideal pattern, and then check that every clause was used at least once after the algorithm terminated. Using this scheme, the example above would be permitted, whereas

would be flagged, since the last clause is redundant.

Now that we've extended the original algorithm a bit and we have a better understanding of the problem, we can try to write a more detailed algorithm in pseudo-Haskell before proceeding to the implementation.

```
checkCoverage :: IdealPattern -> List of Clauses -> Success or Failure
checkCoverage q ρ =
if q `coveredBy` ρ
then if any ρᵢ was not used return Failure (ρᵢ is redundant)
else Success
coveredBy :: IdealPattern -> List of Clauses -> Success or Failure
q `coveredBy` ρ =
if ρ is the empty list
then Failure (q is not covered!)
else
let υ = a substitution such that υ q = (head ρ) or nothing
if υ is nothing
then q `coveredBy` (tail ρ)
else
if υ is injective
then increment the usages of (head ρ) with 1
else
let x = the variable in q that must map to some constructor
let τ = typeOf x
for each c in (constructorsOf τ)
let q' = q with x substituted for c
q' `coveredBy` ρ
```

We'll start by formalizing some of the concepts used in the pseudo-code algorithm.

```
type Name = String
type ClausePattern = Pattern Name
type FreshName = Integer
type IdealPattern = Pattern FreshName
```

These type synonyms will just make our code a bit more readable. We'll also need to fetch the constructors for a type at some point, so let's define those:

For example, the constructors of `IntList`

are `Constructor "Nil" []`

and `Constructor "Cons" [TConstr "Int", TConstr "IntList"]`

.

The pseudo-code mentions substitutions, so lets define what a substitution actually is.

We'll just use a newtype wrapper around an associative list. A more efficient implementation would of course be a `Map`

, but for now let's keep things simple. Note that the domain of the substitution will alwas be `FreshName`

since we never touch the patterns that the user has defined.

Using structural recursion over `Pattern`

we can apply a substitution to a pattern, giving us a new pattern.

```
apply :: Subst FreshName -> Pattern FreshName -> Pattern FreshName
apply (Subst assocs) = go where
go (PBind i)
| Just pat' <- lookup i assocs = pat'
| otherwise = PBind i
go (PMatch nm subpats) =
PMatch nm (map go subpats)
```

We'll also need to know if a substitution is injective. We'll use a new data type to represent this.

A substitution is either injective, or not-injective due to a binding. This data type is isomorphic to `Maybe`

but `Maybe`

's established semantics do not fit very well to this problem, we we'll use our own data type.

We can easily establish whether a substitution is injective by recursing over the list it wraps.

```
isInjective :: Subst ident -> IsInjectiveResult
isInjective (Subst xs) = go xs where
go [] = Injective
go ((b, p) : xs') =
case p of
PBind _ -> go xs'
PMatch _ _ -> NotInjective b
```

If we look at the pseudo-Haskell algorithm, we can identify some helper functions that we will most definitely need. We can also see that the computation must be able to fail in a few different ways. Seems like we'll need a monad! We can create a type class that allows us to abstract over the exact representation of our computation, which will force us to stay at the domain-level when we're writing the implementation.

```
class Monad m => Coverage m where
-- get the type of a name-binding
getType :: FreshName -> m Type
-- get the constructors of a type
getConstructors :: Type -> m [Constructor]
-- extend the computation with bindings of names to types
withTypes :: [(FreshName, Type)] -> m a -> m a
-- get a fresh name
freshName :: m FreshName
-- fail a coverage check
coverageError :: CoverageError -> m a
```

A coverage-check can fail for the reasons specified in the pseudo-Haskell, but we could also encounter some more "low-level" errors, like malformed patterns, empty types or a failing lookup of types or constructors.

```
data CoverageError
= RedundantClauses [ClausePattern]
| CannotCover IdealPattern
| MalformedPattern ClausePattern
| EmptyType Type
| NoTypeFound FreshName
| NoConstructorsFound Type
deriving (Show, Eq)
```

Since we're associating a number (usages) with each input clause, we'll create a datatype to maintain this association.

```
data Clause = Clause { usages :: Integer, pattern :: ClausePattern }
useClause :: Clause -> Clause
useClause br = br { usages = usages br + 1 }
```

Looking at the specification, we could make do with a boolean field since we only keep track of the used/not-used state of clauses. I'll stick with the `Integer`

field though, as it could potentially be useful information, for debugging purposes if nothing else.

With the main plumbing out of the way, we can jump right into the implementation of the `coveredBy`

function, which checks that the patterns are exhaustive and updates the clauses with their number of usages.

```
-- the explicit forall is so we can refer back to `m` in the signature of the
-- where-binding
coveredBy :: forall m. (Coverage m) => IdealPattern -> [Clause] -> m [Clause]
coveredBy ideal [] = coverageError (CannotCover ideal)
coveredBy ideal (clause : clauses) =
ideal `hasSubst` pattern clause >>= \case
Nothing ->
(clause :) <$> coveredBy ideal clauses
Just subst ->
case isInjective subst of
Injective ->
pure (useClause clause : clauses)
NotInjective binding -> do
typ <- getType binding
constructors <- getConstructors typ
foldlM (coveredByRefined binding) (clause : clauses) constructors
where
coveredByRefined :: FreshName -> [Clause] -> Constructor -> m [Clause]
coveredByRefined fname clauses' constructor = do
(refineTo, refinedTypes) <- constructorToPattern constructor
let refined = apply (Subst [(fname, refineTo)]) ideal
withTypes refinedTypes (refined `coveredBy` clauses')
```

We update the usages of the clauses by returning them from the function. Even if we do not use a clause, we will still need to return it, so it won't "disappear" from the set of clauses for the next sub-problem. The main divergence from the pseudo-Haskell is the `coveredByRefined`

helper function, which is iterated over the constructors of the type of the binding that we're splitting on. It uses the `constructorToPattern`

function to convert a constructor of a type to a pattern.

```
constructorToPattern :: Coverage m => Constructor -> m (IdealPattern, [(FreshName, Type)])
constructorToPattern (Constructor nm args) = do
let arglen = length args
freshNames <- replicateM arglen freshName
let typeAssocs = zip freshNames args
pure (PMatch nm (map PBind freshNames), typeAssocs)
```

Here we both generate fresh names to stand in for the arguments of the constructor, but we also return a list associating the names to their appropriate types.

We also need to know if an ideal pattern can transformed into a covering pattern through a substitution, which we can define as

```
hasSubst :: Coverage m => IdealPattern -> ClausePattern -> m (Maybe (Subst Name))
hasSubst (PBind x) pat = pure . pure $ Subst [(x, pat)]
hasSubst (PMatch nm1 pats1) (PMatch nm2 pats2)
| nm1 /= nm2 =
pure Nothing
| length pats1 /= length pats2 =
coverageError (MalformedPattern (PMatch nm2 pats2))
| null pats1 = pure (Just mempty)
| otherwise =
mconcat <$> (sequence (zipWith hasSubst pats1 pats2))
hasSubst (PMatch _ _) (PBind _) = pure (Just mempty)
```

- \(x\, \mathsf{hasSubst}\, p\) is always the substitution \([x ↦ p]\).

- \((c\, p_1 \dots p_n)\; \mathsf{hasSubst}\; (c\, p'_1 \dots p'_n)\) is just the concatenation of the substitutions of the sub-patterns.

- The last case is somewhat interesting as it says that \((c\, p_1 \dots p_n)\; \mathsf{hasSubst}\; x\) is just the empty substitution. This is contrary to Augustsson's method, where this is not true. Instead, the clauses are refined along with the ideal pattern, so such a case does not occur. I could not find a good reason to do this though, so I chose to bake in this notion of generality instead.

We can now put the icing on the cake and define the function that actually aplies the coverage checking algorithm!

```
checkCoverage :: Coverage m => IdealPattern -> [ClausePattern] -> m ()
checkCoverage ideal userpats = do
checkedClausees <- ideal `coveredBy` (map asClause userpats)
case unusedPatterns checkedClausees of
[] -> pure ()
unreached -> coverageError $ RedundantClauses unreached
where
asClause pat = Clause { usages = 0, pattern = pat }
unusedPatterns clauses =
let onlyUnused = \cl -> if usages cl < 1 then Just (pattern cl) else Nothing
in catMaybes (map onlyUnused clauses)
```

It is very like the pseudo-Haskell specification, but with a bit more book-keeping to set up and tear down the state we need.

Now, we can start working out how to actually run and test our algorithm. We have to start by picking a concrete datatype to implement our `Coverage`

type class.

```
newtype CoverageM r = CoverageM
{ unCoverageM ::
ExceptT
CoverageError
(StateT CoverageState (Reader CoverageRead)) r
}
deriving ( Functor
, Applicative
, Monad
, MonadError CoverageError
, MonadState CoverageState
, MonadReader CoverageRead
)
data CoverageRead = CoverageRead
{ crTypes :: [(FreshName, Type)]
, crConstructors :: [(Type, [Constructor])]
}
type CoverageState = Integer
```

We use the `GeneralizedNewtypeDeriving`

language extension along with monad transformers to derive a bunch of nifty functionality for us! If you're not familiar with monad transformers, this might look a bit arcane, but it really is just boilerplate. To keep things simple, we again use associative lists where `Map`

might be more appropriate.

We can now make our `CoverageM`

monad an instance of our `Coverage`

type class, and then define a way to run a computation in our monad.

```
instance Coverage CoverageM where
getType uid =
asks crTypes
>>= maybe (coverageError $ NoTypeFound uid) pure . lookup uid
getConstructors typ =
asks crConstructors
>>= maybe (coverageError $ NoConstructorsFound typ) noEmptyTypes . lookup typ
where
noEmptyTypes [] = coverageError (EmptyType typ)
noEmptyTypes cs = pure cs
withTypes types = local (\r -> r { crTypes = types ++ crTypes r })
freshName = get >>= (\i -> modify (+1) >> pure i)
coverageError = throwError
runCoverageM
:: CoverageState
-> CoverageRead
-> CoverageM a
-> (Either CoverageError a, CoverageState)
runCoverageM st rd (CoverageM x) =
runReader (runStateT (runExceptT x) st) rd
```

Finally, we can test our algorithm on some example inputs. Normally, I would use a testing framework like Tasty, but for this blog post let us just do some quick and dirty testing.

```
test :: IO ()
test = do
let tunit = TConstr "Unit"
specify "simple tests" $ do
let rd = CoverageRead [0 |-> tunit] [tunit |-> [Constructor "MkUnit" []]]
runCoverageM 0 rd (checkCoverage (PBind 0) [PMatch "MkUnit" []])
`shouldBe` (Right (), 0)
runCoverageM 0 rd (checkCoverage (PBind 0) [PMatch "Just" []])
`shouldBe` (Left (CannotCover (PMatch "MkUnit" [])), 0)
runCoverageM 0 rd (checkCoverage (PBind 0) [PMatch "MkUnit" [], PBind "x"])
`shouldBe` (Left (RedundantClauses [PBind "x"]), 0)
specify "slightly more advanced" $ do
let rd = CoverageRead
[ 0 |-> TConstr "UnitList" ]
[ TConstr "UnitList" |->
[ Constructor "Nil" []
, Constructor "Cons" [tunit, TConstr "UnitList"]
]
, tunit |-> [Constructor "MkUnit" []]
]
specify "shallow match works" $ do
let branches = [PMatch "Cons" [PBind "x", PBind "xs"], PMatch "Nil" []]
runCoverageM 0 rd (checkCoverage (PBind 0) branches) `shouldBe` (Right (), 2)
specify "deep matching on head works" $ do
let branches = [PMatch "Cons" [PMatch "MkUnit" [], PBind "xs"], PMatch "Nil" []]
runCoverageM 0 rd (checkCoverage (PBind 0) branches) `shouldBe` (Right (), 2)
specify "deep matching on head works" $ do
let branches = [PMatch "Cons" [PMatch "MkUnit" [], PBind "xs"], PMatch "Nil" []]
runCoverageM 0 rd (checkCoverage (PBind 0) branches) `shouldBe` (Right (), 2)
putStrLn "All tests succeeded"
pure ()
where
specify :: String -> IO () -> IO ()
specify = flip const
(!x) `shouldBe` (!y)
| x == y = pure ()
| otherwise = error $ "Expected " ++ show x ++ " to equal " ++ show y
(|->) x y = (x,y)
```

These tests are hardly exhaustive, but they will do for our purposes. Since this algorithm is quite simple yet has real-world uses, it'd be a fun exercise to write some property-based tests for it, or even to prove some simple properties about it. Off the top of my head, I can think of

- If
`q`

is successfully covered by`ρ`

, then duplicating any pattern`ρᵢ`

in`ρ`

will cause a redundant-pattern error with`ρᵢ`

. - If
`q`

is not covered by`ρ`

, we can fix it by inserting a catch-all pattern into the end of`ρ`

. - If
`q`

is covered by`ρ`

, then`q `coveredBy` (PBind "x" : ρ)`

will cause a redundant-pattern error with`ρ`

.

Furthermore, a space/time complexity analysis of the algorithm should also be an interesting (yet surmountable) task. Haskell's lazy semantics are quite useful, but always provide for extra challenge when attempting to reason about the runtime characteristics of your code.

That's it for now, thanks for reading!