Defining Types for a Simple HTTP Server

In the last several months, we’ve gone through solutions for a multitude of LeetCode problems in Haskell. Practicing problems like these is a great step towards learning a new language. However, you’ll only get so far solving contrived problems with no extra programming context.

Another great step you can take to level up your programming skills is to write common tools from scratch. This forces you to tackle a larger context than simply the inputs and outputs of a single function. You’ll also get more familiar with techniques that are entirely absent from LeetCode problems, like filesystem operations and network mechanics. This is beneficial whether you’re learning more with your primary language or getting started with a new language.

We’re going to spend the rest of the year writing a couple small projects like this in Haskell. We’ll start by writing a simple HTTP Server in these first few weeks. Then we’ll try something more complicated.

What you’ll find with projects like these is that parsing is extremely important. In a LeetCode problem, you’re typically receiving pre-structured input data. When you’re writing a tool from scratch, your input is more often a stream of unstructured data from a file or the network, and one of your main jobs is making sense of that data! To learn some great techniques for parsing in Haskell, you should sign up for our course, Solve.hs! In Module 4, you’ll learn all about the Megaparsec library that we’ll use in this series!

Outlining Our Server

Before we dive into any code, let’s outline the basic expectations for our server - what do we expect it to do? We’re going to keep things very simple.

Our program should start a server listening on port 3000 When a user pings our server with a valid HTTP request, we should reply with a valid HTTP response using the code “200 OK”. This response should have a simple body like “This is the response body!” If we receive an invalid HTTP request, we should reply with a valid HTTP response using the code “400 Bad Request”. This 400 response should give an error message in the body.

Now there are many libraries out there for writing HTTP Servers. In fact, if you take our Practical Haskell course, you’ll learn about Servant, which uses some really cool type-level mechanics that are unique to Haskell! By using a server library, you could get all this functionality in about 10-20 lines of code (if that).

But when you’re writing something “from scratch”, you want to limit which libraries you use, so that you can focus on learning some of the lower level details. In our case, we want to focus on the details of the HTTP Protocol itself. Our objective will be to improve our understanding of the message format behind HTTP requests and responses.

This means we’re going to write our own parsing code for HTTP requests, and our own serialization code for responses. We’ll follow this guide for HTTP version 1.1. We’ll use this to help structure our data, but we won’t get too complicated. We’ll aim to correctly parse (almost) all valid requests. But as we’ll explain below, there are a lot of rules we won’t enforce, so our server will “accept” a wide variety of “invalid” requests.

Defining Types

The first thing we want to do when writing a parser is define the types of our system. This is especially true in Haskell, where it’s easy for us to define the structure of new types, and to combine our elements using sum and product types.

If you’re using open-source documentation, coming up with types is usually easy! The docs will often lay out the structure for you. For example, the the doc linked above defines an HTTP Message like so:

HTTP-message = Request | Response; HTTP/1.1 messages

We could translate this into Haskell types:

data HttpRequest = HttpRequest

data HttpResponse = HttpResponse

data HttpMessage =
  RequestMessage HttpRequest |
  ResponseMessage HttpResponse

Of course our request and response types are incomplete, and we’ll fill them in next. If we wanted, we could define each field as we parse it. When you’re writing an entirely new system, you might take this approach. Once again though, good documentation can give us an overview of the entire type. Let’s see how we can use the documentation to produce a complete “request” type.

HTTP Request

For the request, we can read the following definition in the docs:

Request       = Request-Line;
                *(( general-header;
                  | request-header;
                  | entity-header)
                 CRLF);
                CRLF
                [ message-body ];

Note that the CRLF items refer to the consecutive characters \r\n, a “carriage return” and “line feed” (AKA “new line character”). We read the full definition as 4 parts.

1. The request line (we’ll see below what information this has)
2. 0 or more headers, each terminated by CRLF. There are 3 types of headers, but they all have the same structure, as we’ll see.
3. A mandatory CRLF separating the headers from the body
4. An optional message body

The Request Line

This still isn’t specific enough to write our types. Let’s examine the “request line” for more details.

Request-Line = Method SP Request-URI SP HTTP-Version CRLF

The request line has 3 components and 3 separators (SP means a single space character ’ ‘). The first component is the “method” of the request (e.g. “Get”, “Post”). The protocol defines a series of valid methods for a request.

Method = "OPTIONS"
       | "GET"
       | "HEAD"
       | "POST"
       | "PUT"
       | "DELETE"
       | "TRACE"
       | "CONNECT"
       | extension-method
extension-method = token

If we ignore the “extension” method, we can make a simple enumerated type for the different methods, and add this as the first field in our request!

data HttpMethod =
    HttpOptions | HttpGet | HttpHead | HttpPost | HttpPut |
    HttpDelete | HttpTrace | HttpConnect
    deriving (Show, Eq)

data HttpRequest = HttpRequest
    { requestMethod :: HttpMethod
    ...
    } deriving (Show, Eq)

The “request URI” has a few different options as well.

Request-URI    = "*" | absoluteURI | abs_path | authority

Each of these has a particular structure and rules, but we’re going to simplify it considerably. We’ll just treat the URI as a ByteString, with the only restriction being that it can’t have any “space” characters, since the space is the separator.

One of the biggest gains you’ll get from a good HTTP library is breaking down request URIs into component parts, like path components and query parameters. The Servant library does this very well.

data HttpRequest = HttpRequest
    { requestMethod :: HttpMethod
    , requestUri :: ByteString
    ...
    } deriving (Show, Eq)

The last item in the request line is the “HTTP Version”. Here’s the spec from the documentation:

HTTP-Version   = "HTTP" "/" 1*DIGIT "." 1*DIGIT

The two values we care about are the major and minor version numbers. For example, HTTP/1.0 gives the major version 1 and the minor version 0. As a practical matter, we only care about very small integer (<256), data-preserve-html-node="true" so each of these. So we can represent the version of the request with a tuple (Word8, Word8).

import Data.Word (Word8)

data HttpRequest = HttpRequest
    { requestMethod :: HttpMethod
    , requestUri :: ByteString
    , requestHttpVersion :: (Word8, Word8)
    ...
    } deriving (Show, Eq)

So now our type is representing all the parts of the request line. Let’s move on to the rest of the request.

Headers & Body

Now let’s tackle headers. As we mentioned before, there are several types of headers (general, request, response, entity), but they all have the same basic structure. Here is that structure:

message-header = field-name ":" [ field-value ]
 field-name     = token
 field-value    = *( field-content | LWS )
 field-content  = <the OCTETs making up the field-value
                  and consisting of either *TEXT or combinations
                  of token, separators, and quoted-string>

There are references to LWS, which is “leading white space”. But at a basic level, a header consists of a “name” and a “value”, separated by a colon. We’ll treat both the name and value as bytestrings. Then we want to use some kind of a map to match the names with the values. So we’ll add this field to our type:

import qualified Data.HashMap.Lazy as HM

​​newtype HttpHeaders = HttpHeaders
    (HM.HashMap ByteString ByteString)
    deriving (Show, Eq)

data HttpRequest = HttpRequest
    { requestMethod :: HttpMethod
    , requestUri :: ByteString
    , requestHttpVersion :: (Word8, Word8)
    , requestHeaders :: HttpHeaders
    ...
    } deriving (Show, Eq)

We use a newtype to package this map away in a type-safe manner.

Finally, we have the “Body” of the request. In general, this is simply a ByteString. We could represent empty request bodies with an empty bytestring. But since there’s a meaningful semantic difference between a request that has a body and one that doesn’t, we can also use a Maybe value.

data HttpResponse = HttpResponse
    { responseHttpVersion :: (Word8, Word8)
    , responseStatusCode :: Int
    , responseReason :: ByteString
    , responseHeaders :: HttpHeaders
    , responseBody :: Maybe ByteString
    }
    deriving (Show, Eq)

This completes our request type!

The Response Type

Any server that receives a request should be able to produce a valid response, so we need to define that type as well. The good news is that the documentation shows that a response is very similar to a request in its structure:

Response = Status-Line;
           *(( general-header;
           | response-header;
           | entity-header ) CRLF);
           CRLF
           [ message-body ]

There are only two differences. First a response has a “status line” instead of a “request line”. Second, it has “response-header” as an option instead of “request-header”. This second difference doesn’t affect our type, so we’ll go ahead and start outlining the response like this:

data HttpResponse = HttpResponse
    { ...
    , responseHeaders :: HttpHeaders
    , responseBody :: Maybe ByteString
    }
    deriving (Show, Eq)

Now we just have to understand the response line. Here is its specification:

Status-Line = HTTP-Version SP Status-Code SP Reason-Phrase CRLF

This has a similar structure to the request line, but different data in a different order. The HTTP version comes first. Then comes a status code (e.g. 200 = OK, 400 = client error, etc.). Finally, we have a “reason” for the response code (e.g. “OK”, “Bad Request”, “Forbidden”).

We’re already representing the version as (Word8, Word8). The status code is a straightforward Int, and the reason is just going to be a Bytestring. So it’s easy to fill out the rest of this response type:

data HttpResponse = HttpResponse
    { responseHttpVersion :: (Word8, Word8)
    , responseStatusCode :: Int
    , responseReason :: ByteString
    , responseHeaders :: HttpHeaders
    , responseBody :: Maybe ByteString
    }
    deriving (Show, Eq)

Now we have our fundamental types! Here’s the complete code for our request and response types, including imports and subtypes:

import Data.Word (Word8)
import qualified Data.HashMap.Lazy as HM
import Data.ByteString.Lazy (ByteString)

data HttpMethod =
    HttpOptions | HttpGet | HttpHead | HttpPost | HttpPut |
    HttpDelete | HttpTrace | HttpConnect
    deriving (Show, Eq)

newtype HttpHeaders = HttpHeaders
    (HM.HashMap ByteString ByteString)
    deriving (Show, Eq)

data HttpRequest = HttpRequest
    { requestMethod :: HttpMethod
    , requestUri :: ByteString
    , requestHttpVersion :: (Word8, Word8)
    , requestHeaders :: HttpHeaders
    , requestBody :: Maybe ByteString
    }
    deriving (Show, Eq)

data HttpResponse = HttpResponse
    { responseHttpVersion :: (Word8, Word8)
    , responseStatusCode :: Int
    , responseReason :: ByteString
    , responseHeaders :: HttpHeaders
    , responseBody :: Maybe ByteString
    }
    deriving (Show, Eq)

Conclusion

That’s all for the first part of this series. Next week in Part 2, we’ll write code to parse a request on our server using Megaparsec. For an in-depth tutorial on parsing in Haskell, including using this powerful library, you should sign up for Solve.hs, our Haskell problem solving course! Module 4 goes into a lot of detail on parsing, and allows you to build your own parser from scratch!

by James Bowen at November 03, 2025 09:30 AM

Computer Says No: Error Reporting for LTL

Quickstrom is a property-based testing tool for web applications, using QuickLTL for specifying the intended behavior. QuickLTL is a linear temporal logic (LTL) over finite traces, especially suited for testing. As with many other logic systems, when a formula evaluates to false — like when a counterexample to a safety property is found or a liveness property cannot be shown to hold — the computer says no. That is, you get “false” or “test failed”, perhaps along with a trace. Understanding complex bugs in stateful systems then comes down to staring at the specification alongside the trace, hoping you can somehow pin down what went wrong. It’s not great.

Instead, we should have helpful error messages explaining why a property does not hold; which parts of the specification failed and which concrete values from the trace were involved. Not false, unsat, or even assertion error: x != y. We should get the full story. I started exploring this space a few years ago when I worked actively on Quickstrom, but for some reason it went on the shelf half-finished. Time to tie up the loose ends!

The starting point was Picostrom, a minimal Haskell version of the checker in Quickstrom, and Error Reporting Logic (ERL), a paper introducing a way of rendering natural-language messages to explain propositional logic counterexamples. I ported it to Rust mostly to see what it turned into, and extended it with error reporting supporting temporal operators. The code is available at codeberg.org/owi/picostrom-rs under the MIT license.

Between the start of my work and picking it back up now, A Language for Explaining Counterexamples was published, which looks closely related, although it’s focused on model checking with CTL. If you’re interested in other related work, check out A Systematic Literature Review on Counterexample Explanation in Model Checking.

All right, let’s dive in!

QuickLTL and Picostrom

A quick recap on QuickLTL is in order before we go into the Picostrom code. QuickLTL operates on finite traces, making it suitable for testing. It’s a four-valued logic, meaning that a formula evaluates to one of these values:

• definitely true
• definitely false
• probably true
• probably false

It extends propositional logic with temporal operators, much like LTL:

next_d(P)

P must hold in the next state, demanding a next state is available. This forces the evaluator to draw a next state.

next_f(P)

P must hold in the next state, defaulting to definitely false if no next state is available.

next_t(P)

P must hold in the next state, defaulting to probably true if no next state is available.

eventually_N(P)

P must hold in the current or a future state. It demands at least N states, evaluating on all available states, finally defaulting to probably false.

always_N(P)

P must hold in the current and all future states. It demands at least N states, evaluating on all available states, finally defaulting to probably true.

You can think of eventually_N(P) as unfolding into a sequence of N nested next_d, wrapping an infinite sequence of next_f, all connected by ∨. Let’s define that inductively with a coinductive base case:

$$ \begin{align} \text{eventually}_0(P) & = P \lor \text{next}_F(\text{eventually}_0(P)) \\ \text{eventually}_(N + 1)(P) & = P \lor \text{next}_D(\text{eventually}_N(P)) \\ \end{align} $$

And similarly, always_N(P) can be defined as:

$$ \begin{align} \text{always}_0(P) & = P \land \text{next}_T(\text{always}_0(P)) \\ \text{always}_(N + 1)(P) & = P \land \text{next}_D(\text{always}_N(P)) \\ \end{align} $$

This is essentially how the evaluator expands these temporal operators, but for error reporting reasons, not exactly.

Finally, there are atoms, which are domain-specific expressions embedded in the AST, evaluating to ⊤ or ⊥. The AST is parameterized on the atom type, so you can plug in an atom language of choice. An atom type must implement the Atom trait, which in simplified form looks like this:

trait Atom {  type State;   fn eval(&self, state: &Self::State) -> bool;   fn render(  &self,   mode: TextMode,   negated: bool,  ) -> String;   fn render_actual(  &self,   negated: bool,   state: &Self::State,  ) -> String; }

For testing the checker, and for this blog post, I’m using the following atom type:

enum TestAtom {  Literal(u64),  Select(Identifier),  Equals(Box<TestAtom>, Box<TestAtom>),  LessThan(Box<TestAtom>, Box<TestAtom>),  GreaterThan(Box<TestAtom>, Box<TestAtom>), }  enum Identifier {  A,  B,  C, }

Evaluation

The first step, like in ERL, is transforming the formula into negation normal form (NNF), which means pushing down all negations into the atoms:

enum Formula<Atom> {  Atomic {  negated: bool,  atom: Atom,  },  // There's no `Not` variant here!  ... }

This makes it much easier to construct readable sentences, in addition to another important upside which I’ll get to in a second. The NNF representation is the one used by the evaluator internally.

Next, the eval function takes an Atom::State and a Formula, and produces a Value:

enum Value<'a, A: Atom> {  True,  False { problem: Problem<'a, A> },  Residual(Residual<'a, A>), }

A value is either immediately true or false, meaning that we don’t need to evaluate on additional states, or a residual, which describes how to continue evaluating a formula when given a next state. Also note how the False variant holds a Problem, which is what we’d report as definitely false. The True variant doesn’t need to hold any such information, because due to NNF, it can’t be negated and “turned into a problem.”

I won’t cover every variant of the Residual type, but let’s take one example:

 enum Residual<'a, A: Atom> {  // ...  AndAlways {  start: Numbered<&'a A::State>,  left: Box<Residual<'a, A>>,  right: Box<Residual<'a, A>>,  },  // ... }

When such a value is returned, the evaluator checks if it’s possible to stop at this point, i.e. if there are no demanding operators in the residual. If not possible, it draws a new state and calls step on the residual. The step function is analogous to eval, also returning a Value, but it operates on a Residual rather than a Formula.

The AndAlways variant describes an ongoing evaluation of the always operator, where the left and right residuals are the operands of ∧ in the inductive definition I described earlier. The start field holds the starting state, which is used when rendering error messages. Similarly, the Residual enum has variants for ∨, ∧, ⟹, next, eventually, and a few others.

When the stop function deems it possible to stop evaluating, we get back a value of this type:

enum Stop<'a, A: Atom> {  True,  False(Problem<'a, A>), }

Those variants correspond to probably true and probably false. In the false case, we get a Problem which we can render. Recall how the Value type returned by eval and step also had True and False variants? Those are the definite cases.

Rendering Problems

The Problem type is a tree structure, mirroring the structure of the evaluated formula, but only containing the parts of it that contributed to its falsity.

enum Problem<'a, A: Atom> {  And {  left: Box<Problem<'a, A>>,  right: Box<Problem<'a, A>>,  },  Or {  left: Box<Problem<'a, A>>,  right: Box<Problem<'a, A>>,  },  Always {  state: Numbered<&'a A::State>,  problem: Box<Problem<'a, A>>,  },  Eventually {  state: Numbered<&'a A::State>,  formula: Box<Formula<A>>,  },  // A bunch of others... }

I’ve written a simple renderer that walks the Problem tree, constructing English error messages. When hitting the atoms, it uses the render and render_actual methods from the Atom trait I showed you before.

The mode is very much like in the ERL paper, i.e. whether it should be rendered in deontic (e.g. “x should equal 4”) or indicative (e.g. “x equals 4”) form:

enum TextMode {  Deontic,  Indicative, }

The render method should render the atom according to the mode, and render_actual should render relevant parts of the atom in a given state, like its variable assignments.

With all these pieces in place, we can finally render some error messages! Let’s say we have this formula:

eventually₁₀(B = 3 ∧ C = 4)

If we run a test and never see such a state, the rendered error would be:

Probably false: eventually B must equal 3 and C must equal 4, but it was not observed starting at state 0

Neat! This is the kind of error reporting I want for my stateful tests.

Implication

You can trace why some subformula is relevant by using implication. A common pattern in state machine specs and other safety properties is:

precondition ⟹ before ∧ next_t(after)

So, let’s say we have this formula:

always_N((A > 0) ⟹ (B > 5 ∧ next_t(C < 10)))

If B or C are false, the error includes the antecedent:

Definitely false: B must be greater than 5 and in the next state, C must be less than 10 since A is greater than 0, […]

Small Errors, Short Tests

Let’s consider a conjunction of two invariants. We could of course combine the two atomic propositions with conjunction inside a single always(...), but in this case we have the formula:

always(A < 3) ∧ always(B < C)

An error message, where both invariants fail, might look the following:

Definitely false: it must always be the case that A is less than 3 and it must always be the case that B is greater than C, but A=3 in state 3 and B=0 in state 3

If only the second invariant (B < C) fails, we get a smaller error:

Definitely false: it must always be the case that B is greater than C, but B=0 and C=0 in state 0

And, crucially, if one of the invariants fail before the other we also get a smaller error, ignoring the other invariant. While single-state conjunctions evaluate both sides, possibly creating composite errors, conjunctions over time short-circuit in order to stop tests as soon as possible.

Diagrams

Let’s say we have a failing safety property like the following:

next_d(always₈(B < C))

The textual error might be:

Definitely false: in the next state, it must always be the case that B is greater than C, but B=13 and C=15 in state 6

But with some tweaks we could also draw a diagram, using the Problem tree and the collected states:

Or for a liveness property like next_d(eventually₈(B = C)), where there is no counterexample at a particular state, we could draw a diagram showing how we give up after some time:

These are only sketches, but I think they show how the Problem data structure can be used in many interesting ways. What other visualizations would be possible? An interactive state space explorer could show how problems evolve as you navigate across time. You could generate spreadsheets or HTML documents, or maybe even annotate the relevant source code of some system-under-test? I think it depends a lot on the domain this is applied to.

No Loose Ends

It’s been great to finally finish this work! I’ve had a lot of fun working through the various head-scratchers in the evaluator, getting strange combinations of temporal operators to render readable error messages. I also enjoyed drawing the diagrams, and almost nerd-sniped myself into automating that. Maybe another day. I hope this is interesting or even useful to someone out there. LTL is really cool and should be used more!

The code, including many rendering tests cases, is available at codeberg.org/owi/picostrom-rs.

A special thanks goes to Divyanshu Ranjan for reviewing a draft of this post.

October 31, 2025 11:00 PM

Applicative code —the IDE for functional programming— is now in beta and sports a Bluesky account to…

Applicative Code (@code.applicative.co)

Applicative code —the IDE for functional programming— is now in beta and sports a Bluesky account to follow!

October 31, 2025 11:04 AM

Case Study: Debugging a Haskell space leak

As part of their Haskell Ecosystem Support Package, QBayLogic asked us to investigate a space leak in one of their Haskell applications, a simulation of a circuit using Clash. The starting point was a link to a ticket in the bittide-hardware package with reproduction instructions.

This post explains the debugging process which led to the resolution of this ticket. At the start of the investigation the program used 2 GB memory, at the end, about 200 MB, an improvement of approximately 10x!

First impressions

I first looked at the ticket report to get an idea of the problem.

• The ticket contained a profile generated by eventlog2html which showed a profile of a program which runs in two phases. During these two phases the memory increased before resetting to some baseline and then increasing again.
• Reproduction instructions were provided in the subsequent comment, I could run these easily to reproduce the issue. I altered the options to use the -hT profiling mode to generate a basic heap profile without needing to compile with profiling support. This is a useful technique to get an initial handle on the problem.
• The instructions used profiling-detail: all-functions, which will insert many cost centres into the program which will significantly affect the runtime characteristics of the resulting program. I replaced this with profiling-detail: late.

Most importantly, the ticket lacked a precise description about what the issue was with the profile. It may have been that this was exactly the memory profile that the program should exhibit! When starting to think about memory issues, thinking about memory invariants is a very helpful technique. The first question I ask myself is:

What is the memory invariant that the program should uphold?

This situation was a useful test of this technique, since I had no domain knowledge of what the program did, what the test did or what function the library even aimed to perform. It certainly highlighted to me the importance of knowing your domain and knowing the invariants.

Memory invariants

A memory invariant is a property that your program’s heap should obey. Establishing a memory invariant makes it easier to verify and fix memory issues, since if you have a precise invariant, it is easy to check whether the invariant holds.

A memory invariant consists of two parts:

• A predicate on the heap
• The timeline over which the predicate should hold

For example, some predicates on the heap might be:

• “No constructors of type T are alive”
• “There is an upper bound of 20000 bytestrings”
• “There are exactly 5 live closures of type T”
• “No closures of type T are reachable from closures of type Q”

When paired with a timeline, a memory invariant is formed. Example timelines include:

• “Before the second phase of the program”
• “During the cleanup phase”
• “After initialisation”
• “Between runs 10 and 100”
• “At all points of the program’s execution”

Establishing a memory invariant requires domain knowledge about the program. Without first establishing an invariant (even informally in your head), you can’t begin to debug memory usage of a program. The main challenge for me when investigating this issue was coming up with a memory invariant.

Initial investigation

In order to get an idea of how to proceed, I generated a “Profile by Closure Type” using the -hT runtime system option.

cabal run bittide-instances:unittests -- -p RegisterWb +RTS -hT -l -RTS

The result was a unittests.eventlog file which contains the profiling information.

I rendered this eventlog using eventlog2html and inspected the result in my browser.

eventlog2html unittests.eventlog

The profile shows a coarse breakdown by the type of closures currently alive on the heap. The maximum value reported in the profile is about 600 MB. This value relates to the total memory used by the process (2 GB), but doesn’t include additional memory used by the RTS. The relationship between live bytes and OS memory usage is explained fully in this blog post. Reducing live memory is a good way to reduce the overall memory usage of your program, but it isn’t the only factor.

The top four bands came from

• Clash.Signal.Internal.:-
• Protocols.Wishbone.Wishbone.S2M
• THUNK_1_0
• 2-tuples (,)

and as can be easily seen from the “detailed pane”, the patterns of allocation of these top four bands closely align with each other:

Looking at these correlations in the detailed pane can be invaluable in understanding the root issue, since memory issues are normally about different closures retaining each other, they are allocated together and retained together. Seeing these overall patterns can give you context about what exact kind of thing is using the memory.

Without a clear memory invariant, I wanted to get a better idea about these top 4 bands of allocation, I had a hypothesis at this stage that the THUNK closures were contained within tuples, which were retaining the WishboneS2M and :- constructors.

A more specific profile with info table provenance

I want to know information about the precise source location of the :-, WishboneS2M constructors and thunks. Therefore I enabled a few more debugging options to add this information to the binary:

• -finfo-table-map: Gives a source location to each thunk and data constructor
• -fdistinct-constructor-tables: Distinguishes between allocation sites of each constructor

Then if you make a profile using the -hi option, you get a very fine-grained breakdown about where exactly in your program to start looking. That’s useful for me since I didn’t yet look at any of the source code!

cabal run bittide-instances:unittests -- -p RegisterWb +RTS -hi -l -RTS

After consulting the source code in the relevant places, I quickly realised that this wouldn’t necessarily be as straightforward an investigation as I had hoped. I had hoped that the THUNK_1_0 locations reported in the -hT profile would be clear that my hypothesis about retaining was correct, but the -hi profile didn’t show up anything directly wrong. These locations were normal ways you could construct a Clash circuit.

At this stage my lack of a memory invariant or some domain knowledge was a hindrance. I took the opportunity to consult Ben who knew about the Clash ecosystem and asked on the ticket what the expected profile should look like.

• The program is simulating a digital circuit.
• The :- constructor represents a single time-step of simulation.
• The expected memory profile is to use a constant (or near constant) amount of memory, since the circuit being simulated has bounded size.

For this program, a plausible invariant might have been: the number of :- constructors should remain roughly constant during simulation.

With this knowledge, the number of :- constructors alive seemed to be the biggest unexpected source of memory usage. Knowing that :- is a data constructor with two arguments, Each allocation is 24 bytes, so 240 MB of live :- closures corresponds to roughly 10 million constructors. That is certainly an issue.

Secondly, the number of live WishboneS2M constructors looked wrong. I didn’t have a good idea of the domain still, but by similar arithmetic, many millions of these are also resident on the heap.

These two facts gave me some further avenues to investigate but I was going to need to use ghc-debug to investigate further.

Using ghc-debug to investigate retainers

Using ghc-debug I wanted to establish

• What was retaining :- constructors
• What was retaining WishboneS2M constructors

Therefore I instrumented the test executable, and launched ghc-debug-brick in order to query what was retaining :- and WishboneS2M. This was the start of making progress on the investigation.

To find the retainers of :-, I paused the test program just after the test started and used the “Find retainers” command in ghc-debug-brick. The result was a list of 100 :- closures, and when expanded, each one shows the path which was taken to reach it. It wasn’t very important where I paused, as long as it was in this initial period, since we saw in the profile that the :- closures are alive and linearly increasing for the whole phase.

When looking at retainers of :-, it was immediately noticeable that the program contained very long chains of :- constructors (upwards of 5000 long). This looked wrong to me, since my understanding was that :- was being used as a control operation to drive the simulation of the circuit.

The information about where each :- constructor was allocated is not very informative. That just gives me a location inside the library functions.

The question then becomes, why is :- being retained? I scrolled, for a long while, and eventually get to the point where the chain of :- constructors is retained by a non-:- constructor. That’s the interesting part since it’s the part of the program which led to the long chain being retained.

At the time, I didn’t think this looked so interesting, but also I didn’t know what I was looking for exactly.

So I kept going down the stack, looking for anything which looked suspicious. In the end, I got quite lucky: I found a tuple which was retained by a thunk. Since I had compiled with profiling enabled, I could see the cost centre stack where the thunk was allocated, which pointed to the implementation of singleMasterInterconnectC.

Culprit 1: lazy unzip

In the source code of singleMasterInterconnectC, I worked out this part of the allocation was coming from these calls to unzip.

  go (((), m2s), unzip -> (prefixes, unzip -> (slaveMms, s2ms))) = ((SimOnly memMap, s2m), (\x -> ((),     ((), x))) <$> m2ss)

Then I looked at the definition of unzip, and found it was defined in a very lazy manner.

unzip :: Vec n (a,b) -> (Vec n a, Vec n b)
unzip xs = (map fst xs, map snd xs)

With this definition, the thunk created by applying map to fst and xs retains a reference to xs, which retains a reference to all the bs as well as the as. In a definition which performs a single iteration, if you force either list, both will be evaluated and leave no reference to the other half. I changed this definition to one which performed a single iteration and this had a massive positive effect on memory usage.

unzip xs
  | clashSimulation = unzipSim xs
  | otherwise = (map fst xs, map snd xs)
 where
  unzipSim :: Vec m (a,b) -> (Vec m a, Vec m b)
  unzipSim Nil = (Nil, Nil)
  unzipSim (~(a,b) `Cons` rest) =
    let (as, bs) = unzipSim rest
    in (a `Cons` as, b `Cons` bs)

This issue was hard to spot with the tools, I got lucky, but it was harder to spot since unzip was also marked as INLINE. In the end, I guessed right, but it’s a bit unsatisfying to not have a great story about how I worked it out, but I knew the answer was somewhere in the retainer stack I was looking at, and eventually I looked in the right place.

This problem is similar to one you can encounter when using conduit and similar libraries. In short, by sharing a thunk between two consumers, the input structure can be retained longer than intended. Since one part of the program continues by evaluating the thunk, the other reference is updated to the result of the thunk being evaluated. This is a problem though, since the original structure was intended to be used for control and discarded immediately after driving the next step of execution.

Culprit 2: lazy record update retains old field values

Once the original problem had been fixed, memory usage was much improved. I circled back to the start to look at a modified -hT profile. Perhaps there were still other problems lurking?

The final phase of memory usage looks much better, so I turned my attention to the initial phase. In the initial phase, it looked like OUTPUT was increasing linearly.

I turned to ghc-debug again, inspected the retainers of the OUTPUT constructor and discovered that the fields of WishboneM2S were not being strictly updated, indirectly keeping a reference to the OUTPUT constructor.

I looked at the source location that WishboneM2S was allocated,

and made the update strict:

     toSlaves =
-      (\newStrobe -> (updateM2SAddr newAddr master){strobe = strobe && newStrobe})
+      (\newStrobe -> strictM2S $ (updateM2SAddr newAddr master){strobe = strobe && newStrobe})
         <$> oneHotOrZeroSelected
     toMaster
       | busCycle && strobe =
@@ -152,10 +152,8 @@ singleMasterInterconnect (fmap pack -> config) =
             (maskToMaybes slaves oneHotOrZeroSelected)
       | otherwise = emptyWishboneS2M

+    strictM2S (WishboneM2S !a !b !c !d !e !f !g !h !i) = WishboneM2S a b c d e f g h i

This resulted in another reduction in memory usage:

Culprit 3: lack of sharing in iterate

When I returned to the profile a final time, the memory usage seemed much better, especially in the initial section. I had now eliminated retained :- constructors, so the overall memory usage was much lower, but still increasing slightly. I turned to a -hi profile again to get more information about the THUNK bands.

Looking at the source code for the sat_ssVQ thunks, they come from the Clash.Sized.Vector.map function. Therefore… back to ghc-debug to see what retains these map thunks, and the callstack where they are allocated from. This time I used “Find Retainers (Exact)”, to find closures which are named sat_ssVQ_info.

The first one I looked at, I found was allocated from iterateI by inspecting the cost centre stack.

iterateI was implemented as follows:

iterateI :: forall n a. KnownNat n => (a -> a) -> a -> Vec n a
iterateI f a = xs
  where
    xs = init (a `Cons` ws)
    ws = map f (lazyV xs)

Reasoning about the definition, you can see that iterateI will result in a vector of the form:

a `Cons` map f (a `Cons` (map f (a `Cons` ...)))

As a result, each element of the vector will independently compute f^n a, no intermediate results will be shared, a quadratic amount of thunks for the n applications of f will be allocated.

Defining iterateI in a directly recursive style means only a linear amount of thunks will be allocated and f will be computed only a linear number of times.

iterateU :: UNat n -> (a -> a) -> a -> Vec n a
iterateU UZero _ _ = Nil
iterateU (USucc s) f a = a `Cons` iterateU s f (f a)

Even better, for the specific example, was to use a strict accumulator, so no intermediate thunks were allocated or retained in the early part of the program.

Final result

The final profile shows slightly higher memory usage in the initial phase of the program’s execution than the second phase, but looking at the detailed pane, I could identify why the memory was retained.

Overall, the total memory usage decreased from about 2 GB to 200 MB. There is probably still some improvement which can be made to this profile, but we felt like it was a good place to stop for this post.

Conclusion

The goal of this post is to document the thought process involved in investigating a memory issue. Overall, I feel like I would have found it easier to fix the problem with some domain knowledge. Once I acquired some knowledge about the domain I made much more rapid progress about what to investigate.

The main cause of the memory leak was not obvious, and I got a bit lucky in finding the right place. One issue being the problem was obfuscated by the problematic definition being inlined. In general, with a busy heap, finding the needle can be quite tricky. Debugging the subsequent issues was more straightforward.

In the future, we want to explore more reliable ways to identify and investigate the kinds of memory invariants that were violated in this program. For example, it was crucial to know that :- should not be retained, perhaps additional language design can express that property more clearly. On another note, a logical specification of memory invariants could be useful to automatically detect and pause the program at the exact point a violation was detected. There remains significant potential to improve our memory debugging tooling!

This work was performed for QBayLogic as part of their Haskell Ecosystem Support Package. If your company is using Haskell and from time to time requires expert help in issues like this, our packages fund maintenance on core tooling such as GHC and Cabal, as well as development or support for your specific issues. Please contact info@well-typed.com if we might be able to help you!

by matthew at October 31, 2025 12:00 AM

72: Manuel Chakravarty

In this episode, we talk to Manuel Chakravarty - specifically, his work on the ghc backend such as data-parallel Haskell and the FFI  and how that work segued into type system design. We also discussed Manuel's perspective on Haskell from the language design of Swift.

by Haskell Podcast at October 30, 2025 10:00 AM

Continuous Performance Testing: staying fast

The performance of a system is critical to the user experience. Whether it’s a website, mobile app, or service, users demand fast response and seamless functionality. Every change to a system brings the risk of performance degradation, so you should check every commit during development to ensure that loyal users do not face any performance issues.

From my experience, one of the most effective methods to achieve this is with Continuous Performance Testing (CPT). In this post, I want to explain how CPT is effective in catching performance-related issues during development. CPT is a performance testing strategy, so you might benefit from a basic understanding of the latter. A look at my previous blog post will be helpful!

What is Continuous Performance Testing?

Continuous Performance Testing (CPT) is an automated and systematic approach to performance testing, leveraging various tools to spontaneously conduct tests throughout the development lifecycle. Its primary goal is to gather insightful data, providing real-time feedback on how code changes impact system performance and ensuring the system is performing adequately before proceeding further.

As shown in the example below, CPT is integrated directly into the Continuous Integration and Continuous Deployment (CI/CD) pipeline. This integration allows performance testing to act as a crucial gatekeeper, enabling quick and accurate assessments to ensure that software meets required performance benchmarks before moving to subsequent stages.

A key benefit of this approach is its alignment with shift-left testing, which emphasizes bringing performance testing earlier into the development lifecycle. By identifying and addressing performance issues much sooner, teams can avoid costly late-stage fixes, improve software quality, and accelerate the overall development process, ultimately ensuring that performance standards and Service Level Agreements (SLAs) are consistently met.

To which types of performance testing can CPT be applied?

Continuous performance testing can be applied to the all types of performance testing. However each types has different challenges.

Automated Performance Testing is

• Easily applied to load testing
• Hard to apply to stress and spike tests, but still has benefits
• Very hard to apply to soak-endurance tests

For more details about why the latter two performance testing types are difficult to implement in CI/CD, see the previous blog post.

Why prefer automated load testing?

The load test is designed with the primary objective of assessing how well the system performs under a specific and defined load. This type of testing is crucial for evaluating the system’s behavior and ensuring it can handle expected levels of user activity or data processing. The success of a load test is determined by its adherence to predefined metrics, which serve as benchmarks against which the system’s performance is measured. These metrics might include factors such as response times, throughput, and resource utilization. Given this focus on quantifiable outcomes, load testing is considered the most appropriate, easiest and well-suited type of performance testing type for Continuous Performance Testing (CPT).

How to apply continuous load testing

Strategy

Performance testing can be conducted at every level, starting with unit testing. It should be tailored to evaluate the specific performance requirements of each development stage, ensuring the system meets its capabilities and user expectation.

Load testing can be performed at any level—unit, integration, system, or acceptance. In Continuous Performance Testing (CPT), performance testing should start as early as possible in the development process to provide timely feedback, especially at the integration level. Early testing helps identify bottlenecks and optimize the application before progression. When CPT is applied at the system level, it offers insights into the overall performance of the entire system and how components interact, helping ensure the system meets its performance goals.

In my opinion, to maximize CPT benefits, it’s best to apply automated load testing at both integration and system level. This ensures realistic load conditions, highlights performance issues early, and helps optimize performance throughout development for a robust, efficient application.

Evaluation with static thresholds

Continuous Performance Testing (CPT) is fundamentally centered around fully automated testing processes, meaning that the results obtained from performance testing must also be evaluated automatically to ensure efficiency and accuracy. This automatic evaluation can be achieved in different ways. Establishing static metrics that serve as benchmarks against which the current results can be measured is one of them. By setting and comparing against these predefined metrics, we can effectively assess whether the application meets the required performance standards.

The below code snippet shows how we can set threshold values for various metrics with K6. K6 is an open source performance testing tool built in Go and it allows us to write performance testing scripts in Javascript, and it has an embedded threshold feature that we can use to evaluate the performance test results. For more information about setting thresholds, please see the documentation of K6 thresholds.

import { check, sleep } from "k6"
import http from "k6/http"

export let options = {
  vus: 250, // number of virtual users
  duration: "30s", // duration of the test
  thresholds: {
    http_req_duration: [
      "avg<20", // average response time must be below 2ms
      "p(90)<30", // 90% of requests must complete below 3ms
      "p(95)<40", // 95% of requests must complete below 4ms
      "max<50", // max response time must be below 5ms
    ],
    http_req_failed: [
      "rate<0.01", // http request failures should be less than 1%
    ],
    checks: [
      "rate>0.99", // 99% of checks should pass
    ],
  },
}

With the example above, K6 tests the service for 30 seconds with 250 virtual users and compares the results to the metrics defined in the threshold section. Let’s look at the results of this test:

running (0m30.0s), 250/250 VUs, 7250 complete and 0 interrupted iterations
default   [ 100% ] 250 VUs  30.0s/30s

     ✓ is status 201
     ✓ is registered

   ✓ checks.........................: 100.00% 15000 out of 15000
   ✗ http_req_duration..............: avg=2.45ms   min=166.47µs med=1.04ms   max=44.52ms p(90)=3.68ms   p(95)=7.71ms
       { expected_response:true }...: avg=2.45ms   min=166.47µs med=1.04ms   max=44.52ms p(90)=3.68ms   p(95)=7.71ms
   ✓ http_req_failed................: 0.00%   0 out of 7500
     iterations.....................: 7500    248.679794/s
     vus_max........................: 250     min=250            max=250


running (0m30.2s), 000/250 VUs, 7500 complete and 0 interrupted iterations
default ✓ [ 100% ] 250 VUs  30s
time="2025-03-12T12:09:54Z" level=error msg="thresholds on metrics 'http_req_duration' have been crossed"
Error: Process completed with exit code 99.

Although the checks and the http_req_failed rate thresholds are satisfied, this test failed because all the calculated http_req_duration metrics are greater than the thresholds defined above.

Evaluation by comparing to historical data

Another method of evaluation involves comparing the current results with historical data within a defined confidence level. This statistical approach allows us to understand trends over time and determine if the application’s performance is improving, declining, or remaining stable.

In many cases, performance metrics such as response times or throughput can be assumed to follow a normal distribution, especially when you have a large enough sample size. The normal distribution, often referred to as the bell curve, is a probability distribution that is symmetric about the mean. You can read more about it on Wikipedia.

Here’s how the statistical analysis works: from your historical data, calculate the mean (or average, μ) and standard deviation (SD, σ) of the performance metrics. These values will serve as the basis for hypothesis testing. Then, determine the performance metric from the current test run that you want to compare against the historical data. This could be the mean response time, p(90), error rate, etc.

Define test hyptheses

Concretely, let’s first create an hypothesis to test the current result with the historical data.

• Null Hypothesis (H0): The current performance metric is equal to the historical mean (no significant difference).

  <semantics>H0:μcurrent=μhistorical<annotation encoding="application/x-tex">H_0: \mu_{\text{current}} = \mu_{\text{historical}}</annotation></semantics>H0​:μcurrent​=μhistorical​

• Alternative Hypothesis (H1): The current performance metric is not equal to the historical mean (there is a significant difference).

  <semantics>H1:μcurrent≠μhistorical<annotation encoding="application/x-tex">H_1: \mu_{\text{current}} \neq \mu_{\text{historical}}</annotation></semantics>H1​:μcurrent​=μhistorical​

Define a comparison metric and acceptance criterion

To compare the current result to the historical mean, we calculate the Z-score, which tells you how many standard deviations the current mean is from the historical mean. The formula for the Z-score is:

<semantics>Z=μcurrent−μhistoricalσhistorical<annotation encoding="application/x-tex">Z = \frac{\mu_{\text{current}} - \mu_{\text{historical}}}{\sigma_{\text{historical}}}</annotation></semantics>Z=σhistorical​μcurrent​−μhistorical​​

Where:

• <semantics>μcurrent<annotation encoding="application/x-tex">\mu_{\text{current}}</annotation></semantics>μcurrent​ is the current mean.
• <semantics>μhistorical<annotation encoding="application/x-tex">\mu_{\text{historical}}</annotation></semantics>μhistorical​ is the historical mean.
• <semantics>σhistorical<annotation encoding="application/x-tex">\sigma_{\text{historical}}</annotation></semantics>σhistorical​ is the standard deviation of the historical data.

Finally, we need to determine the critical value of the Z-score: for a 95% confidence level, you can extract it from the standard normal distribution table. For a two-tailed test, the critical values are approximately ±1.96. For the full standard normal distribution table, see, for example, this website.

The confidence level means that the calculated difference between current and historical performance would fall within the chosen range around the historical mean in 95% of the cases. I believe the 95% confidence level provides good enough coverage for most purposes, but depending on the criticality of the product or service, you can increase or decrease it.

Make a decision

If the calculated Z-score falls outside the range of -1.96 to +1.96, you reject the null hypothesis (H0) and conclude that there is a statistically significant difference between the current performance metric and the historical mean. If the Z-score falls within this range, you fail to reject the null hypothesis, indicating no significant difference.

Based on these findings, you can interpret whether the application’s performance has improved, declined, or remained stable compared to historical data. This statistical analysis provides a robust framework for understanding performance trends over time and making data-driven decisions for further optimizations.

Implementation

In the above section, I tried to provide a clear explanation of how we can effectively evaluate the results of performance testing using historical data. It is important to note that we do not need to engage in complex manual statistical analyses to check the validity of these results. Instead, we should focus on scripting a comprehensive process that allows us to test the hypothesis for the Z-score within the 95% confidence level. This approach will streamline our evaluation and ensure that we rely on a straightforward method to assess the performance outcomes in the CI/CD pipeline.

import numpy as np
from scipy import stats

def hypothesis_test(historical_data, current_data, confidence_level=0.95):
    # Calculate historical mean and standard deviation
    historical_mean = np.mean(historical_data)
    historical_std = np.std(historical_data, ddof=1)

    # Calculate the current mean
    current_mean = np.mean(current_data)

    # Number of observations in the current dataset
    n_current = len(current_data)

    # Calculate Z-score
    z_score = (current_mean - historical_mean) / historical_std

    # Determine the critical Z-values for the two-tailed test
    critical_value = stats.norm.ppf((1 + confidence_level) / 2)

    # Print results
    print(f"Historical Mean: {historical_mean:.2f}")
    print(f"Current Mean: {current_mean:.2f}")
    print(f"Z-Score: {z_score:.2f}")
    print(f"Critical Value for {confidence_level*100}% confidence: ±{critical_value:.2f}")

    # Hypothesis testing decision
    if abs(z_score) > critical_value:
        assert abs(z_score) <= critical_value, f"z_score {z_score} exceeds the critical value {critical_value}"

if __name__ == "__main__":
    # Read the historical data (performance metrics)
    historical_data = get_historical_data()
    # Current data to compare
    current_data = get_current_result()
    hypothesis_test(historical_data, current_data, confidence_level=0.95)

The challenges with CPT

CPT can add additional cost to your project. It is an additional step in the CI pipeline, and requires performance engineering expertise that organizations might need to hire for. Furthermore, an additional test environment is needed to run the performance testing.

In addition to the costs, maintenance can be challenging. Likewise, data generation is very critical for the success of the performance testing: it requires obtaining data, masking sensitive information, and deleting them securely. CPT also requires testing new services, reflecting changes in the current services or removing unused services. Following up on detected issues and on new features of performance testing tools are also mandatory. All these must be done regularly to keep the system afloat, adding to existing maintenance efforts.

The benefits of CPT

Continuous Performance Testing offers significant benefits by enabling automatic early detection of performance issues within the development process. This proactive approach allows teams to identify and address bottlenecks before they reach production, reducing both costs and efforts associated with fixing problems later. By continuously monitoring and optimizing application performance, CPT helps ensure a fast, responsive user experience and minimizes the risk of outages or slowdowns that could disrupt users and business operations.

In addition to early detection, CPT enhances resource utilization by pinpointing inefficient code and infrastructure setups, ultimately reducing overall costs despite initial investments. It also fosters better collaboration among development, testing, and operations teams by providing a shared understanding of performance metrics: each test generates valuable data that supports advanced analysis and better decision-making regarding code improvements, infrastructure upgrades, and capacity planning. Finally, CPT offers the convenience of on-demand testing with just one click, providing an easy-to-use baseline for more rigorous performance evaluations when needed.

Conclusion

Continuous Performance Testing (CPT) transforms traditional performance testing by integrating it directly into the CI/CD pipeline. CPT can, in principle, be applied to each performance testing type, but load testing is most advantageous with lower cost and higher benefits.

The core idea is to automate and conduct performance tests continuously and earlier in the development cycle, aligning with the “shift-left” philosophy. This approach provides real-time feedback on performance impacts, helps identify and resolve issues sooner, and ultimately leads to improved software quality, faster development, and consistent adherence to performance standards and SLAs.

October 30, 2025 12:00 AM

GHC 9.14.1-rc1 is now available

GHC 9.14.1-rc1 is now available

bgamari - 2025-10-30

The GHC developers are very pleased to announce the availability of the release candidate of GHC 9.14.1. Binary distributions, source distributions, and documentation are available at downloads.haskell.org.

GHC 9.14 will bring a number of new features and improvements, including:

• Significant improvements in specialisation:

  • The SPECIALISE pragma now allows use of type application syntax
  • The SPECIALISE pragma can be used to specialise for expression arguments as well as type arguments.
  • Specialisation is now considerably more reliable in the presence of newtypes

• Significant GHCi improvements including:

  • Correctness and performance improvements in the bytecode interpreter
  • Features in the GHCi debugger
  • Support for multiple home units in GHCi

• Implementation of the Explicit Level Imports proposal

• RequiredTypeArguments can now be used in more contexts

• SSE/AVX2 support in the x86 native code generator backend

• A major update of the Windows toolchain and improved compatibility with macOS Tahoe

• … and many more

A full accounting of changes can be found in the release notes. Given the many specialisation improvements and their potential for regression, we would very much appreciate testing and performance characterisation on downstream workloads.

Note that while this release makes many improvements in the specialisation optimisation, polymorphic specialisation will remain disabled by default in the final release due to concern over regressions of the sort identified in #26329. Users needing more aggressive specialisation can explicitly enable this feature with the -fpolymorphic-specialisation flag. Depending upon our experience with 9.14.1, we may enable this feature by default in a later minor release.

This is the first and hopefully last release candidate prerelease of 9.14.1. This comes later than expected in part due to work on resolving a regression in macOS 26 (#26166) which threatened the usability of the release. This prerelease includes a fix to this regression; naturally, please open a ticket if you encounter any trouble when using this release on macOS Tahoe or recent XCode releases. We expect that this fix will be backported to GHC 9.12 and 9.10 in the coming months.

We would like to thank the Zw3rk stake pool, Well-Typed, Mercury, Channable, Tweag I/O, Serokell, SimSpace, the Haskell Foundation, and other anonymous contributors whose on-going financial and in-kind support has facilitated GHC maintenance and release management over the years. Finally, this release would not have been possible without the hundreds of open-source contributors whose work have made the Haskell ecosystem what it is today.

As always, do give this release a try and open a ticket if you see anything amiss.

by ghc-devs at October 30, 2025 12:00 AM

Stock Market Shark: More Multidimensional DP

Today will be the final problem we do (for now) comparing Rust and Haskell LeetCode solutions. We’ll do a wrap-up of some of the important lessons next week. Last week’s problem was a multi-dimensional dynamic programming problem where the “dimensions” were obvious. We were working in 2D space trying to find the largest square, so we wanted the cells in our “DP” grid to correspond to the cells in our input grid.

Today we’ll solve one final problem using DP in multiple dimensions where the dimensions aren’t quite as obvious. To learn more about the basics behind implementing DP in Haskell, you need to enroll in our course, Solve.hs! You’ll learn many principles about algorithms in Module 3 and get a ton of practice with our exercises!

The Problem

Today’s problem is Best Time to Buy and Sell Stack IV, the final in a series of problems where we are aiming to maximize the profit we can make from purchasing a single stock.

We have two problem inputs. The first is an array of the prices of the stock over a number of days. Each day has one price. There is no fluctuation over the course of a day (real world stock trading would be much easier if we got this kind of future data!).

Our second input is a number of “transactions” we can make. A single transaction consists of buying AND selling the stock. There are some restrictions on how these transactions work. The primary one is that we cannot have simultaneous transactions. Another way of saying this is that we can only hold one “instance” of the stock at a time. We can’t buy one instance of the stock on day 1, and then another instance on day 2, and then sell them both later.

We also cannot sell a stock on the same day we buy it, nor buy a new instance on the same day we sell a previous instance. This isn’t so much a problem constraint as an algorithmic insight that there is no benefit to us doing this. Buying and selling on the same day yields no net profit, so we may as well just not use the transaction.

As an example, suppose we have 3 transactions to use, and the following data for the upcoming days:

[1, 4, 8, 2, 7, 1, 15]

The solution here is 26, via the following transactions:

1. Buy the stock on day 1 for $1, sell it on day 3 for $8 ($7 profit)
2. Buy the stock on day 4 for $2, sell it on day 5 for $7 ($5 profit)
3. Buy the stock on day 6 for $1, sell it on day 7 for $15 ($14 profit)

If we only had 2 transactions to work with, the answer would be 21. We would simply omit the second transaction.

The Algorithm

Since this is a “hard” problem, the algorithm description is a bit tricky! But we can break it into a few pieces.

Grid Structure

As I alluded to, this is a multi-dimensional DP problem, but the “dimensions” are not as clear as our last problem, because this problem doesn’t have a spatial nature. But once you do enough DP problems, it gets easier to see what the dimensions are.

One dimension will be the “current day”, and the other will be the “transaction state”. The cell {s, d} will indicate “Given I am in state s on day d, what is the largest additional profit I can achieve?”

The number of days is obviously equal to the size of our input array. This will be our column dimension. So column i will always mean “if I am in this state on day i”.

The number of transaction states is actually double the number of transactions we are allowed. We want one row for each transaction to capture the state after we have bought for this transaction, and one row for before buying as part of this transaction (we’ll refer to this row as “pre-bought” throughout).

We’ll order the rows so that earlier rows represent fewer transactions remaining. Thus the first row indicates the state of having purchased the stock for the final transaction, but not yet having sold it. The second row indicates you have one transaction still available, but you haven’t bought the stock for this transaction yet. The third row indicates you have purchased the stock and you’ll have 1 complete transaction remaining after selling it. And so on. So with n days and k transactions, our grid will have size 2k x n.

Base Cases

Now let’s think about the base cases of this grid. It is easiest to consider the last day, the final column of the grid. If we’re on the last day, the marginal gain we can make if we are holding the stock is simply to sell it (all prices are positive), which would give us a “profit” of the final sale price. We don’t need to consider the cost of buying the stock for these rows. We just think about “given that I have the stock, what’s the most I can end up with”.

Then, for all the “pre-bought” rows, the final column is 0. We don’t have enough time to buy AND sell a stock, so we just do nothing.

Now we can also populate the rows for the final transaction fairly easily. These are base cases as well. We’ll populate them from right to left, meaning from the later days to the earlier days (recall we’ve already filled in the very last day).

For the “top” row, where we’ve already bought the stock for our final transaction, we have two choices. We can “sell” the stock on that day, or “keep” the stock to cell later. The first option means we just use the price for that day, and the second means we use the recorded value for the next day. We want the maximum of these options.

Once we’ve populated the “bought” row, we move on to the “pre-bought” row below it. Again, we’ll loop right to left and have two options each time. We can “buy” the stock, which would move us “up” to the bought row on the next day, except we have to subtract the price of the stock. Or we can “stay” and not buy the stock. This means we grab the value from the same row in the next column. Again, we just use the max of these two options.

At this point, we’ve populated the entire last column of our grid AND the first two rows.

Recursive Cases

For the “recursive” cases (we can actually think of them as “inductive” cases), we go two rows at a time, counting up to our total transaction count. Each transaction follows the same pattern, which is similar to what we did for the rows above.

First, fill in the “bought” row for this transaction. We can “sell” or “keep” the stock. Selling moves us up and to the right, and adds the sale price for that day. But keeping moves us directly right in our grid. Again, we take the max of these options.

Then we fill the “pre-bought” row for this transaction. We can “buy” or “stay”. Buying means subtracting the price for that day from the value up and to the right. Staying means we take the value immediately to our right. As always, take the max.

When we’ve completed populated our grid following this pattern, our final answer is the value in the bottom left of the grid! This is the maximum profit starting from day 0 and before buying for any of our transactions, which is the true starting state of the problem.

Rust Solution

Let’s solve this in Rust first! We begin by defining a few values and handling an edge case (if there’s only 1 day, the answer is 0 since we can’t buy and sell).

pub fn max_profit(k: i32, prices: Vec<i32>) -> i32 {
    let n = prices.len();
    if n == 1 {
        return 0;
    }
    let ku = k as usize;
    let numRows = 2 * ku;

    // Create our zero-ed out grid
    let mut dp: Vec<Vec<i32>> = Vec::with_capacity(numRows);
    dp.resize(numRows, Vec::with_capacity(n));
    for i in 0..numRows {
        dp[i].resize(n, 0);
    }
    ...
}

Now we handle the first two rows (our “final” transaction). In each case, we start with the base case of the final day, and then move from right to left, following the rules described in the algorithm.

pub fn max_profit(k: i32, prices: Vec<i32>) -> i32 {
    ...

    // Final Transaction
    // Always sell on the last day!
    dp[0][n - 1] = prices[n - 1];
    for i in (0..=(n-2)).rev() {
        // Sell or Keep
        dp[0][i] = std::cmp::max(prices[i], dp[0][i+1]);
    }
    dp[1][n - 1] = 0;
    for i in (0..=(n-2)).rev() {
        // Buy (subtract price!) or keep
        dp[1][i] = std::cmp::max(dp[0][i+1] - prices[i], dp[1][i+1]);
    }
    ...
}

Now we write our core loop, going through the remaining transaction count. We start by defining the correct row numbers and setting the final-column base cases:

pub fn max_profit(k: i32, prices: Vec<i32>) -> i32 {
    // Setup
    ...
    // Final Transaction
    ...
    // All other transactions
    for j in 1..ku {
        let boughtRow = 2 * j;
        let preBoughtRow = boughtRow + 1;
        // Always sell on the last day!
        dp[boughtRow][n - 1] = prices[n - 1];
        // 0 - No time to buy/sell!
        dp[preBoughtRow][n - 1] = 0;
        ...
    }
}

And now we apply the logic for our algorithm. As we populate each row from right to left, we simply apply our two choices: sell/keep for the “bought” row and buy/stay for the “pre-bought” row.

pub fn max_profit(k: i32, prices: Vec<i32>) -> i32 {
    ...
    // All other transactions
    for j in 1..ku {
        let boughtRow = 2 * j;
        let preBoughtRow = boughtRow + 1;
        // Always sell on the last day!
        dp[boughtRow][n - 1] = prices[n - 1];
        // 0 - No time to buy/sell!
        dp[preBoughtRow][n - 1] = 0;
        // Sell or Keep!
        for i in (0..=(n-2)).rev() {
            dp[boughtRow][i] = std::cmp::max(dp[boughtRow - 1][i+1] + prices[i], dp[boughtRow][i + 1]);
        }
        // Buy or Stay!
        for i in (0..=(n-2)).rev() {
            dp[preBoughtRow][i] = std::cmp::max(dp[boughtRow][i+1] - prices[i], dp[preBoughtRow][i + 1])
        }
    }
    return dp[numRows - 1][0];
}

This completes our loop, and the final thing we need, as you can see, is to return the value in the bottom left of our grid!

Here is the complete solution:

pub fn max_profit(k: i32, prices: Vec<i32>) -> i32 {
    let n = prices.len();
    if n == 1 {
        return 0;
    }
    let ku = k as usize;
    let numRows = 2 * ku;
    let mut dp: Vec<Vec<i32>> = Vec::with_capacity(numRows);
    dp.resize(numRows, Vec::with_capacity(n));
    for i in 0..numRows {
        dp[i].resize(n, 0);
    }

    // Final Transaction
    dp[0][n - 1] = prices[n - 1];
    for i in (0..=(n-2)).rev() {
        dp[0][i] = std::cmp::max(prices[i], dp[0][i+1]);
    }
    dp[1][n - 1] = 0;
    for i in (0..=(n-2)).rev() {
        dp[1][i] = std::cmp::max(dp[0][i+1] - prices[i], dp[1][i+1]);
    }

    // All other transactions
    for j in 1..ku {
        let boughtRow = 2 * j;
        let preBoughtRow = boughtRow + 1;
        dp[boughtRow][n - 1] = prices[n - 1];
        dp[preBoughtRow][n - 1] = 0;
        for i in (0..=(n-2)).rev() {
            dp[boughtRow][i] = std::cmp::max(dp[boughtRow - 1][i+1] + prices[i], dp[boughtRow][i + 1]);
        }
        for i in (0..=(n-2)).rev() {
            dp[preBoughtRow][i] = std::cmp::max(dp[boughtRow][i+1] - prices[i], dp[preBoughtRow][i + 1])
        }
    }
    return dp[numRows - 1][0];
}

Haskell Solution

As we saw in our first DP problem, we often don’t need as much memory as it initially seems. We filled out the “whole grid” for Rust, which helps make the algorithm more clear. But our Haskell solution will reflect the fact that we only actually need to pass along one preceding row (the pre-bought row) each time we loop through a transaction.

Let’s start by defining our edge case, as well as a few useful terms. We’ll define our indices in left-to-right order, but in all cases we’ll loop through them in reverse with foldr:

maxProfit :: V.Vector Int -> Int -> Int
maxProfit nums k = if n == 1 then 0
  else ...
  where
    n = V.length nums
    lastPrice = nums V.! (n - 1)
    idxs = ([0..(n-2)] :: [Int])
    ...

Now we’ll define three different “loop” functions, all with the same pattern. We’ll use an IntMap Int to represent each “row” in our grid. So these functions will modify the IntMap for the row as we go along, while taking the new “index” we are populating. Let’s start with the base case, the first “bought” row, corresponding to our final transaction.

It will give us two options: sell or keep, following our algorithm. We insert the max of these into the map.

maxProfit :: V.Vector Int -> Int -> Int
maxProfit nums k = if n == 1 then 0
  else ...
  where
    n = V.length nums
    lastPrice = nums V.! (n - 1)
    idxs = ([0..(n-2)] :: [Int])

    ibFold :: Int -> IM.IntMap Int -> IM.IntMap Int
    ibFold i mp =
      let sell = nums V.! i
          keep = mp IM.! (i + 1)
      in  IM.insert i (max sell keep) mp
    initialBought = foldr ibFold (IM.singleton (n-1) lastPrice) idxs

    ...

We construct our initialBought row by folding, starting with a singleton of the last column base case.

Now we’ll write a function that, given a “bought” row, can construct the preceding “pre-bought” row. This will apply the “buy” and “stay” ideas in our algorithm and select between them. Choosing the “buy” option requires looking into the preceding “bought” row, while “stay” looking into a later index of the existing map:

maxProfit :: V.Vector Int -> Int -> Int
maxProfit nums k = if n == 1 then 0
  else ...
  where
    ...
    initialBought = foldr ibFold (IM.singleton (n-1) lastPrice) idxs
    
    preBoughtFold :: IM.IntMap Int -> Int -> IM.IntMap Int -> IM.IntMap Int
    preBoughtFold bought i preBought =
      let buy = bought IM.! (i+1) - nums V.! i
          stay = preBought IM.! (i+1)
      in  IM.insert i (max buy stay) preBought

    initialPreBought = foldr (preBoughtFold initialBought) (IM.singleton (n-1) 0) idxs

We construct the initialPreBought row by applying this function with initialBought as the input. But we’ll use this for the rest of our “pre-bought” rows as well! First though, we need a more general loop for the rest of our “bought” rows.

This function has the same structure as pre-bought, just applying the “sell” and “keep” rules instead of “buy” and “stay”:

maxProfit :: V.Vector Int -> Int -> Int
maxProfit nums k = if n == 1 then 0
  else ...
  where
    ...
    
    boughtFold :: IM.IntMap Int -> Int -> IM.IntMap Int -> IM.IntMap Int
    boughtFold preBought i bought =
      let sell = preBought IM.! (i+1) + nums V.! i
          keep = bought IM.! (i+1)
      in  IM.insert i (max sell keep) bought

Now we’re ready for our core loop! This will loop through every transaction except the base case. It takes only the preceding “pre-bought” row and the transaction counter. Once the counter reaches k, we return the first value in this row. Otherwise, we run the “bought” loop to produce a next “bought” row, and we pass this in to the “pre-bought” loop to produce a new “pre-bought” row. This becomes the input to our recursive call:

maxProfit :: V.Vector Int -> Int -> Int
maxProfit nums k = if n == 1 then 0
  else loop 1 initialPreBought
  where
    ...
    loop :: Int -> IM.IntMap Int -> Int
    loop i preBought = if i >= k then preBought IM.! 0
      else
        let bought' = foldr (boughtFold preBought) (IM.singleton (n-1) lastPrice) idxs
            preBought' = foldr (preBoughtFold bought') (IM.singleton (n-1) 0) idxs
        in  loop (i + 1) preBought'

As you can see above, we complete the solution by calling our loop with the initial “pre-bought” row, and a transaction counter of 1!

Here’s our full Haskell solution:

maxProfit :: V.Vector Int -> Int -> Int
maxProfit nums k = if n == 1 then 0
  else loop 1 initialPreBought
  where
    n = V.length nums
    lastPrice = nums V.! (n - 1)
    idxs = ([0..(n-2)] :: [Int])

    ibFold :: Int -> IM.IntMap Int -> IM.IntMap Int
    ibFold i mp =
      let sell = nums V.! i
          keep = mp IM.! (i + 1)
      in  IM.insert i (max sell keep) mp
    initialBought = foldr ibFold (IM.singleton (n-1) lastPrice) idxs
    
    preBoughtFold :: IM.IntMap Int -> Int -> IM.IntMap Int -> IM.IntMap Int
    preBoughtFold bought i preBought =
      let buy = bought IM.! (i+1) - nums V.! i
          stay = preBought IM.! (i+1)
      in  IM.insert i (max buy stay) preBought

    initialPreBought = foldr (preBoughtFold initialBought) (IM.singleton (n-1) 0) idxs

    boughtFold :: IM.IntMap Int -> Int -> IM.IntMap Int -> IM.IntMap Int
    boughtFold preBought i bought =
      let sell = preBought IM.! (i+1) + nums V.! i
          keep = bought IM.! (i+1)
      in  IM.insert i (max sell keep) bought

    loop :: Int -> IM.IntMap Int -> Int
    loop i preBought = if i >= k then preBought IM.! 0
      else
        let bought' = foldr (boughtFold preBought) (IM.singleton (n-1) lastPrice) idxs
            preBought' = foldr (preBoughtFold bought') (IM.singleton (n-1) 0) idxs
        in  loop (i + 1) preBought'

Conclusion

That’s the last LeetCode solution we’re going to write for now! Hopefully you’ve got a good impression now on the differences between dynamic programming in Haskell when compared to a language like Rust. To learn more about the basics of these Haskell solutions, take a look at our course, Solve.hs! You’ll also get a ton of practice with hundreds of exercise problems in the course!

Next week we will switch gears, and start working on some interesting parsing problems!

by James Bowen at October 27, 2025 08:30 AM

[blyqokgn] simultaneously define record type and data

we propose a Haskell syntax extension which may be useful when a record type has very few data values of that type, perhaps just one, e.g., the Singleton design pattern.

introduce the keyword DEFINERECORD:

singletonrecord :: Recordtype;
singletonrecord = DEFINERECORD RecordType RecordConstructor { john :: Int = 1, paul :: String = "bass", george :: Bool = True, ringo :: Float = 1.0};

the benefit of this syntax is that the field types and their corresponding values get defined next to each other.  future code changes to type and value will happen at the same place.  there is less danger of accidentally leaving a field uninitialized.

also, the field labels are each written exactly once (Don't Repeat Yourself), in contrast to the current method (below), defining the data type then defining the singleton record using record syntax, which requires typing each field label twice.  although you can optionally put type annotations on field values so that field, value, and type are next to each other when defining the singleton, it feels like even more Repeating Yourself.

data RecordType = RecordConstructor { john :: Int, paul :: String, george :: Bool, ringo :: Float };
singletonrecord :: Recordtype;
singletonrecord = RecordConstructor { john = 1 :: Int, paul = "bass" :: String, george = True :: Bool, ringo = 1 :: Float};

the proposed syntax cannot be used if RecordType has multiple constructors.  (because there can only be one constructor, also consider simpler syntax which restricts the constructor to be the same as that of the type.)

if you have nested records, the syntax can define inner record types "in place" as well.

singletonrecord :: Recordtype;
singletonrecord = DEFINERECORD RecordType RecordConstructor { john :: Int = 1, paul :: String = "bass", george :: Bool = True, ringo = DEFINERECORD DrumType DrumConstructor { snare :: Double = 1.0, cymbal :: String = "crash" } };

this might be a nice feature to combine with Data.Default .

slight variation: record types can be unnamed (anonymous), but have named accessor functions (named fields).  introduce the keyword UNNAMEDRECORD, which stands for both type and constructor.

f1 :: UNNAMEDRECORD;
f1 = UNNAMEDRECORD { john :: String = "guitar", paul :: String = "bass", george :: String = "guitar", ringo = UNNAMEDRECORD { snare :: Double = 1.0, cymbal :: String = "crash" } };

f2 :: UNNAMEDRECORD;
f2 = UNNAMEDRECORD { capital :: String = "london", home :: String = "liverpool" };

g :: String;
g = let
{ v1 :: UNNAMEDRECORD
; v1 = f1
; v2 :: UNNAMEDRECORD
; v2 = f2
} in cymbal (ringo v1) ++ home v2;
-- returns "crashliverpool"

this is better than returning multiple values through tuple syntax because components get named, both when creating and extracting.  using names seems less error-prone than extracting tuple components by position:

g = let { v1 = f1 ; v2 = f2 } in (case v1 of {(_,_,_, (_,x) )->x}) ++ snd v2

open question: if we use DEFINERECORD or UNNAMEDRECORD inside a let or where, should the type name and accessor functions escape the let and become visible in the global scope?  perhaps explicitly mark things for export from the let (requires more new syntax).

more sophistication (and complexity) possible: lenses, record wildcards and puns, etc.  type inference probably becomes more difficult.

related work by Alexander Thiemann: SuperRecord anonymous records.

although we propose this extension for Haskell, it seems a nice feature to have in any programming language.

by Unknown (noreply@blogger.com) at October 26, 2025 06:30 PM

Draw high dimensional tensors as a matrix of matrices

I have recently needed to draw the contents of high-dimensional (e.g., 4D and up) tensors where it is important to ensure that is clear how to identify each of the dimensions in the representation. Common strategies I've seen people do in this situation include printing a giant list 2D slices (what the default PyTorch printer will do) or flattening the Tensor in some way back down to a 2D tensor. However, if you have a lot of horizontal space, there is a strategy that I like that makes it easy to identify all the axes of the higher dimensional tensor: draw it as a matrix of matrices.

Here are some examples, including the easy up-to-2D cases for completeness.

0D: torch.arange(1).view()

0

1D: torch.arange(2)

0  1

2D: torch.arange(4).view(2, 2 )

0  1
2  3

3D: torch.arange(8).view(2, 2, 2)

0  1    4  5
2  3    6  7

4D: torch.arange(16).view(2, 2, 2, 2)

 0  1    4  5
 2  3    6  7

 8  9   12 13
10 11   14 15

5D: torch.arange(32).view(2, 2, 2, 2, 2):

 0  1    4  5  :  16 17   20 21
 2  3    6  7  :  18 19   22 23
               :
 8  9   12 13  :  24 25   28 29
10 11   14 15  :  26 27   30 31

The idea is that every time you add a new dimension, you alternate between stacking the lower dimension matrices horizontally and vertically. You always stack horizontally before stacking vertically, to follow the standard row-major convention for printing in the 2D case. Dimensions always proceed along the x and y axis, but the higher dimensions (smaller dim numbers) involve skipping over blocks. For example, a "row" on dim 3 in the 4D tensor is [0, 1] but the "row" on dim 1 is [0, 4] (we skip over to the next block.) The fractal nature of the construction means we can keep repeating the process for as many dimensions as we like.

In fact, for the special case when every size in the tensor is 2, the generated sequence of indices form a Morton curve. But I don't call it that, since I couldn't find a popular name for the variation of the Morton curve where the radix of each digit in the coordinate representation can vary.

Knowledge check. For the 4D tensor of size (2, 2, 2, 2) arranged in this way, draw the line(s) that would split the tensor into the pieces that torch.split(x, 1, dim), for each possible dimension 0, 1, 2 and 3. Answer under the fold.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

dim=0

>>> [x.reshape(-1) for x in torch.arange(16).view(2,2,2,2).split(1,dim=0)]
[tensor([0, 1, 2, 3, 4, 5, 6, 7]), tensor([ 8, 9, 10, 11, 12, 13, 14, 15])]

     0  1    4  5
     2  3    6  7
   ----------------
     8  9   12 13
    10 11   14 15


dim=1

>>> [x.reshape(-1) for x in torch.arange(16).view(2,2,2,2).split(1,dim=1)]
[tensor([ 0, 1, 2, 3, 8, 9, 10, 11]), tensor([ 4, 5, 6, 7, 12, 13, 14, 15])]

     0  1 |  4  5
     2  3 |  6  7
          |
     8  9 | 12 13
    10 11 | 14 15

dim=2

>>> [x.reshape(-1) for x in torch.arange(16).view(2,2,2,2).split(1,dim=2)]
[tensor([ 0, 1, 4, 5, 8, 9, 12, 13]), tensor([ 2, 3, 6, 7, 10, 11, 14, 15])]

     0  1    4  5
   ------- -------
     2  3    6  7

     8  9   12 13
   ------- -------
    10 11   14 15

dim=3

>>> [x.reshape(-1) for x in torch.arange(16).view(2,2,2,2).split(1,dim=3)]
[tensor([ 0, 2, 4, 6, 8, 10, 12, 14]), tensor([ 1, 3, 5, 7, 9, 11, 13, 15])]

     0 |  1    4 |  5
     2 |  3    6 |  7

     8 |  9   12 | 13
    10 | 11   14 | 15

by Edward Z. Yang at October 25, 2025 04:55 PM

Introduction to Agentic Coding

AI-assisted coding is having its moment. For autocomplete tools and AI agents like GitHub Copilot and Cursor, the hype is real. But so is the confusion. Are we replacing developers? Can anyone build software just by prompting? Is “vibe coding” the future?

At Modus Create, we wanted to cut through the noise. So we ran a real experiment: two teams, same scope, same product, same timeline. One team used traditional workflows. The other used AI agents to scaffold, implement, and iterate — working in a new paradigm we call Agentic Coding.

Every technique we learned along the way and every insight this approach taught us is collected in our Agentic Coding Handbook. This article distills the lessons from the handbook into the core principles and practices any engineer can start applying today.

From Typing Code to Designing Systems

Agentic coding isn’t about writing code faster. It’s about working differently. Instead of manually authoring every line, engineers become high-level problem solvers. They define the goal, plan the implementation, and collaborate with an AI agent that writes code on their behalf.

Agentic Coding is a structured, AI-assisted workflow where skilled engineers prompt intentionally, validate rigorously, and guide the output within clear architectural boundaries.

This approach is fundamentally different from what many refer to as “vibe coding”, the idea that you can throw a vague prompt at an LLM and see what comes back. That mindset leads to bloated code, fragile architecture, and hallucinations.

Agentic Coding vs. Vibe Coding

To illustrate the difference, here’s how agentic coding compares to the more casual “vibe coding” approach across key dimensions:

	Agentic Coding	Vibe Coding
Planning	Structured implementation plan	None or minimal upfront thinking
Prompting	Scoped, intentional, reusable	Loose, improvisational, trial-and-error
Context	Deliberately curated via files/MCPs	Often missing or overloaded
Validation	Treated as a critical engineering step	Frequently skipped or shallow
Output Quality	High, repeatable, aligned to standards	Inconsistent, often needs full rewrite
Team Scalability	Enables leaner squads with high output	Prone to technical debt and drift

Agentic coding provides the structure, discipline, and scalability that large organizations need to standardize success across multiple squads. It aligns AI workflows with existing engineering quality gates, enabling automation without losing control. In contrast, vibe coding may produce short-term wins but fails to scale under the weight of enterprise demands for predictability, maintainability, and shared accountability.

A Note on Our Experiment

We ran a structured experiment with two engineering squads working on the same product. One team (DIY) built the product using traditional methods. The other team (AI) used Cursor and GitHub Copilot Agent to complete the same scope, using agentic workflows. The AI team had 30% fewer engineers and delivered in half the time. More importantly, the code quality — verified by SonarQube and human reviewers — was consistent across both teams.

Core Practices That Make the Difference

Implementation Planning is Non-Negotiable

Before any prompting happens, engineers must do the thinking. Creating an implementation plan isn’t just a formality but the most critical piece in making agentic coding work. It’s where intent becomes design.

A solid implementation plan defines what to build, but also why, how, and within what constraints. It includes:

• Functional goals: What should this piece of code do?
• Constraints: Performance expectations, architecture rules, naming conventions, etc.
• Edge cases: Known pitfalls, alternate flows, integration risks.
• Required context: Links to schemas, designs, existing modules, etc.
• Step-by-step plan: Breakdown of the task into scoped units that will become individual prompts.

This plan is usually written in markdown and lives inside the codebase. It acts like a contract between the engineer and the AI agent.

The more precise and explicit this document is, the easier it is to turn each unit into a high-quality prompt. This is where agentic coding shifts from “throw a prompt and see what happens” to deliberate system design, supported by AI.

In short, prompting is the act. Planning is the discipline. Without it, you’re not doing agentic coding — you’re just taking shots in the dark and hoping something works.

Prompt Engineering is a Real Skill

Prompt engineering is not about being clever. It’s about being precise, scoped, and iterative. We teach engineers to break down tasks into discrete steps, write action-oriented instructions, avoid vague intentions, chain prompts, and use prompting strategies like:

• Three Experts: Use this when you want multiple perspectives on a tough design problem. For example, ask the AI to respond as a senior engineer, a security expert, and a performance-focused architect.
• N-Shot Prompting: Provide the AI with N examples of the desired output format or pattern. Zero-shot uses no examples, one-shot provides a single example, and few-shot (N-shot) includes multiple examples to guide the AI toward the expected structure and style.
• 10 Iteration Self-Refinement: Best used when you want the AI to improve its own output iteratively. Give it a problem, then prompt it to improve its previous response 10 times, evaluating each step with reasoning.

Choosing the right style depends on the type of challenge you’re tackling — architectural design, implementation, refactoring, or debugging.

Context is a First-Class Citizen

Model Context Providers (MCPs) give GitHub Copilot a second brain. Instead of treating the LLM as an isolated suggester, MCPs stream relevant context — from Figma designs, documentation in Confluence, code changes from GitHub, and decision logs — directly into the Copilot chat session.

This allows engineers to ask Copilot to write code that matches an actual UI layout, or implements some logic described in a design doc, without manually pasting content into the prompt. The results are significantly more relevant and aligned. Some of the MCPs we use are:

• GitHub MCP: Pulls in pull request content and comments to give the model full context for writing review responses, proposing changes, or continuing implementation from feedback.
• Figma MCP: Streams UI layouts into the session, enabling the AI to generate frontend code that accurately reflects the design.
• Database Schema MCP: Injects table structures, column types, and relationships to help the AI write or update queries, migrations, or API models with accurate field-level context.
• Memory Bank MCP: Shares scoped memory across sessions and team members, maintaining continuity of architectural decisions, prompt history, and recent iterations.
• CloudWatch MCP: Supplies log output to the AI for debugging and incident triage — essential during the Debugging workflow.
• SonarQube MCP: Feeds static analysis results so the AI can refactor code to eliminate bugs, smells, or duplication.
• Confluence MCP: Integrates architecture and business documentation to inform decisions around domain logic, constraints, and requirements.

MCPs are just one part of the context curation puzzle. Engineers also need to deliberately craft the model’s working memory for each session. That includes:

• Implementation Plans: Markdown files that define goals, steps, constraints, and trade-offs, acting as an onboarding doc for the AI agent.
• Codebase Files: Selectively attaching relevant parts of the codebase (like entry points, shared utilities, schemas, or config files) so the AI operates with architectural awareness.
• Console Logs or Test Output: Including runtime details helps the AI understand execution behavior and suggest context-aware fixes.
• Instructions or TODO Blocks: GitHub Copilot supports markdown-based instruction files and inline TODO comments to guide its code generation. These instructions act like lightweight tickets embedded directly in the repo. For example, an INSTRUCTIONS.md might define architectural rules, file responsibilities, or interface contracts. Within code files, TODOs like // TODO: replace mock implementation with production-ready logic act as scoped prompts that Copilot can act on directly. Used consistently, these become in-repo signals that align the agent’s output with team expectations and design intent, markers inside the code to direct the model towards a specific change or design pattern.

Effective context curation is an engineering discipline. Give too little, and the agent hallucinates. Give too much, and it loses focus or runs out of space in the LLM context window. The best results come from curating the smallest possible set of high-signal resources. When you treat context as a design artifact the AI becomes a more reliable collaborator.

The Role of Workflows

We embedded AI in our delivery pipeline using a set of core workflows. You can explore each one in more detail in our handbook, but here is the high-level overview:

Workflow	Purpose
Spec-First	Write a scoped prompt plan before coding
Exploratory	Understand unfamiliar codebases with AI help
Memory Bank	Maintain continuity across sessions and team members
TDD	Test-first with AI-generated test coverage
Debugging	Use AI to triage, investigate, and fix bugs
Visual Feedback	Align AI output with Figma and screenshots
Auto Validations	Run tools like SonarQube, ESLint post-output

In our experience, these workflows are not just productivity boosters; they’re the foundation for scaling AI-assisted development across teams. They provide consistency, repeatability, and shared mental models. We believe this approach is especially critical in enterprise environments, where large engineering organizations require predictable output, quality assurance, and alignment with established standards. Agentic workflows bring just enough structure to harness AI’s strengths without sacrificing accountability or control.

Building a Validation Loop

We use validation tools like SonarQube, ESLint, Vitest, and Prettier to provide automatic feedback to the AI. For example, if SonarQube flags duplication, we prompt the AI to refactor accordingly. This creates a tight loop where validation tools become coaching signals.

Some tools, like GitHub Copilot, can even collect log output from the terminal running tests or executing scripts. This allows the AI to observe the outcome of code execution, analyze stack traces or test failures, and automatically attempt fixes. One common approach is asking the AI to run a test suite, interpret the failed test results, make corrections, and repeat this process until all tests pass.

Lizard, a tool that calculates code complexity metrics, is another useful validation tool. Engineers can instruct the AI to execute Lizard against the codebase. When the output indicates that a function exceeds the defined complexity threshold (typically 10), the AI is prompted to refactor that function into smaller, more maintainable blocks. This method forces the AI to act on specific, measurable quality signals and improves overall code readability.

In this setup, engineers can let the AI operate in a closed loop for several iterations. Once the AI produces clean validation results — whether through passing tests, static analysis, or complexity reduction — the human engineer steps back in to review the result. This combination of automation and oversight speeds up bug fixing while maintaining accountability.

But here’s the thing: the team needs to actually understand what the AI built. If you’re just rubber-stamping AI changes without really getting what they do, you’re setting yourself up for trouble. The review step isn’t just a checkbox — it’s where you make sure the code actually makes sense for your system.

Why Human Oversight Still Matters

No AI is accountable for what goes to production. Engineers are. AI doesn’t own architectural tradeoffs, domain-specific reasoning, or security assumptions. Human-in-the-loop is the safety mechanism.

Humans are the only ones who can recognize when business context changes, when a feature should be cut for scope, or when a security concern outweighs performance gains. AI can assist in code generation, validation, and even debugging — but it lacks the experience, judgment, and ownership required to make trade-offs that affect users, stakeholders, or the long-term health of the system.

Human engineers are also responsible for reviewing the AI’s decisions, ensuring they meet legal, ethical, and architectural constraints. This is especially critical in regulated industries, or when dealing with sensitive data. Without a human to enforce these standards, the risk of silent failure increases dramatically.

Agentic coding isn’t about handing off responsibility, it’s about amplifying good engineering judgment.

Where People Fail (And Blame the AI)

Common mistakes include vague prompts, lack of planning, poor context, and not validating output. While LLMs have inherent limitations — they hallucinate, make incorrect assumptions, and produce plausible-sounding but wrong outputs even with good inputs — engineering discipline significantly increases the reliability of results.

A prompt like “make this better” tells the AI nothing about what “better” means — faster? more readable? safer? Without clear constraints and context, LLMs default to producing generic solutions that may not align with your actual needs. The goal isn’t to eliminate all AI errors, but to create workflows that catch and correct them systematically.

Lack of validation is another key failure mode. Trusting the first output, skipping tests, or ignoring code quality tools defeats the point of the feedback loop. AI agents need boundaries and coaching signals or, without them, they can drift into plausible nonsense.

Using these tools effectively also means understanding their current limitations. AI models work best with well-represented programming languages like JavaScript, TypeScript, and Python (to name a few examples). However, teams working in specialized domains may see limited results even with popular languages.

A Closer Look at Our Tooling

GitHub Copilot played a key role in our experiment, especially when paired with instruction files, validation scripts, and Model Context Providers (MCPs).

What made GitHub Copilot viable for agentic workflows wasn’t just its autocomplete or inline chat. It was how we surrounded it with structure and feedback mechanisms:

Instruction Files

Instruction files served as the AI’s map. These markdown-based guides detailed the implementation plan, scoped tasks, architectural constraints, naming conventions, and even file-level goals. When placed inside the repo, they gave GitHub Copilot context it otherwise wouldn’t have. Unlike ad-hoc prompts, these files were written with intent and discipline, and became a critical part of the repo’s knowledge layer.

Validation Scripts

We paired Copilot with post-generation validation tools like ESLint, Vitest, Horusec, and SonarQube. These weren’t just guardrails but closers of the loop. When Copilot generated code that violated rules or failed tests, engineers would reframe the prompt with validation results as input. This prompted Copilot to self-correct. It’s how we turned passive AI output into an iterative feedback process.

Copilot + Workflows = Impact

Used this way, GitHub Copilot became more than a helper. It became a participant in our structured workflows:

• In Spec-First, Copilot consumed instruction files to scaffold code.
• In Debugging, it analyzed logs fed via MCP and proposed targeted fixes.
• In TDD, it generated unit tests from requirements, then refactored code until tests passed.
• In Visual Feedback, it aligned components with Figma via the design MCP.

By aligning Copilot with prompts, plans, validation, and context, we moved from “code completion” to code collaboration.

So no — GitHub Copilot isn’t enough on its own. But when embedded inside a disciplined workflow, with context and feedback flowing in both directions, it’s a capable agent. One that gets better the more structured your engineering practice becomes.

Final Advice: How to Actually Start

The path to agentic coding begins with a single, well-chosen task. Pick something atomic that you understand deeply — a function you need to refactor, a component you need to build, or a bug you need to fix. Before touching any AI tool, write an implementation plan that defines your goals, constraints, and step-by-step approach.

Once you have your plan, start experimenting with the workflows we’ve outlined. Try Spec-First to scaffold your implementation, then use Auto Validations to create feedback loops. If you’re working with UI, explore Visual Feedback with design tools. As you gain confidence, introduce Model Context Providers to give your AI agent richer context about your codebase and requirements. Always keep in mind that the quality of AI output depends on the quality of the task setup and the availability of feedback.

Treat each interaction as both an experiment and a learning opportunity. Validate every output as if it came from a junior developer. Most importantly, remember that this isn’t about replacing your engineering judgment; it’s about amplifying it. The most successful engineers in our experiments were the ones who treated the AI as a collaborator — not a magician.

What we’ve described isn’t just a productivity technique — it’s a fundamental shift in how we think about human creativity and machine capability. When engineers become high-level problem solvers, supported by AI agents within well-defined boundaries, we unlock new possibilities for what software teams can accomplish. Welcome to the next era of software development.

October 23, 2025 12:00 AM

A Fast Bytecode VM for Arithmetic: The Virtual Machine

In this series of posts, we write a fast bytecode compiler and a virtual machine for arithmetic in Haskell. We explore the following topics:

• Parsing arithmetic expressions to Abstract Syntax Trees (ASTs).
• Unit testing for our parser.
• Interpreting ASTs.
• Compiling ASTs to bytecode.
• Disassembling and decompiling bytecode.
• Unit testing for our compiler.
• Property-based testing for our compiler.
• Efficiently executing bytecode in a virtual machine (VM).
• Unit testing and property-based testing for our VM.
• Benchmarking our code to see how the different passes perform.
• All the while keeping an eye on performance.

In this final post, we write the virtual machine that executes our bytecode, and benchmark it.

This post was originally published on abhinavsarkar.net.

This post is part of the series: A Fast Bytecode VM for Arithmetic.

1. The Parser
2. The Compiler
3. The Virtual Machine (you are here)

Introduction

Bytecode Virtual Machines (VMs) are known to be faster than AST-walking interpreters. That’s why many real-world programming languages these days are implemented with bytecode VMs, for example, Java, Python, PHP, and Raku. The reason is partially, the flat and compact nature of bytecode itself. But VMs also have a few other tricks up their sleeves that make them highly performant. In this post, we write a VM for our arithmetic expression language, and explore some of these performance tricks.

But first, we need to finish a pending task.

Testing the Compiler

We wrote some unit tests for our compiler in the last post, but unit tests cover only the cases we can think of. A compiler has to deal with any input, and with just unit tests we cannot be sure of its correctness.

To test our compiler and other components for correctness, we use the QuickCheck library. QuickCheck is a Property-based Testing framework. The key idea of property-based testing is to write properties of our code that hold true for any input, and then to automatically generate a large number of arbitrary inputs and make sure that the properties are indeed true for them¹². Since we are writing an arithmetic expression parser/compiler/VM, we generate arbitrary expression ASTs, and use them to assert certain invariants of our program.

With QuickCheck, we write generators for the inputs for our tests. These generators are composable just like parser combinators are. We use the library provided generators to write small generators that we combine to create larger ones. Let’s start:

numGen :: Q.Gen Expr
numGen = Num <$> Q.arbitrary

varGen :: Set.Set Ident -> Q.Gen Expr
varGen vars = Var <$> Q.elements (Set.toList vars)
 
identGen :: Q.Gen Ident
identGen =
  mkIdent
    <$> ( (:)
            <$> Q.elements lower
            <*> Q.resize 5 (Q.listOf1 $ Q.elements validChars)
        ) `Q.suchThat` (not . isReservedKeyword . BSC.pack)
  where
    lower = ['a' .. 'z']
    validChars = lower <> ['A' .. 'Z']

First come the basic generators:

• numGen generates number expressions by using QuickCheck’s built-in arbitrary function.
• varGen generates variable expressions by choosing from the set of passed valid variable names.
• identGen generates valid identifiers from combinations of letters a—z and A—Z, and discarding ones that are reserved keywords.

Moving on to composite generators:

binOpGen :: Set.Set Ident -> Int -> Q.Gen Expr
binOpGen vars size =
  BinOp
    <$> Q.chooseEnum (Add, Div)
    <*> exprGen vars (size `div` 2)
    <*> exprGen vars (size `div` 2)

letGen :: Set.Set Ident -> Int -> Q.Gen Expr
letGen vars size = do
  x <- identGen
  let vars' = Set.insert x vars
  Let x <$> exprGen vars (size `div` 2) <*> exprGen vars' (size `div` 2)

exprGen :: Set.Set Ident -> Int -> Q.Gen Expr
exprGen vars size
  | size < 5 = Q.frequency [(4, Q.oneof baseGens), (1, Q.oneof compositeGens)]
  | otherwise = Q.frequency [(1, Q.oneof baseGens), (4, Q.oneof compositeGens)]
  where
    baseGens = numGen : [varGen vars | not $ Set.null vars]
    compositeGens = [binOpGen vars size, letGen vars size]

• binOpGen generates binary expressions with arbitrary binary operations. It recursively calls exprGen to generate the operands. The size parameter controls the complexity of the generated expressions, and we half the size of operands (and so on recursively) so that we don’t end up with infinitely large expressions.

• letGen generates Let expressions by generating an identifier, and then generating the assignment and body expressions recursively. We do the same trick of halving sizes here as well. Notice that the assignment is generated with the passed variable names in scope, whereas the body is generated with the new identifier added to the scope.

• exprGen uses the above generators to generate all kinds of expressions. At smaller sizes, it prefers to generate base expressions, while at larger sizes, it prefers composite ones. Due to the careful recursive halving of size in composite generators, we end up with expressions of finite sizes.

Finally, we have some instances of QuickCheck’s Arbitrary type class to tie everything together:

instance Q.Arbitrary Expr where
  arbitrary = Q.sized $ exprGen Set.empty
  shrink = Q.genericShrink

instance Q.Arbitrary Ident where
  arbitrary = identGen

instance Q.Arbitrary Op where
  arbitrary = Q.chooseEnum (Add, Div)

We can apply them in GHCi:

> :set -XTypeApplications
> Q.sample $ Q.arbitrary @Expr
0
((let jgSg = 2 in (-2 - -2)) + -2)
2
(0 / 1)
(-11 / -13)
((let kpuS = 10 in 31) + (let jChmZV = -12 in jChmZV))
((54 * -55) * (let ohLSk = 29 in -45))
(-102 - (-119 * -125))
(-234 - (32 / -217))
(let kVrB = (-261 * 238) in ((let qdz = 228 in 347) + 18))
(let uMMdXH = ((let ePUi = 842 in ePUi) - (let zrkM = (let vwH = ((9 + -987) / -487) in (let ylKowr = vwH in vwH)) in zrkM)) in (((uMMdXH / -836) / uMMdXH) - (let qkK = uMMdXH in qkK)))

Notice that the generated samples increase in complexity. With the generators in place, we define our properties next. Let’s test our parser first:

prop_print_ast_then_parse_returns_same_ast :: Spec
prop_print_ast_then_parse_returns_same_ast =
  prop "Property: Print AST then parse returns same AST" $ \expr ->
    parse (BSC.pack $ show expr) == Right expr

This property is a simple round-trip test for the parser and printer: we parse the string representation of a generated expression, and assert that it gives back the same expression.

The second property is a more involved round-trip test for the compiler and decompiler:

prop_disassemble_bytecode_then_decompile_then_compile_returns_same_bytecode :: Spec
prop_disassemble_bytecode_then_decompile_then_compile_returns_same_bytecode =
  prop ( "Property: Disassemble bytecode then decompile then compile"
         <> " returns same bytecode" ) $ \expr ->
    case compile (sizedExpr expr) of
      Left _ -> Q.discard
      Right bytecode ->
        (disassemble bytecode >>= (decompile >>> fmap sizedExpr) >>= compile)
          == Right bytecode

This asserts that compiling an expression, then disassembling and decompiling it, and finally compiling it again should result in the original bytecode³.

This requires a helper function to get the size of an expression:

sizedExpr :: Expr -> SizedExpr
sizedExpr expr = case expr of
  Num _ -> (expr, 3)
  Var _ -> (expr, 2)
  BinOp _ a b -> (expr, snd (sizedExpr a) + snd (sizedExpr b) + 1)
  Let _ a b -> (expr, snd (sizedExpr a) + snd (sizedExpr b) + 1)

We run these tests in a later section. This ends our short detour.

The Virtual Machine

Now for the main event: the virtual machine. Our VM is a stack-based machine that operates on a stack of values and executes the compiled bytecode. Our goal is to be as fast as possible. For a quick reminder, these are our Opcodes:

data Opcode
  = OPush !Int16        -- 0
  | OGet !Word8         -- 1
  | OSwapPop            -- 2
  | OAdd                -- 3
  | OSub                -- 4
  | OMul                -- 5
  | ODiv                -- 6
  deriving (Show, Read, Eq, Generic)

And now, the heart of the VM:

interpretBytecode :: Bytecode -> Result Int16
interpretBytecode = interpretBytecode' defaultStackSize

interpretBytecode' :: Int -> Bytecode -> Result Int16
interpretBytecode' stackSize bytecode = runST $ runExceptT $ do
  stack <- PA.newPinnedPrimArray stackSize
  sp <- go 0 0 stack
  checkStack InterpretBytecode stackSize sp
  PA.readPrimArray stack 0
  where
    !size = BS.length bytecode

    go sp ip _ | ip == size = pure sp
    go !sp !ip stack = do
      let opcode = readInstr bytecode ip
      if
        | sp >= stackSize -> throwInterpretError "Stack overflow"
        | sp < 0 -> throwInterpretError "Stack underflow"
        | sp < 2 && opcode >= 2 -> throwInsufficientElementsError
        | opcode == 0 && ip + 2 >= size -> throwIPOOBError $ ip + 2
        | opcode == 1 && ip + 1 >= size -> throwIPOOBError $ ip + 1
        | otherwise -> case opcode of
            0 -> do                 -- OPush
              PA.writePrimArray stack sp $ readInstrArgInt16 bytecode ip
              go (sp + 1) (ip + 3) stack
            1 -> do                 -- OGet
              let i = fromIntegral $ readInstrArgWord8 bytecode ip
              if i < sp
                then do
                  PA.copyMutablePrimArray stack sp stack i 1
                  go (sp + 1) (ip + 2) stack
                else throwInterpretError $
                  "Stack index " <> show i <> " out of bound " <> show (sp - 1)
            2 -> do                 -- OSwapPop
              PA.copyMutablePrimArray stack (sp - 2) stack (sp - 1) 1
              go (sp - 1) (ip + 1) stack
            3 -> interpretBinOp (+) -- OAdd
            4 -> interpretBinOp (-) -- OSub
            5 -> interpretBinOp (*) -- OMul
            6 -> do                 -- ODiv
              b <- PA.readPrimArray stack $ sp - 1
              a <- PA.readPrimArray stack $ sp - 2
              when (b == 0) $ throwInterpretError "Division by zero"
              when (b == (-1) && a == minBound) $
                throwInterpretError "Arithmetic overflow"
              PA.writePrimArray stack (sp - 2) $ a `div` b
              go (sp - 1) (ip + 1) stack
            n -> throwInterpretError $
              "Invalid bytecode: " <> show n <> " at: " <> show ip
      where
        interpretBinOp op = do
          b <- PA.readPrimArray stack $ sp - 1
          a <- PA.readPrimArray stack $ sp - 2
          PA.writePrimArray stack (sp - 2) $ a `op` b
          go (sp - 1) (ip + 1) stack
        {-# INLINE interpretBinOp #-}

        throwIPOOBError ip = throwInterpretError $
          "Instruction index " <> show ip <> " out of bound " <> show (size - 1)

        throwInsufficientElementsError =
          throwInterpretError "Not enough elements to execute operation"

        throwInterpretError = throwError . Error InterpretBytecode

The interpretBytecode' function is where the action happens. It is way more complex than interpretAST, but the complexity has a reason, namely performance.

interpretBytecode' runs inside the ST monad wrapped with the ExceptT monad transformer. ST monad lets us use mutable data structures locally while ensuring the function remains externally pure. ExceptT monad transformer adds support for throwing and propagating errors in a pure manner.

We use PrimArray for our stack, which is a mutable array of unboxed primitive types, in our case an array of Int16 values. Using a mutable unboxed array is much faster than using an immutable and/or boxed one like Seq or Vector due to reduced allocation and/or pointer chasing.

The core of the VM is the go function, a tight, tail-recursive loop that GHC compiles into an efficient machine loop, as we see later. It takes the stack pointer (sp), instruction pointer (ip)⁴, and the stack as arguments.

At the top of each loop, a block of guard clauses checks for stack overflow, underflow, and other error conditions before branching on the current opcode. Placing these checks at the top instead of inside the opcode cases is a deliberate choice. This may make the code slightly harder to understand, but it significantly improves the performance of the loop by moving all branching at the beginning of the loop, resulting in code that is more friendly to the CPU’s Branch Predictor. Also notice how we reduce the number of checks by working with a range of opcodes at once in the opcode >= 2 guard. The checks are also sorted so as to be most performant, guided by profiling and benchmarking⁵.

The handling of each opcode is actually pretty straightforward. We use different PrimArray specific operations to read and write to the stack, while taking care of doing the required bound and arithmetic checks. We also use the readInstr* functions that we wrote earlier.

After carrying out each operation, we reenter the loop by calling it tail-recursively with the right stack and instruction pointers. Finally, we make sure that the execution terminated correctly by checking the state of the stack, and return its first element.

Peeking Under the Hood: GHC Core

We see later that the VM is quite fast, but how does GHC achieve this performance? To see the magic, we can look at GHC’s intermediate language: Core. Core is a simpler functional language than Haskell to which GHC compiles Haskell. The simpler nature of Core makes it easier for GHC to optimize it, and compile it further. We can get the Core code for a program by compiling with the GHC option -ddump-simpl.

The actual Core code for our VM is too verbose to show here, but here is a simplified C-like pseudo-code version of our go loop:

$wgo (stack_addr, ip, sp) {
  if (ip == bytecode_size) {
    return sp;
  }
  if (sp >= stack_size) {
    throw "Stack Overflow";
  }
  if (sp < 0) {
    throw "Stack Underflow";
  }

  opcode = read_byte_at(bytecode_addr, ip);
  // ... other checks ...

  switch (opcode) {
    case 0: // OPush
      val = read_int16_at(bytecode_addr, ip + 1);
      write_int16_at(stack_addr, sp, val);
      jump $wgo(stack_addr, ip + 3, sp + 1);

    case 3: // OAdd
      val2 = read_int16_at(stack_addr, sp - 1);
      val1 = read_int16_at(stack_addr, sp - 2);
      write_int16_at(stack_addr, sp - 2, val1 + val2);
      jump $wgo(stack_addr, ip + 1, sp - 1);

    // ... other cases ...
  }
}

A few key optimizations are worth pointing out:

1. The loop: The tail-recursive go function is compiled into a proper loop. The jump $wgo(...) instruction is effectively a goto, which means there’s no function call overhead for each iteration of the VM loop.

2. Unboxing: The Core code is full of primitive, unboxed types like Int#, Addr#, and Word#, and operations on them. These are raw machine integers and memory addresses, not boxed Haskell objects. This means operations on them are as fast as they would be in C. The stack operations are not function calls on a PrimArray instance, but primitive memory reads and writes on a raw memory address stack_addr.

3. Inlining: The interpretBinOp helper function is completely inlined into the main loop. For OAdd, the code for reading two values, adding them, and writing the result is laid out inline, and works on unboxed values and array address.

In short, GHC has turned our high-level, declarative Haskell code into a low-level loop that looks remarkably like one we would write in C. We get the safety and expressiveness of Haskell, while GHC does the heavy lifting to produce highly optimized code. It’s the best of both worlds!

Testing the VM

We must test the VM to make sure it works correctly⁶. We reuse the success and failure tests for the AST interpreter, as the bytecode interpreter should yield the same result:

bytecodeInterpreterSpec :: Spec
bytecodeInterpreterSpec = describe "Bytecode interpreter" $ do
  forM_ astInterpreterSuccessTests $ \(input, result) ->
    it ("interprets: \"" <> BSC.unpack input <> "\"") $ do
      parseCompileInterpret input `shouldBe` Right result

  forM_ errorTests $ \(input, err) ->
    it ("fails for: \"" <> BSC.unpack input <> "\"") $ do
      parseCompileInterpret input `shouldSatisfy` \case
        Left (Error InterpretBytecode msg) | err == msg -> True
        _ -> False
  where
    parseCompileInterpret = parseSized >=> compile >=> interpretBytecode' 7

    errorTests =
      [ ("1/0", "Division by zero"),
        ("-32768 / -1", "Arithmetic overflow"),
        ( "let a = 0 in let b = 0 in let c = 0 in let d = 0 in let e = 0 in "
            <> "let f = 0 in a + b + c + d + e + f",
          "Stack overflow"
        )
      ]

prop_interpret_ast_returns_same_result_as_compile_assemble_then_interpret_bytecode ::
  Spec
prop_interpret_ast_returns_same_result_as_compile_assemble_then_interpret_bytecode =
  prop ( "Property: Interpret AST returns same result as compile"
          <> " then interpret bytecode" ) $ \expr ->
    interpretAST expr == (compile (sizedExpr expr) >>= interpretBytecode)

We also add a property-based test this time: for any given expression, interpreting the AST should produce the same result as compiling it to bytecode and executing it in the VM⁷.

Our test suite is complete now:

main :: IO ()
main = hspec $ do
  parserSpec
  astInterpreterSpec
  compilerSpec
  prop_print_ast_then_parse_returns_same_ast
  prop_disassemble_bytecode_then_decompile_then_compile_returns_same_bytecode
  bytecodeInterpreterSpec
  prop_interpret_ast_returns_same_result_as_compile_assemble_then_interpret_bytecode

And finally, we run all tests together:

Test run

$ cabal test -O2
Running 1 test suites...
Test suite specs: RUNNING...

Parser
  parses: "1 + 2 - 3 * 4 + 5 / 6 / 0 + 1" [✔]
  parses: "1+2-3*4+5/6/0+1" [✔]
  parses: "1 + -1" [✔]
  parses: "let x = 4 in x + 1" [✔]
  parses: "let x=4in x+1" [✔]
  parses: "let x = 4 in let y = 5 in x + y" [✔]
  parses: "let x = 4 in let y = 5 in x + let z = y in z * z" [✔]
  parses: "let x = 4 in (let y = 5 in x + 1) + let z = 2 in z * z" [✔]
  parses: "let x=4in 2+let y=x-5in x+let z=y+1in z/2" [✔]
  parses: "let x = (let y = 3 in y + y) in x * 3" [✔]
  parses: "let x = let y = 3 in y + y in x * 3" [✔]
  parses: "let x = let y = 1 + let z = 2 in z * z in y + 1 in x * 3" [✔]
  fails for: "" [✔]
  fails for: "1 +" [✔]
  fails for: "1 & 1" [✔]
  fails for: "1 + 1 & 1" [✔]
  fails for: "1 & 1 + 1" [✔]
  fails for: "(" [✔]
  fails for: "(1" [✔]
  fails for: "(1 + " [✔]
  fails for: "(1 + 2" [✔]
  fails for: "(1 + 2}" [✔]
  fails for: "66666" [✔]
  fails for: "-x" [✔]
  fails for: "let 1" [✔]
  fails for: "let x = 1 in " [✔]
  fails for: "let let = 1 in 1" [✔]
  fails for: "let x = 1 in in" [✔]
  fails for: "let x=1 inx" [✔]
  fails for: "letx = 1 in x" [✔]
  fails for: "let x ~ 1 in x" [✔]
  fails for: "let x = 1 & 2 in x" [✔]
  fails for: "let x = 1 inx" [✔]
  fails for: "let x = 1 in x +" [✔]
  fails for: "let x = 1 in x in" [✔]
  fails for: "let x = let x = 1 in x" [✔]
AST interpreter
  interprets: "1" [✔]
  interprets: "1 + 2 - 3 * 4 + 5 / 6 / 1 + 1" [✔]
  interprets: "1 + (2 - 3) * 4 + 5 / 6 / (1 + 1)" [✔]
  interprets: "1 + -1" [✔]
  interprets: "1 * -1" [✔]
  interprets: "let x = 4 in x + 1" [✔]
  interprets: "let x = 4 in let x = x + 1 in x + 2" [✔]
  interprets: "let x = 4 in let y = 5 in x + y" [✔]
  interprets: "let x = 4 in let y = 5 in x + let z = y in z * z" [✔]
  interprets: "let x = 4 in (let y = 5 in x + y) + let z = 2 in z * z" [✔]
  interprets: "let x = let y = 3 in y + y in x * 3" [✔]
  interprets: "let x = let y = 1 + let z = 2 in z * z in y + 1 in x * 3" [✔]
  fails for: "x" [✔]
  fails for: "let x = 4 in y + 1" [✔]
  fails for: "let x = y + 1 in x" [✔]
  fails for: "let x = x + 1 in x" [✔]
  fails for: "1/0" [✔]
  fails for: "-32768 / -1" [✔]
Compiler
  compiles: "1" [✔]
  compiles: "1 + 2 - 3 * 4 + 5 / 6 / 1 + 1" [✔]
  compiles: "1 + (2 - 3) * 4 + 5 / 6 / (1 + 1)" [✔]
  compiles: "let x = 4 in x + 1" [✔]
  compiles: "let x = 4 in let y = 5 in x + y" [✔]
  compiles: "let x = 4 in let x = x + 1 in x + 2" [✔]
  compiles: "let x = let y = 3 in y + y in x * 3" [✔]
  compiles: "let x = let y = 1 + let z = 2 in z * z in y + 1 in x * 3" [✔]
  compiles: "1/0" [✔]
  compiles: "-32768 / -1" [✔]
  fails for: "x" [✔]
  fails for: "let x = 4 in y + 1" [✔]
  fails for: "let x = y + 1 in x" [✔]
  fails for: "let x = x + 1 in x" [✔]
  fails for: "let x = 4 in let y = 1 in let z = 2 in y + x" [✔]
  fails for: "let x = 4 in let y = 5 in x + let z = y in z * z" [✔]
  fails for: "let a = 0 in let b = 0 in let c = 0 in let d = 0 in d" [✔]
  fails for greater sized expr [✔]
  fails for lesser sized expr [✔]
Property: Print AST then parse returns same AST [✔]
  +++ OK, passed 100 tests.
Property: Disassemble bytecode then decompile then compile returns same bytecode [✔]
  +++ OK, passed 100 tests.
Bytecode interpreter
  interprets: "1" [✔]
  interprets: "1 + 2 - 3 * 4 + 5 / 6 / 1 + 1" [✔]
  interprets: "1 + (2 - 3) * 4 + 5 / 6 / (1 + 1)" [✔]
  interprets: "1 + -1" [✔]
  interprets: "1 * -1" [✔]
  interprets: "let x = 4 in x + 1" [✔]
  interprets: "let x = 4 in let x = x + 1 in x + 2" [✔]
  interprets: "let x = 4 in let y = 5 in x + y" [✔]
  interprets: "let x = 4 in let y = 5 in x + let z = y in z * z" [✔]
  interprets: "let x = 4 in (let y = 5 in x + y) + let z = 2 in z * z" [✔]
  interprets: "let x = let y = 3 in y + y in x * 3" [✔]
  interprets: "let x = let y = 1 + let z = 2 in z * z in y + 1 in x * 3" [✔]
  fails for: "1/0" [✔]
  fails for: "-32768 / -1" [✔]
  fails for: "let a = 0 in let b = 0 in let c = 0 in let d = 0 in let e = 0 in let f = 0 in a + b + c + d + e + f" [✔]
Property: Interpret AST returns same result as compile then interpret bytecode [✔]
  +++ OK, passed 100 tests.

Finished in 0.0166 seconds
91 examples, 0 failures
Test suite specs: PASS

Happily, all tests pass.

Benchmarking the VM

Now for the fun part: benchmarking. We use the criterion library to benchmark the code.

{-# LANGUAGE GHC2021 #-}

module Main where

import ArithVMLib
import Control.Arrow ((>>>))
import Control.DeepSeq (force)
import Control.Exception (evaluate)
import Control.Monad ((>=>))
import Criterion
import Criterion.Main
import Criterion.Main.Options
import Criterion.Types
import Data.ByteString qualified as BS

main :: IO ()
main = do
  code <- BS.getContents >>= evaluate . force
  let Right ast = force $ parseSized code
      Right bytecode = force $ compile ast
      Right program = force $ disassemble bytecode
  runMode
    ( Run
        (defaultConfig {reportFile = Just "benchmark.html"})
        Prefix
        []
    )
    [ bgroup
        "pass"
        [ bench "parse" $ whnf (parseSized >>> force) code,
          bench "compile" $ whnf (compile >>> force) ast,
          bench "disassemble" $ whnf (disassemble >>> force) bytecode,
          bench "decompile" $ whnf (decompile >>> force) program
        ],
      bgroup
        "interpret"
        [ bench "ast" $ whnf (fst >>> interpretAST >>> force) ast,
          bench "bytecode" $ whnf (interpretBytecode >>> force) bytecode
        ],
      bgroup
        "run"
        [ bench "ast" $
            whnf (parse >=> interpretAST >>> force) code,
          bench "bytecode" $
            whnf (parseSized >=> compile >=> interpretBytecode >>> force) code
        ]
    ]

We have a benchmark suite to measure the performance of each pass, the two interpreters (AST and bytecode), and the full end-to-end runs⁸. We compile with the following GHC options:

 -O2
 -fllvm
 -funbox-strict-fields
 -funfolding-use-threshold=16
 -threaded
 -rtsopts
 -with-rtsopts=-N2

Benchmark run

$ cat benchmark.tb | cabal bench
Running 1 benchmarks...
Benchmark bench: RUNNING...
benchmarking pass/parse
time                 581.1 ms   (566.7 ms .. 594.3 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 573.5 ms   (570.4 ms .. 577.1 ms)
std dev              3.948 ms   (1.359 ms .. 5.424 ms)
variance introduced by outliers: 19% (moderately inflated)

benchmarking pass/compile
time                 51.00 ms   (50.48 ms .. 52.54 ms)
                     0.998 R²   (0.995 R² .. 1.000 R²)
mean                 50.82 ms   (50.57 ms .. 51.87 ms)
std dev              810.9 μs   (185.8 μs .. 1.509 ms)

benchmarking pass/disassemble
time                 160.3 ms   (154.7 ms .. 166.5 ms)
                     0.998 R²   (0.990 R² .. 1.000 R²)
mean                 155.8 ms   (150.0 ms .. 160.5 ms)
std dev              7.642 ms   (4.255 ms .. 11.76 ms)
variance introduced by outliers: 12% (moderately inflated)

benchmarking pass/decompile
time                 495.1 ms   (454.0 ms .. 523.7 ms)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 506.5 ms   (495.0 ms .. 525.1 ms)
std dev              17.73 ms   (2.167 ms .. 22.59 ms)
variance introduced by outliers: 19% (moderately inflated)

benchmarking interpret/ast
time                 49.57 ms   (49.53 ms .. 49.61 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 49.80 ms   (49.71 ms .. 50.07 ms)
std dev              255.9 μs   (124.2 μs .. 433.9 μs)

benchmarking interpret/bytecode
time                 15.83 ms   (15.79 ms .. 15.88 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 15.79 ms   (15.75 ms .. 15.83 ms)
std dev              96.85 μs   (70.30 μs .. 140.9 μs)

benchmarking run/ast
time                 628.0 ms   (626.7 ms .. 630.5 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 617.2 ms   (610.2 ms .. 621.0 ms)
std dev              6.679 ms   (1.899 ms .. 8.802 ms)
variance introduced by outliers: 19% (moderately inflated)

benchmarking run/bytecode
time                 643.8 ms   (632.5 ms .. 655.3 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 638.3 ms   (635.8 ms .. 641.2 ms)
std dev              2.981 ms   (1.292 ms .. 4.153 ms)
variance introduced by outliers: 19% (moderately inflated)

Benchmark bench: FINISH

Here are the results in a more digestible format:

Benchmark	Mean Time (ms)
pass/parse	573.5
pass/compile	50.8
pass/disassemble	155.8
pass/decompile	506.5
interpret/ast	49.8
interpret/bytecode	15.8
run/ast	617.2
run/bytecode	638.3

Here are the times in a chart (smaller is better):

<noscript></noscript>

Let’s break down these numbers:

• Parsing and decompiling are slow: At ~573ms and ~506ms, these are by far the slowest passes. This isn’t surprising. Parsing with parser combinators has a known trade-off of expressiveness for performance. Decompiling is a shift-reduce parser that reconstructs an AST from a linear stream of opcodes, and we didn’t spend any time optimizing it.
• Compilation is fast: At ~51ms, compilation is an order of magnitude faster than parsing. This is thanks to pre-calculating the bytecode size during the parsing phase, which allows us to pre-allocate a single ByteString and fill it in with low-level pointer operations.
• Bytecode interpretation is blazingly fast: At just ~16ms, our VM’s interpreter is over 3 times faster than the AST interpreter (~50ms), which proves our belief that bytecode interpreters are faster.
• End-to-end runs: Interestingly, the total time to run via bytecode (~638ms) is slightly slower than the run via AST (~617ms). This is because the cost of parsing, compiling, and then interpreting is higher than just parsing and interpreting. The real win for a bytecode VM comes when you compile once and run many times, amortizing the initial compilation cost.

I can already see readers thinking, “Sure that’s fast, but is it faster than C/Rust/Zig/my favourite language?” Let’s find out.

Benchmarking Against C

To get a better sense of our VM’s performance, I rewrote it in C.

The C implementation is a classic manual approach: a hand-written tokenizer and recursive-descent parser, structs with pointers for the AST, and manual memory management and error propagation. The VM is a simple while loop with a switch statement for dispatching opcodes⁹.

To compare our Haskell code against the C code, we need to write the last Haskell module, the CLI app that we demonstrated in the first post:

ArithVMApp.hs

{-# LANGUAGE GHC2021 #-}

module Main where

import ArithVMLib
import Control.Arrow ((>>>))
import Control.Monad ((>=>))
import Data.ByteString qualified as BS
import Data.Foldable (toList)
import Data.Set qualified as Set
import Data.String (IsString (fromString))
import Options.Applicative qualified as O
import System.Exit (exitFailure)
import System.IO qualified as IO
import Test.QuickCheck qualified as Q
import Text.Pretty.Simple qualified as PS

data Command
  = RunPass Pass Input
  | Run Input
  | Generate Int
  deriving (Show, Eq)

data Input = InputFP FilePath | InputStdin deriving (Show, Eq)

instance IsString Input where
  fromString = \case
    "-" -> InputStdin
    fp -> InputFP fp

commandParser :: IO Command
commandParser =
  O.customExecParser (O.prefs $ O.showHelpOnError <> O.showHelpOnEmpty)
    . O.info (O.hsubparser (mconcat subcommandParsers) O.<**> O.helper)
    $ O.fullDesc <> O.header "Bytecode VM for Arithmetic written in Haskell"
  where
    subcommandParsers =
      map
        ( \(command, pass, desc) ->
            O.command command
            . O.info (RunPass pass <$> inputParser)
            $ O.progDesc desc
        )
        [ ("read", Read, "Read an expression from file or STDIN"),
          ("parse", Parse, "Parse expression to AST"),
          ("print", Print, "Parse expression to AST and print it"),
          ("compile", Compile, "Parse and compile expression to bytecode"),
          ("disassemble", Disassemble, "Disassemble bytecode to opcodes"),
          ( "decompile",
            Decompile,
            "Disassemble and decompile bytecode to expression"
          ),
          ("interpret-ast", InterpretAST, "Parse expression and interpret AST"),
          ( "interpret-bytecode",
            InterpretBytecode,
            "Parse, compile and assemble expression, and interpret bytecode"
          )
        ]
        <> [ O.command "run" . O.info (Run <$> inputParser) $
               O.progDesc "Run bytecode",
             O.command "generate" . O.info (Generate <$> maxSizeParser) $
               O.progDesc "Generate a random arithmetic expression"
           ]

    inputParser =
      O.strArgument
        ( O.metavar "FILE"
            <> O.value InputStdin
            <> O.help "Input file, pass - to read from STDIN (default)"
        )

    maxSizeParser =
      O.option
        O.auto
        ( O.long "size"
            <> O.short 's'
            <> O.metavar "INT"
            <> O.value 100
            <> O.help "Maximum size of the generated AST"
        )

main :: IO ()
main = commandParser >>= runCommand

runCommand :: Command -> IO ()
runCommand = \case
  RunPass Read i -> run i (const $ pure ()) (\_ -> Right () :: Either String ())
  RunPass Parse i -> run i (const $ pure ()) parse
  RunPass Print i -> run i pPrintExpr parse
  RunPass Compile i -> run i BS.putStr $ parseSized >=> compile
  RunPass Decompile i -> run i pPrintExpr $ disassemble >=> decompile
  RunPass Disassemble i -> run i (mapM_ print) $ disassemble >>> fmap toList
  RunPass InterpretAST i -> run i print $ parse >=> interpretAST
  RunPass InterpretBytecode i ->
    run i print $ parseSized >=> compile >=> interpretBytecode
  Run i -> run i print interpretBytecode
  Generate maxSize -> Q.generate (exprGen Set.empty maxSize) >>= pPrintExpr
  where
    run input print process = do
      code <- case input of
        InputStdin -> BS.getContents
        InputFP fp -> BS.readFile fp
      case process code of
        Left err -> IO.hPrint IO.stderr err >> exitFailure
        Right val -> print val

    pPrintExpr =
      PS.pPrintOpt PS.CheckColorTty $
        PS.defaultOutputOptionsDarkBg
          { PS.outputOptionsIndentAmount = 2,
            PS.outputOptionsCompact = True
          }

We compile with the following GHC options¹⁰:

 -O2
 -fllvm
 -funbox-strict-fields
 -funfolding-use-threshold=16

And for the C version, we compile using GCC:

gcc -O3 arithvm.c -o arithvm -Wall

Now, let’s see how they stack up against each other. We use hyperfine to run the two executables.

Hyperfine run

$ arith-vm compile benchmark.tb > benchmark.tbc
# Haskell runs
$ hyperfine -L pass read,parse,compile,interpret-bytecode --warmup 10 -r 30 \
    "arith-vm {pass} benchmark.tb"
Benchmark 1: arith-vm read benchmark.tb
  Time (mean ± σ):      30.4 ms ±   0.2 ms    [User: 2.4 ms, System: 15.9 ms]
  Range (min … max):    30.0 ms …  30.9 ms    30 runs

Benchmark 2: arith-vm parse benchmark.tb
  Time (mean ± σ):     567.6 ms ±   5.7 ms    [User: 537.4 ms, System: 22.0 ms]
  Range (min … max):   554.7 ms … 579.9 ms    30 runs

Benchmark 3: arith-vm compile benchmark.tb
  Time (mean ± σ):     630.0 ms ±   4.5 ms    [User: 598.5 ms, System: 23.5 ms]
  Range (min … max):   622.6 ms … 641.1 ms    30 runs

Benchmark 4: arith-vm interpret-bytecode benchmark.tb
  Time (mean ± σ):     650.2 ms ±   4.9 ms    [User: 619.0 ms, System: 23.3 ms]
  Range (min … max):   640.9 ms … 656.6 ms    30 runs

$ hyperfine --warmup 10 -r 30 "arith-vm run benchmark.tbc"
Benchmark 1: arith-vm run benchmark.tbc
  Time (mean ± σ):      29.3 ms ±   0.2 ms    [User: 17.6 ms, System: 2.9 ms]
  Range (min … max):    28.9 ms …  29.6 ms    30 runs

# C runs
$ hyperfine -L pass read,parse,compile,interpret --warmup 10 -r 30 \
    "./arithvm {pass} benchmark.tb"
Benchmark 1: ./arithvm read benchmark.tb
  Time (mean ± σ):      14.2 ms ±   0.2 ms    [User: 0.8 ms, System: 13.0 ms]
  Range (min … max):    14.0 ms …  14.6 ms    30 runs

Benchmark 2: ./arithvm parse benchmark.tb
  Time (mean ± σ):     217.4 ms ±   2.6 ms    [User: 192.2 ms, System: 23.7 ms]
  Range (min … max):   213.6 ms … 223.9 ms    30 runs

Benchmark 3: ./arithvm compile benchmark.tb
  Time (mean ± σ):     254.5 ms ±   2.9 ms    [User: 228.3 ms, System: 24.7 ms]
  Range (min … max):   246.0 ms … 259.1 ms    30 runs

Benchmark 4: ./arithvm interpret benchmark.tb
  Time (mean ± σ):     267.9 ms ±   2.1 ms    [User: 241.5 ms, System: 24.9 ms]
  Range (min … max):   263.4 ms … 272.2 ms    30 runs

$ hyperfine --warmup 10 -r 30 "./arithvm run benchmark.tbc"
Benchmark 1: ./arithvm run benchmark.tbc
  Time (mean ± σ):      13.9 ms ±   0.1 ms    [User: 12.4 ms, System: 1.1 ms]
  Range (min … max):    13.6 ms …  14.1 ms    30 runs

Here’s a summary of the results:

Pass	C Time (ms)	Haskell Time (ms)	Slowdown
Read	14.2	30.4	2.14x
Parse	203.2	537.2	2.64x
Compile	37.1	62.4	1.68x
Interpret	13.4	20.2	1.51x
Run	13.9	29.3	2.11x

I have subtracted the times of previous passes to get the times for individual passes. Here’s the same in a chart (smaller is better):

<noscript></noscript>

As expected, the C implementation is faster across the board, between 1.5x to 2.6x. The biggest difference is in parsing, where the hand-written C parser is more than twice as fast as our combinator-based one. On the other hand, the Haskell VM is only 50% slower than the C VM. In my opinion, the Haskell code’s performance is quite respectable, especially given the safety, expressiveness and conciseness benefits, as illustrated by the code sizes¹¹:

Implementation	Lines of Code
C	775
Haskell	407

The Haskell implementation is almost half the size of the C code. I don’t know about you but I’m perfectly happy with the half as small, half as fast tread-off.

The benchmark results for the VMs become less surprising when I compare the C interpret function with the GHC Core code for interpretBytecode'¹².

int interpret(const uint8_t *bytecode, const long bytecode_size, int16_t *result) {
  VM vm;
  vm_init(&vm);

  while (vm.ip < bytecode_size) {
    if (vm.sp >= STACK_SIZE) { return VM_ERROR_STACK_OVERFLOW; }
    if (vm.sp < 0) { return VM_ERROR_STACK_UNDERFLOW; }

    const uint8_t op = bytecode[vm.ip];
    // other checks

    switch (op) {
    case OP_PUSH: {
      const uint8_t byte1 = bytecode[vm.ip + 1];
      const uint8_t byte2 = bytecode[vm.ip + 2];
      const int16_t value = (int16_t)((uint16_t)byte1 | ((uint16_t)byte2 << 8));

      vm.stack[vm.sp] = value;
      vm.sp++;
      vm.ip += 3;
      break;
    }

    case OP_ADD:
    case OP_SUB:
    case OP_MUL:
    case OP_DIV: {
      int16_t value1 = vm.stack[vm.sp - 2];
      int16_t value2 = vm.stack[vm.sp - 1];

      int16_t result;
      switch (op) {
      case OP_ADD: { result = value1 + value2; break; }
      case OP_SUB: { result = value1 - value2; break; }
      case OP_MUL: { result = value1 * value2; break; }
      case OP_DIV: {
        if (value2 == 0) { return VM_ERROR_DIVISION_BY_ZERO; }
        if (value2 == -1 && value1 == -32768) {
          return VM_ERROR_ARITHMETIC_OVERFLOW;
        }
        result = value1 / value2;
        break;
      }
      }

      vm.stack[vm.sp - 2] = result;
      vm.sp--;
      vm.ip++;
      break;
    }
    // ... other cases ...
    }
  }
  // ... final checks and return ...
}

This structure is almost a 1-to-1 match with the GHC Core code we saw earlier. The C while loop corresponds to the optimized $wgo function that GHC generates, the switch statement is almost identical to the case analysis on the raw opcode byte, and the C stack array is equivalent to the MutableByteArray# GHC uses. GHC effectively compiles our high-level Haskell into a low-level code that is structurally identical to what we wrote by hand in C¹³.

This explains why the performance is in the same ballpark. The remaining performance gap is probably due to the thin layer of abstraction that the Haskell runtime still maintains, but it’s remarkable how close we can get to C-like performance.

Future Directions

While our Haskell program is fast, we can improve certain things:

• Parser optimizations: As the benchmarks showed, parsing is our slowest pass. For better performance, we could replace our Attoparsec-based combinator parser with a parser generator like Alex and Happy, or even write a recursive-descent parser by hand.

• Superinstructions: We could analyze the bytecode for common instruction sequences (like OPush followed by OAdd) and combine them into single superinstructions. This would reduce the instruction dispatch overhead, but may make compilation slower.

• Register-based VM: A register-based VM, which uses a small array of virtual registers instead of a memory-based stack, could significantly reduce memory traffic and improve performance. This would require a more complex compiler capable of register allocation.

• Just-in-Time (JIT) compilation: The ultimate performance boost could come from a JIT compiler. Instead of interpreting bytecode, we could compile it to native machine code at runtime, eliminating the interpreter entirely. Maybe we could use LLVM to build a JIT compiler in Haskell.

Conclusion

And that’s a wrap! We successfully built a bytecode compiler and virtual machine in Haskell. We covered parsing, AST interpretation, compilation, and bytecode execution, as well as, debugging and testing functionalities. Let’s update our checklist:

• Parsing arithmetic expressions to Abstract Syntax Trees (ASTs).
• Unit testing for our parser.
• Interpreting ASTs.
• Compiling ASTs to bytecode.
• Disassembling and decompiling bytecode.
• Unit testing for our compiler.
• Property-based testing for our compiler.
• Efficiently executing bytecode in a virtual machine.
• Unit testing and property-based testing for our VM.
• Benchmarking our code to see how the different passes perform.
• All the while keeping an eye on performance.

The journey from a simple AST interpreter to a bytecode VM has been a rewarding one. We saw a significant performance improvement, learned about how compilers and VMs work, and how to write performant code in Haskell. While our Haskell implementation isn’t as fast as the hand-written C version, it’s far more concise and, I would argue, easier to reason about. It’s a great demonstration of Haskell’s power for writing high-performance—yet safe and elegant—code.

See the full code at:

• ArithVMLib.hs
• ArithVMSpec.hs
• ArithVMBench.hs
• ArithVMApp.hs
• arithvm.c

If you have any questions or comments, please leave a comment below. If you liked this post, please share it. Thanks for reading!

---

1. Actually, QuickCheck does not generate entirely arbitrary inputs. It generates arbitrary inputs with increasing complexity—where the complexity is defined by the user—and asserts the properties on these inputs. When a test fails for a particular input, QuickCheck also tries to simplify the culprit and tries to find the simplest input for which the test fails. This process is called Shrinking in QuickCheck parlance. QuickCheck then shows this simplest input to the user for them to use it to debug their code.↩︎

2. Read this good introduction to QuickCheck if you are unfamiliar.↩︎

3. Notice that we discard the expressions that do not compile successfully.↩︎

4. sp and ip are not actual pointers, but indices into the stack and bytecode arrays respectively.↩︎

5. Guided by the GHC profiler, I tweaked the code in many different ways and ran benchmarks for every change. Then I chose the code that was most performant.↩︎

6. It is extremely important to write good tests before getting your hands dirty with performance optimizations. In my case, the tests saved me many times from breaking the VM while moving code around for performance.↩︎

7. We are using our AST interpreter as a definitional interpreter, assuming it to be correctly implemented because of its simpler nature.↩︎

8. I ran all benchmarks on an Apple M4 Pro 24GB machine against a 142MB file generated using the expression generator we wrote earlier.↩︎

9. I don’t claim to be a great or even a good C programmer. In fact, this C VM is the first substantial C code I have written in decades. I’m sure the code is not most optimized. It may even be ridden with memory management bugs. If you find something wrong, please let me know in the comments.↩︎

10. I tried various RTS options to tweak GHC garbage collection, but the defaults proved to be fastest.↩︎

11. The lines of code are for only the overlapping functionalities between C and Haskell versions.↩︎

12. I did try using Direct Threading and Subroutine Threading in the C code, but they resulted in slower code than the switch-case variant. GCC may be smart enough in case of this simple VM to optimize the switch-case to be faster than threaded code.↩︎

13. You may have noticed that the C interpret function is not laid out in the exact same manner as the Haskell interpretBytecode'.go function. In case of C, moving the checks to the front did not yield in performance improvement. I suspect this may be because GCC is smart enough to do that optimization by itself. The nested switch were also no detriment to the performance of the C code.↩︎

This post is part of the series: A Fast Bytecode VM for Arithmetic.

1. The Parser
2. The Compiler
3. The Virtual Machine (you are here)

If you liked this post, please leave a comment.

by Abhinav Sarkar (abhinav@abhinavsarkar.net) at October 21, 2025 12:00 AM

Spatial DP: Finding the Largest Square

In the past two weeks we’ve explored a couple different problems in dynamic programming. These were simpler 1-dimensional problems. But dynamic programming is often at its most powerful when you can work across multiple dimensions. In today’s problem, we’ll consider a problem that is actually a 2D spatial problem where we can use dynamic programming.

If you want to learn how to write dynamic programming solutions in Haskell from the ground up, take a look at our Solve.hs course. DP is one of several algorithmic approaches you’ll learn in Module 3!

The Problem

Today’s problem (Maximal Square) is fairly simple conceptually. We are given a grid of 1’s and 0’s like so:

10100
11111
00111
10101

We must return the size of the largest square in the grid composed entirely of 1’s. So in the example above, the answer would be 4. There are two 2x2 squares we can form, starting in the 2nd row, using either the 3rd or 4th column as the “top left” of the square.

We can do a couple small edits to change the answer here. For example, we can flip the second ‘0’ in the bottom row and we’ll get a 3x3 grid, allowing the answer 9:

10100
11111
00111
10111

We could instead flip the second ‘1’ in the third row, and now the answer is only 1, as there are no 2x2 squares remaining:

10100
11111
00101
10101

The Algorithm

To solve this, we can imagine a DP grid that has “layers” where each layer has the same dimensions as the original grid. Each layer has a number “k” associated with it. The index {row,column} at layer k tells us whether or not a square of size k exists in the original grid with size k x k, with the cell {row, column} as its top left cell.

To construct this grid, we would need a base case and a recursive case. The base case is to consider layer 1. This is identical to the original grid we receive. Any location with 1 in the original grid is the top left for a 1x1 square.

So how do we build the layer k+1? This requires one simple insight. Suppose we are dealing with a single index {r,c}. In order for this to be the top left of a square of size k+1, we just need to check that 4 cells begin squares of size k: {r,c}, {r+1,c}, {r,c+1},{r+1,c+1}.

So to form the next layer, we just loop through each index in the layer and fill it in with 1 if it meets that criterion. Once we reach a layer where each entry is 0, we are done. We should return the square of the last layer we found.

There are a few optimizations possible here. Thinking back to our first DP problem, we didn’t need to store the full DP array since each new step only depended on a couple prior values. This time, we don’t need a full grid with “k” layers. We could alternate with only two grids, saving new values from the prior grid, and then making our “new” grid the “old” grid for the next layer.

But even simpler than that, we can keep modifying a single grid in place. Each “new” value we calculate depends on numbers below and/or to its right. So as long as we loop through the grid from left to right and top to bottom, we are safe modifying its values in place. At least, that’s what we’ll do in Rust. In Haskell we could do this with the mutable array API, but we’ll stick with the more conventional, immutable, approach in this article. (You can learn more about Haskell’s mutable arrays in Solve.hs).

Rust Solution

Let’s start with the Rust solution, demonstrating the mutable array approach. We’ll start by defining a series of terms, like the dimensions of our input and our dp grid (which is initially a clone of the input). We’ll also define a boolean (found) to indicate if we’ve found at least a single 1 on the current layer. We’ll track level, the number of layers confirmed to have a 1.

pub fn maximal_square(matrix: Vec<Vec<char>>) -> i32 {
    let m = matrix.len();
    let n = matrix[0].len();
    let mut level = 0;
    let mut dp = matrix.clone();
    let mut found = true;
    ...
    return level * level;
}

Of course, our final answer is just the square of the final “level” we determine. But how do we find this? We’ll need an outer while loop that terminates once we hit a level that does not hold a 1. We reset found as false to start each loop, but at the end of the loop, we’ll increment the level if we have found something.

pub fn maximal_square(matrix: Vec<Vec<char>>) -> i32 {
    let m = matrix.len();
    let n = matrix[0].len();
    let mut level = 0;
    let mut dp = matrix.clone();
    let mut found = true;
    while (found) {
        found = false;
        ...
        if (found) {
            level += 1;
        }
    }
    return level * level;
}

Now the core of the “layer” loop is to loop through each cell, left to right and top to bottom.

pub fn maximal_square(matrix: Vec<Vec<char>>) -> i32 {
    ...
    while (found) {
        found = false;
        for i in 0..m {
            for j in 0..n {
                ...
            }
        }
        if (found) {
            level += 1;
        }
    }
    return level * level;
}

So what happens inside the loop? When we hit a 0 cell, we don’t need to do anything. It always remains a 0 and we haven’t “found” anything. But interesting things happen if we hit a 1.

First, we note that found is now true - this layer is not empty. We have found a k x k square. But second, we should now reset this cell as 0 if it does not make a square of size k+1. We need to first check the dimensions to make sure we don’t go out of bounds, but then also check the 3 spaces, to the right, below, and diagonally away from us. If any of these are 0, we reset this cell as 0.

pub fn maximal_square(matrix: Vec<Vec<char>>) -> i32 {
    ...
    while (found) {
        found = false;
        for i in 0..m {
            for j in 0..n {
                if (dp[i][j] == '1') {
                    found = true;
                    if (i + 1 >= m || 
                        j + 1 >= n || 
                        dp[i][j+1] == '0' ||
                        dp[i+1][j] == '0' ||
                        dp[i+1][j+1] == '0') {
                        dp[i][j] = '0';
                    }
                }
            }
        }
        if (found) {
            level += 1;
        }
    }
    return level * level;
}

And just by filling in this logic, our function is suddenly done! Our inner loop is complete, and our outer loop will break once we find no more increasingly large squares. Here is the full Rust solution:

pub fn maximal_square(matrix: Vec<Vec<char>>) -> i32 {
    let m = matrix.len();
    let n = matrix[0].len();
    let mut level = 0;
    let mut dp = matrix.clone();
    let mut found = true;
    while (found) {
        found = false;
        for i in 0..m {
            for j in 0..n {
                if (dp[i][j] == '1') {
                    found = true;
                    if (i + 1 >= m || 
                        j + 1 >= n || 
                        dp[i][j+1] == '0' ||
                        dp[i+1][j] == '0' ||
                        dp[i+1][j+1] == '0') {
                        dp[i][j] = '0';
                    }
                }
            }
        }
        if (found) {
            level += 1;
        }
    }
    return level * level;
}

Haskell Solution

Now let’s write this in Haskell. We’ll start with a few definitions, including a type alias for our DP map. We’ll take an Array as the problem input, but we want a HashMap for our stateful version since we can “mutate” a HashMap efficiently:

type SquareMap = HM.HashMap (Int, Int) Bool

maximalSquare :: A.Array (Int, Int) Bool -> Int
maximalSquare grid = ...
  where
    ((minRow,minCol), (maxRow, maxCol)) = A.bounds grid
    initialMap = HM.fromList [vs | vs <- A.assocs grid]

    ...

Now we’ll define two loop functions - one for the inner loop, one for the outer loop. The “state” for the inner loop is our current level number, as well as the map of the previous layer. The inner loop (coordLoop) should return us an updated map, as well as the found bool value telling us if we’ve found at least a single 1 in the prior layer.

maximalSquare :: A.Array (Int, Int) Bool -> Int
maximalSquare grid = ...
  where
    ((minRow,minCol), (maxRow, maxCol)) = A.bounds grid
    initialMap = HM.fromList [vs | vs <- A.assocs grid]

    coordLoop :: (Bool, SquareMap) -> (Int, Int) -> (Bool, SquareMap)
    coordLoop (found, mp) coord@(r, c) = ...

    loop :: Int -> HM.HashMap (Int, Int) Bool -> Int
    loop level mp = ...

    ...

Notice that coordLoop has the argument pattern for foldl, rather than foldr. We want to loop through our coordinates in the proper order, from left to right and top down. If we use a right fold over the indices of the grid, it will go in reverse order.

Let’s start by filling in the inner loop. The first thing to do is determine if the found value needs to change. This is the case if we discover a True value at this index:

maximalSquare :: A.Array (Int, Int) Bool -> Int
maximalSquare grid = ...
  where
    ((minRow,minCol), (maxRow, maxCol)) = A.bounds grid
    initialMap = HM.fromList [vs | vs <- A.assocs grid]

    coordLoop :: (Bool, SquareMap) -> (Int, Int) -> (Bool, SquareMap)
    coordLoop (found, mp) coord@(r, c) =
      let found' = found || mp HM.! coord
          ...
      in  (found’, ...)

Now we need the 5 conditions that tell us if this cell should get cleared. Calculate all these, and insert False at the cell if any of them match. Otherwise, keep the map as is!

maximalSquare :: A.Array (Int, Int) Bool -> Int
maximalSquare grid = ...
  where
    ((minRow,minCol), (maxRow, maxCol)) = A.bounds grid
    initialMap = HM.fromList [vs | vs <- A.assocs grid]

    coordLoop :: (Bool, SquareMap) -> (Int, Int) -> (Bool, SquareMap)
    coordLoop  (found, mp) coord@(r, c) =
      let found' = found || mp HM.! coord
          tooRight = c >= maxCol
          tooLow = r >= maxRow
          toRight = mp HM.! (r, c + 1)
          under = mp HM.! (r + 1, c)
          diag = mp HM.! (r + 1, c + 1)
          failNext = tooLow || tooRight || not toRight || not under || not diag
          mp' = if failNext then HM.insert coord False mp else mp
      in  (found', mp')

    ...

Now for the outer loop, we use foldl to go through our coordinates using the coordLoop. If we’ve found at least 1 square at this size, then we recurse with the new map and an incremented size. Otherwise we return the square of the current level. Then we just need to call this loop with initial values:

```haskell
type SquareMap = HM.HashMap (Int, Int) Bool

maximalSquare :: A.Array (Int, Int) Bool -> Int
maximalSquare grid = loop 0 initialMap
  where
    ((minRow,minCol), (maxRow, maxCol)) = A.bounds grid
    initialMap = HM.fromList [vs | vs <- A.assocs grid]

    coordLoop :: (Bool, SquareMap) -> (Int, Int) -> (Bool, SquareMap)
    coordLoop  (found, mp) coord@(r, c) = ...

    loop :: Int -> HM.HashMap (Int, Int) Bool -> Int
    loop level mp =
      let (found, mp') = foldl coordLoop (False, mp) (A.indices grid)
      in  if found then loop (level + 1) mp' else (level * level)

This completes our Haskell solution!

type SquareMap = HM.HashMap (Int, Int) Bool

maximalSquare :: A.Array (Int, Int) Bool -> Int
maximalSquare grid = loop 0 initialMap
  where
    ((minRow,minCol), (maxRow, maxCol)) = A.bounds grid
    initialMap = HM.fromList [vs | vs <- A.assocs grid]

    coordLoop :: (Bool, SquareMap) -> (Int, Int) -> (Bool, SquareMap)
    coordLoop  (found, mp) coord@(r, c) =
      let found' = found || mp HM.! coord
          tooRight = c >= maxCol
          tooLow = r >= maxRow
          toRight = mp HM.! (r, c + 1)
          under = mp HM.! (r + 1, c)
          diag = mp HM.! (r + 1, c + 1)
          failNext = tooLow || tooRight || not toRight || not under || not diag
          mp' = if failNext then HM.insert coord False mp else mp
      in  (found', mp')

    loop :: Int -> HM.HashMap (Int, Int) Bool -> Int
    loop level mp =
      let (found, mp') = foldl coordLoop (False, mp) (A.indices grid)
      in  if found then loop (level + 1) mp' else (level * level)

Conclusion

Next week we’ll look at one more multi-dimensional DP problem where the dimensions aren’t quite as obvious in this spatial way. The best way to understand DP is to learn related concepts from scratch, including your basic use-it-or-lose-it problems and memoization. You’ll study all these concepts and learn Haskell implementation tricks in Module 3 of Solve.hs. Enroll in the course now!

by James Bowen at October 20, 2025 08:30 AM

71: Stefan Wehr

Stefan Wehr is a professor at the Offenburg University of Applied Sciences. Before becoming a professor, Stefan worked in industry on a large Haskell codebase - specifically one that's not a compiler and not a blockchain. So of course we talked about using Haskell in large projects, software architecture, modularity, type classes and data modeling and the suppression of sums outside of functional programming, and also about teaching Haskell at his current job.

by Haskell Podcast at October 16, 2025 08:00 AM

Exploring Arrows for sequencing effects

Last time, we explored common methods of sequencing effects into little programs. If you haven't read it yet, I'd recommend starting with that, but you can probably manage without it if you insist.

We examined Applicatives, Monads, and Selective Applicatives, and each of these systems had its own trade-offs. We dug into how all approaches exist on the spectrum between being expressive or analyzable and at the end of the post we were unfortunately left wanting something better. Monads reign supreme when it comes to expressiveness as they can express any possible programs we may want to write, but they offer essentially no ability to analyze program they represent without executing it.

On the other hand, Applicatives and Selective Applicatives offered reasonable program analysis, but are unable to express complex programs. They can't even encode programs in which downstream effects materially depend on the results of upstream effects.

These approaches are all based on the same Functor-Applicative-Monad hierarchy, in this post we'll set that aside and rebuild on an altogether different foundation to see if we can do even better.

Setting the goal posts

Before putting in the work let's think critically about the what we felt was missing from the Monad hierarchy and what we wish to gain from a new system.

Here's my wish-list:

• I want to be able to list out every effect that program might perform without executing anything.
• I want to understand the dependencies between the effects including the flow of data between them.
• I want to be able to express programs in which downstream effects can fully utilize the results of upstream effects.

Looking at these requirements, the biggest problem with the Monadic effects system is that it's far too rough-grained in how it handles the results of previous effects. We can see this by reviewing the signature of bind:

(>>=) :: Monad m => m a -> (a -> m b) -> m b

We can see that the result from the previous effect is passed to an arbitrary Haskell function whose job is to return the entire continuation of the program! This permits that function to swap out the entire rest of the program on any particular run, which I'd argue is way more power than the vast majority of reasonable programs require. This is quite frankly a dangerous amount of expressive power, what sort of programs are you writing where you can't even statically identify the possible code paths that might be taken? Even more complex flows like branching, looping and recursion can be expressed in a more structured way without resorting to this sledgehammer level of dynamism.

This tells us we have some room to constrain our programs a bit, and if we're economical about how we do it we can trade that power for the benefits we desire.

We still need to utilize these past results, but we want to avoid opening Pandora's box. That is, we must be careful not to allow the creation of new effects by running arbitrary Haskell functions at execution time. So, in order to use results without a continuation-building function like Monads use, we must meaningfully include the inputs and outputs for our effects in the structure of our effect system itself. We also know that we need to be able to chain these effects together, so we'll need some way to compose them.

If it's not obvious already, this is a great fit for the Category typeclass:

class Category k where
  id :: k a a
  (.) :: k b c -> k a b -> k a c

This already gives us a lot of what we want. Unlike Monads which bake outputs into the continuation of the program using function closures, the Category structure routes inputs and outputs explicitly as part of its structure. Unsurprisingly, it's quite a natural fit; after all, it's called Category Theory, not Monad Theory...

Rebuilding on Categories

Now let's begin to re-implement the examples from the previous post using this new Category-based effect system. In order to save some time, we're actually going to jump up the hierarchy a bit all the way to Arrows.

The Arrow class, if you're not familiar with it, looks like this:

class Category a => Arrow (a :: Type -> Type -> Type) where
  arr :: (b -> c) -> a b c
  (***) :: a b c -> a b' c' -> a (b, b') (c, c')

There are a few other methods we get for free, but this is a minimal set of methods we need to define.

Notice that it has a Category superclass, so we'll use identity and composition from there. We can leverage arr to lift pure Haskell functions into our Category structure. I know we just said we wanted to avoid arbitrary Haskell functions, but note that in this case, just like Applicatives, the function is pure, we can't determine any effects or structure of the effects within the function. No problems here.

We'll re-visit (***) in just a minute.

To get started, how about we re-implement the program we wrote using Applicative in the previous post?

I'll save you from clicking over, here's a refresher on what we did before:

import Control.Applicative (liftA3)
import Control.Monad.Writer (Writer, runWriter, tell)

class (Applicative m) => ReadWrite m where
  readLine :: m String
  writeLine :: String -> m ()

data Command
  = ReadLine
  | WriteLine String
  deriving (Show)

-- | We can implement an instance which runs a dummy interpreter that simply records the commands
-- the program wants to run, without actually executing anything for real.
instance ReadWrite (Writer [Command]) where
  readLine = tell [ReadLine] *> pure "Simulated User Input"
  writeLine msg = tell [WriteLine msg]

-- | A helper to run our program and get the list of commands it would execute
recordCommands :: Writer [Command] String -> [Command]
recordCommands w = snd (runWriter w)

-- | A simple program that greets the user.
myProgram :: (ReadWrite m) => String -> m String
myProgram greeting =
  liftA3
    (\_ name _ -> name)
    (writeLine (greeting <> ", what is your name?"))
    readLine
    (writeLine "Welcome!")

-- We can now run our program in the Writer applicative to see what it would do!
main :: IO ()
main = do
  let commands = recordCommands (myProgram "Hello")
  print commands

-- [WriteLine "Hello, what is your name?", ReadLine, WriteLine "Welcome!"]

The key aspects of this Applicative version were that we could analyze any program which required only an Applicative constraint to get the full list of sequential effects that the program would perform.

Here's the same program, but this time we'll encode the effects using Arrow constraints instead.

But first, a disclaimer: writing Arrow-based programs looks ugly, but don't worry, bear with me for a bit and we'll address that later.

Just like the Applicative version, we'll define a typeclass as the interface to our set of ReadWrite effects, but this time will assume an Arrow constraint:

import Control.Arrow
import Control.Category
import Prelude hiding (id)

class (Arrow k) => ReadWrite k where
  -- Readline has no interesting input, so we use () as input type.
  readLine :: k () String

  -- We track the inputs for the writeLine directly in the Category structure.
  writeLine :: k String ()

-- Helper for embedding a static Haskell value directly into an Arrow
constA :: (Arrow k) => b -> k a b
constA b = arr (\_ -> b)

-- | A simple program which uses a statically provided message to greet the user.
myProgram :: (ReadWrite k) => String -> k () ()
myProgram greeting =
  constA (greeting <> ", what is your name?")
    >>> writeLine
    >>> readLine
    >>> constA "Welcome!"
    >>> writeLine

Great, that should feel pretty straight-forward, it's trivial to convert sequential Applicative programs like this.

In order to run it, we still need to use the IO monad, since that's just how base does IO, but we can use the nifty Kleisli newtype wrapper which turns any monadic computation into a valid Arrow by embedding the monadic effects into the Arrow structure.

Here's how we implement the ReadWrite instance for Kleisli IO:

instance ReadWrite (Kleisli IO) where
  readLine = Kleisli $ \() -> getLine
  writeLine = Kleisli $ \msg -> putStrLn msg

run :: Kleisli IO i o -> i -> IO o
run prog i = do
  runKleisli prog i

And it runs just fine:

>>> run (myProgram "Hello") ()
Hello, what is your name?
Chris
Welcome!

Let's look a little closer at Kleisli:

newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }

Look familiar? It's just the continuation function from monadic bind hiding in there.

There's a difference though, now that arbitrary function is part of our implementation, not our interface!

This is important, because it means we can invent a different implementation of our ReadWrite interface that just tracks the effects that doesn't have to deal with arbitrary binds like this.

Let's implement a command-recorder that does exactly that.

data Command
  = ReadLine
  | WriteLine
  deriving (Show)

-- Just like the applicative we create a custom implementation of the interface which for static analysis.
-- The parameters are phantom, we won't be running anything, so we only care about
-- the structure of the effects for now.
data CommandRecorder i o = CommandRecorder [Command]

-- We need a Category instance since it's a pre-requisite for Arrow:
instance Category CommandRecorder where
  -- The identity command does nothing, so it records no commands.
  id = CommandRecorder []

  -- Composition of two CommandRecorders just collects their command lists.
  (CommandRecorder cmds2) . (CommandRecorder cmds1) = CommandRecorder (cmds1 <> cmds2)

-- Now the Arrow instance.
instance Arrow CommandRecorder where
  -- We know this function must be pure (barring errors), so we don't
  -- need to track any effects from it.
  arr _ = CommandRecorder []

  -- Don't worry about this combinator yet, we'll come back to it.
  -- For now we'll collect the effects from both sides.
  (CommandRecorder cmds1) *** (CommandRecorder cmds2) = CommandRecorder (cmds1 <> cmds2)

-- | Now implementing the ReadWrite instance is just a matter of collecting the commands
-- the program is running.
instance ReadWrite CommandRecorder where
  readLine = CommandRecorder [ReadLine]
  writeLine = CommandRecorder [WriteLine]

-- | A helper to run our program and get the list of commands it would execute
recordCommands :: CommandRecorder i o -> [Command]
recordCommands (CommandRecorder cmds) = cmds

-- | Here's a helper for printing out the effects a program will run.
analyze :: CommandRecorder i o -> IO ()
analyze prog = do
  let commands = recordCommands prog
  print commands

We can analyze our program and it'll show us which effects it will run if we were to execute it:

>>> analyze (myProgram "Hello")
[WriteLine,ReadLine,WriteLine]

Okay, we've achieved the ability to analyze and execute our program at parity with the Applicative version, but isn't it silly that we're asking the user their name and simply ignoring it? As it turns out, our Arrow interface is quantifiably more expressive: we can use results of past effects in future effects! Since we're now allowing writeLine to take it's input dynamically we no longer track the output in the structure of the command itself. This bit might seem like a step back, but if you still wanted the old version you could of course still define it: writeLineStatic :: String -> k () (). Arrows allow us the flexibility to choose which we prefer. We'll chat a bit more about this later in the article.

Here's something we couldn't do with the Applicative version, we can rewrite the program to greet the user by the name they provide. While we're at it, why not receive the greeting message as an input too?

-- | This program uses the name provided by the user in the response.
myProgram2 :: (ReadWrite k) => k String ()
myProgram2 =
  arr (\greeting -> greeting <> ", what is your name?")
    >>> writeLine
    >>> readLine
    >>> arr (\name -> "Welcome, " <> name <> "!")
    >>> writeLine

Composing arrows lets us route data from one effect to the next, and arr let's us map over values to change them just like fmap does for Functors. The structure of the effects are still statically defined, so even when routing input we can still analyze the entire program ahead of time:

>>> analyze myProgram2
[WriteLine, ReadLine, WriteLine]

>>> run myProgram2 "Hello"
Hello, what is your name?
Chris
Welcome, Chris!

Nifty!

Levelling Up

We're off to a great start, the ability to use the results of past effects is already better than we could get from Selective Applicative, without sacrificing any of the analysis capabilities we had in the Applicative version.

However, at the moment our programs are all still just linear sequences of commands. What happens if we want to route results from an earlier effect down to one far later in the program?

We need a bit more power, time to call back to that (***) we ignored earlier, and while we're at it, let's look at (&&&) too, which we get for free when we implement (***).

(***) :: Arrow k => k a b -> k c d -> k (a, c) (b, d)
(&&&) :: Arrow k => k a b -> k a c -> k a (b, c)

These operators allow us to take two independent programs in our arrow interface and compose them in parallel to one another, rather than sequentially. What parallel means is going to be up to the implementation (within the scope of the Arrow laws), but the key part is that these two sides don't depend on each other, which is distinct from the normal sequential composition we've been doing with (>>>).

With these we can write a now write a slightly more complex program which routes values around, and can forward values from earlier effects to later ones.

import UnliftIO.Directory qualified as Directory

-- The effects we'll need for this example
class (Arrow k) => FileCopy k where
  readLine :: k () String
  writeLine :: k String ()
  copyFile :: k (String, String) ()

data Command
  = ReadLine
  | WriteLine
  | CopyFile
  deriving (Show)

-- Here's the real executable implementation
instance FileCopy (Kleisli IO) where
  readLine = Kleisli $ \() -> getLine
  writeLine = Kleisli $ \msg -> putStrLn msg
  copyFile = Kleisli $ \(src, dest) -> Directory.copyFile src dest

-- Helper prompting the user for input.
prompt :: (FileCopy cat) => String -> cat a String
prompt msg =
  pureC msg
    >>> writeLine
    >>> readLine

fileCopyProgram :: (FileCopy k) => k () ()
fileCopyProgram =
  ( prompt "Select a file to copy"
      &&& prompt "Select the destination"
  )
    >>> copyFile

This program prompts the user for a source file and a destination file, then copies the source file to the destination. Notably, each prompt is independent of one another, that is, they don't have any data-dependencies on one another. But, copyFile takes two arguments, the results of each prompt. (&&&) allows us to express this.

Let's run it:

>>> run fileCopyProgram ()
Select a file to copy
ShoppingList.md
Select the destination
ShoppingList.backup

Uhh, okay so you can't see the result, but trust me it works! Kleisli's implementation of (***) just runs the left side, then the right side; but if, for other applications, you wanted real parallel execution you could write your implementation which runs each pair of parallel operations using Concurrently or something like it and your program will magically become as parallel as your data-dependencies allow! Caveat emptor, but at least having the option is nice, we don't get that from the Monadic interface where data-dependencies are hidden from us.

Now for the analysis.

We could, of course, still collect and print out the list of effects that would be run, but I'm bored of that, so let's level that up too. Now that we have both sequential and parallel composition, our programs are a tree of operations, so our analysis tools should probably follow suite.

Here's a rewrite of our CommandRecorder which tracks the whole tree of effects:

-- | We can represent the effects in our computations as a tree now.
data CommandTree eff
  = Effect eff
  | Identity
  | Composed (CommandTree eff {- >>> -}) (CommandTree eff)
  | -- (***)
    Parallel
      (CommandTree eff) -- First
      (CommandTree eff) -- Second
  deriving (Show, Eq, Ord, Functor, Traversable, Foldable)

data CommandRecorder eff i o = CommandRecorder (CommandTree eff)

instance Category (CommandRecorder eff) where
  -- The identity command does nothing, so it records no commands.
  id = CommandRecorder Identity

  -- I collapse redundant 'Identity's for clarity.
  -- The category laws make this safe to do.
  (CommandRecorder Identity) . (CommandRecorder cmds1) = CommandRecorder cmds1
  (CommandRecorder cmds2) . (CommandRecorder Identity) = CommandRecorder cmds2
  (CommandRecorder cmds2) . (CommandRecorder cmds1) = CommandRecorder (Composed cmds1 cmds2)

instance Arrow (CommandRecorder eff) where
  -- We don't bother tracking pure functions, so arr is a no-op.
  arr _f = CommandRecorder Identity

  -- Track when we fork into parallel execution paths as part of the tree.
  (CommandRecorder cmdsL) *** (CommandRecorder cmdsR) = CommandRecorder (Parallel cmdsL cmdsR)

-- | The interface implementation just tracks the commands
instance FileCopy (CommandRecorder Command) where
  readLine = CommandRecorder (Effect ReadLine)
  writeLine = CommandRecorder (Effect WriteLine)
  copyFile = CommandRecorder (Effect CopyFile)

analyze :: CommandRecorder Command i o -> IO ()
analyze prog = do
  let commands = recordCommands prog
  putStrLn $ renderCommandTree commands

Now we can build the tree of effects, let's take advantage of that and render it as a tree too!

Here's a function that renders any program tree down into a flow-chart description using the mermaid diagramming language.

Don't judge me for the implementation of my mermaid renderer... In fact, if you have a nicer one please send it to me :)

(It's not terribly important, so feel free to skip it)

diagram :: CommandRecorder Command i o -> IO ()
diagram prog = do
  let commands = recordCommands prog
  putStrLn $ commandTreeToMermaid commands

-- | A helper to render our command tree as a flow-chart style mermaid diagram.
commandTreeToMermaid :: forall eff. (Show eff) => CommandTree eff -> String
commandTreeToMermaid cmdTree =
  let preamble = "flowchart TD\n"
      (outputNodes, links) =
        renderNode cmdTree
          & flip runReaderT (["Input"] :: [String])
          & flip evalState (0 :: Int)
   in preamble
        <> unlines
          ( links
              <> ((\output -> output <> " --> Output") <$> outputNodes)
          )
  where
    newNodeId :: (MonadState Int m) => m Int
    newNodeId = do
      n <- get
      put (n + 1)
      return n
    renderNode :: CommandTree eff -> ReaderT [String] (State Int) ([String], [String])
    renderNode = \case
      Effect cmd -> do
        prev <- ask
        nodeId <- newNodeId
        let cmdLabel = show cmd
            nodeDef = show nodeId <> "[" <> cmdLabel <> "]"
            links = do
              x <- prev
              pure $ x <> (" --> " <> nodeDef)
        pure ([nodeDef], links)
      Identity -> do
        nodeId <- newNodeId
        prev <- ask
        let nodeDef = show nodeId <> ("[Identity]")
        let links = do
              x <- prev
              pure $ x <> (" --> " <> nodeDef)
        pure ([nodeDef], links)
      Composed cmds1 cmds2 -> do
        (leftIds, leftNode) <- renderNode cmds1
        (rightIds, rightNode) <- local (const leftIds) $ renderNode cmds2
        pure (rightIds, leftNode <> rightNode)
      Parallel cmds1 cmds2 -> do
        prev <- ask
        nodeId <- newNodeId
        let nodeDef = show nodeId <> ("[Parallel]")
        (leftIds, leftNode) <- local (const [nodeDef]) $ renderNode cmds1
        (rightIds, rightNode) <- local (const [nodeDef]) $ renderNode cmds2
        let thisLink = do
              x <- prev
              pure $ x <> (" --> " <> nodeDef)
            links =
              thisLink
                <> leftNode
                <> rightNode
        pure (leftIds <> rightIds, links)

Here's what the diagram output for our fileCopyProgram looks like:

>>> diagram fileCopyProgram
flowchart TD
Input --> 0[Parallel]
0[Parallel] --> 1[WriteLine]
1[WriteLine] --> 2[ReadLine]
0[Parallel] --> 3[WriteLine]
3[WriteLine] --> 4[ReadLine]
2[ReadLine] --> 5[CopyFile]
4[ReadLine] --> 5[CopyFile]
5[CopyFile] --> Output

And rendered:

Pretty cool eh?

Diagramming is just one thing you can do with our CommandTree, it's just data, you can fold over it to get all the effects, analyze which effects depend on which others, all sorts of things. This provides more clarity into what's happening than Selective's Over and Under newtypes.

This was a very simple example, but I promise you, with combinations of arr, (***) and first/second you can do any possible routing of values that you might like.

What you can't do yet, however, is to branch between possible execution paths, then run only one of them.

Let's add that.

Branching with ArrowChoice

Luckily for us, adding branching is pretty straight-forward. There's an aptly named ArrowChoice in base that we'll go ahead and implement.

ArrowChoice adds a new combinator:

(+++) :: ArrowChoice k => k a b -> k c d -> k (Either a c) (Either b d)

Similar to how (***) lets us represent two parallel and independent programs and fuse them into a single arrow which runs both, (+++) lets us introduce a conditional branch to our program, only one path will be executed based on whether the input value is a Left or a Right.

By implementing (+++) we also get the similar (|||) for free:

(|||) :: ArrowChoice k => k a c -> k b c -> k (Either a b) c

Let's add a Branch case to our CommandTree and implement ArrowChoice for our CommandRecorder.

data CommandTree eff
  = Effect eff
  | Identity
  | Composed (CommandTree eff {- >>> -}) (CommandTree eff)
  | Parallel
      (CommandTree eff) -- First
      (CommandTree eff) -- Second
  | Branch
      (CommandTree eff) -- Left
      (CommandTree eff) -- Right
  deriving (Show, Eq, Ord, Functor, Traversable, Foldable)

instance ArrowChoice (CommandRecorder eff) where
  (CommandRecorder cmds1) +++ (CommandRecorder cmds2) = CommandRecorder (Branch cmds1 cmds2)

No problem. As a reminder, here's the branching program we expressed using Selective Applicatives last time:

-- | A program using Selective effects
myProgram :: (ReadWriteDelete m) => m String
myProgram =
  let msgKind =
        Selective.matchS
          -- The list of values our program has explicit branches for.
          -- These are the values which will be used to crawl codepaths when
          -- analysing your program using `Over`.
          (Selective.cases ["friendly", "mean"])
          -- The action we run to get the input
          readLine
          -- What to do with each input
          ( \case
              "friendly" -> writeLine ("Hello! what is your name?") *> readLine
              "mean" ->
                let msg = unlines [ "Hey doofus, what do you want?"
                                  , "Too late. I deleted your hard-drive."
                                  , "How do you feel about that?"
                                  ]
                 in writeLine msg *> deleteMyHardDrive *> readLine
              -- This can't actually happen.
              _ -> error "impossible"
          )
      prompt = writeLine "Select your mood: friendly or mean"
      fallback =
        (writeLine "That was unexpected. You're an odd one aren't you?")
          <&> \() actualInput -> "Got unknown input: " <> actualInput
   in prompt
        *> Selective.branch
          msgKind
          fallback
          (pure id)

This example was always a bit forced just because of how limited Selective Applicatives are, but let's copy it over into our Arrow setup anyways.

First we'll implement ArrowChoice for our CommandRecorder.

-- Define our effects
class (Arrow k) => ReadWriteDelete k where
  readLine :: k () String

  writeLine :: k String ()

  deleteMyHardDrive :: k () ()

-- New commands for the new effects
data Command
  = ReadLine
  | WriteLine
  | DeleteMyHardDrive
  deriving (Show)

-- Track the effects
instance ReadWriteDelete CommandRecorder where
  readLine = CommandRecorder (Pure ReadLine)
  writeLine = CommandRecorder (Pure WriteLine)
  deleteMyHardDrive = CommandRecorder (Pure DeleteMyHardDrive)

-- Here's the runnable implementation
instance ReadWriteDelete (Kleisli IO) where
  readLine = Kleisli $ \() -> getLine
  writeLine = Kleisli $ \msg -> putStrLn msg
  deleteMyHardDrive = Kleisli $ \() -> putStrLn "Deleting hard drive... Just kidding!"

And here's our program which uses ArrowChoice:

branchingProgram :: (ReadWriteDelete k, ArrowChoice k) => k () ()
branchingProgram =
  pureC "Select your mood: friendly or mean"
    >>> writeLine
    >>> readLine
    >>> mapC
      ( \case
          "mean" -> Left ()
          "friendly" -> Right ()
          -- Just default to friendly
          _ -> Right ()
      )
    >>> let friendly =
              pureC "Hello! what is your name?"
                >>> writeLine
                >>> readLine
                >>> mapC (\name -> "Lovely to meet you, " <> name <> "!")
                >>> writeLine
            mean =
              pureC
                ( unlines
                    [ "Hey doofus, what do you want?",
                      "Too late. I deleted your hard-drive.",
                      "How do you feel about that?"
                    ]
                )
                >>> writeLine
                >>> deleteMyHardDrive
         in mean ||| friendly

Notice again, this version is actually more expressive than the Selective Applicative version, it actually greets the user by the name they provided, how kind.

I'll elide the edits to the mermaid renderer, Branch is very similar to the implementation of Parallel.

Let's make a mermaid chart like before:

>>> diagram branchingProgram
flowchart TD
Input --> 0[WriteLine]
0[WriteLine] --> 1[ReadLine]
1[ReadLine] --> 2[Branch]
2[Branch] --> 3[WriteLine]
3[WriteLine] --> 4[DeleteMyHardDrive]
2[Branch] --> 5[WriteLine]
5[WriteLine] --> 6[ReadLine]
6[ReadLine] --> 7[WriteLine]
4[DeleteMyHardDrive] --> Output
7[WriteLine] --> Output

See how it's now clear that the effects on one branch differ from another?

And of course we can run it just as you'd expect:

>>> run branchingProgram
Select your mood: friendly or mean
friendly
Hello! what is your name?
Joe
Lovely to meet you, Joe!

>>> run branchingProgram
Select your mood: friendly or mean
mean
Hey doofus, what do you want?
Too late. I deleted your hard-drive.
How do you feel about that?

Deleting hard drive... Just kidding!

Okay, so the syntax of that last example was starting to get pretty hairy, if only there was something like do-notation, but for arrows...

Arrow Notation

By enabling the {-# LANGUAGE Arrows #-} pragma we can use a form of do-notation with arrows. It will automatically route your inputs wherever you need them using combinators from the Arrow class and will even translate if and case statements into ArrowChoice combinators, it's very impressive.

I won't explain Arrow Notation deeply here, so go ahead and check out the GHC Manual for a more detailed look.

Here's what our branching program looks like when we translate it:

branchingProgramArrowNotation :: (ReadWriteDelete k, ArrowChoice k) => k () ()
branchingProgramArrowNotation = proc () -> do
  writeLine -< "Select your mood: friendly or mean"
  mood <- readLine -< ()
  case mood of
    "mean" -> mean -< ()
    "friendly" -> friendly -< ()
    _ -> friendly -< ()
  where
    friendly = proc () -> do
      writeLine -< "Hello! what is your name?"
      name <- readLine -< ()
      writeLine -< "Lovely to meet you, " <> name <> "!"

    mean = proc () -> do
      writeLine
        -<
          unlines
            [ "Hey doofus, what do you want?",
              "Too late. I deleted your hard-drive.",
              "How do you feel about that?"
            ]
      deleteMyHardDrive -< ()

It takes a bit of getting used to, but it's not so bad.

Here's the diagram, so we can get an idea of how it's being translated:

It's not quite as pretty, the translation introduces a lot of unnecessary calls to Parallel where it's just inserting Identity on the other side, this is perfectly valid, since the Category laws require that the Identity won't affect behaviour, but in our case it's messy and is clogging up our diagram, so let's clean it up.

The command tree we build as an intermediate step is just a value, so we can transform it to clean it up no problem.

If you derive Data and Plated for our Command and CommandTree types then we can do this with a simple transform on the tree. transform will rebuild the tree from the bottom up removing any redundant Identity nodes as it goes.

unredundify :: (Data eff) => CommandTree eff -> CommandTree eff
unredundify = transform \case
  Parallel Identity right -> right
  Parallel left Identity -> left
  Composed Identity right -> right
  Composed left Identity -> left
  other -> other

Diagramming the unredundified version looks much cleaner:

We can see here that the with multiple arms are getting collapsed into a sequence of binary branches, which is perfectly correct of course, but if you wanted to diagram it as a single branch you could rewrite the Branch constructor to have a list of options and collapse them all down with another rewrite rule. Same for Parallels of course. You can really do whatever is most useful for your use-case.

Arrow notation has its quirks, but it's still a substantial improvement over doing argument routing completely manually.

Static vs Dynamic data

It's worth a quick note on the difference between static and dynamic data with Arrows. With Applicatives, all the data needed to define an effect's behaviour was static, that is, it must be known at the time the program was constructed, though this might still be at runtime for the greater Haskell program.

With Arrows it's possible to interleave static and dynamic data, it's up to the author of the interface.

For example, if one were constructing a build-system they might have an interface like this:

class (Arrow k) => Builder k where
  dynamicReadFile :: k FilePath String
  staticReadFile :: FilePath -> k () String

dynamicReadFile takes its FilePath as a dynamic input, so we won't know which file we're going to read until execution time, however staticReadFile takes its FilePath as a static input. You pass it a single FilePath as a Haskell value when you construct the program. In this case we can embed the FilePath into the structure of the effect itself so that it's available during analysis.

While this is a bit more of an advanced use-case, it can be very useful. In the build-system case you could provide any statically known dependency files using staticReadFile and the build-system could check if those files have changed since the last run and safely replace some subtrees of the build with cached results if no dependencies in that subtree have changed.

This sort of thing takes careful thought and design, but provides a lot of flexibility which can unlock whole new programming techniques.

Folks may well have heard of Haxl, it's a Haskell library for analyzing programs and batching and caching requests to remote data sources. The implementation and interface for Haxl is moderately complex, and is limited in what it can do by the fact that it uses Monads. I'm curious how effective an Arrow-based version could be.

What's next?

We explored enough classes to enable most basic programs here. At this point you can branch, express independence between computations, and route input anywhere you need it. In case you're still hankering for a bit more expressive power we'll do a lightning quick tour of a few more classes.

There's ArrowLoop which encodes fixed-point style recursion.

class Arrow a => ArrowLoop a where
  loop :: a (b, d) (c, d) -> a b c

Interestingly, this is actually just another name for Costrong, as you can see by comparing with Costrong from the profunctors package.

If you really really need to be able to completely restructure your program on the fly you can do so using the ArrowApply class, which enables applying arbitrary runtime-created arrows.

class Arrow a => ArrowApply a where
    app :: a (a b c, b) c

This gives you the wildly expressive power to define entirely new code-paths at runtime. I'd still argue that reasonable programs that actually need to do this are pretty rare, but sometimes it's a useful shortcut to avoid some tedium. Note that if you use app, any effects within the dynamically applied arrow will be hidden from analysis, but you can still analyze the non-dynamic parts.

There are a few additional interesting classes which are strangely missing from base; but they have counterparts in profunctors. One example would be an arrow counterpart to Cochoice, which, if it existed, would look something like this:

class (Arrow k) => ArrowCochoice k where
  unright :: k (Either d a) (Either d b) -> k a b
  unleft :: k (Either a d) (Either b d) -> k a b

While the behaviour ultimately depends on the implementation, you can use this to implement things like recursive loops and while-loops, which avoids one of the more common needs for ArrowApply while preserving analysis over the contents of the loop.

There's some other good stuff in profunctors so I'd recommend just browsing around over there, (Thanks Ed). Traversing lets you apply a profunctor to elements of a Traversable container, Mapping does the same for Functors.

Anyways, you can see that most behaviours you take for granted when writing Haskell code with arbitrary functions in do-notation binds can generally be decomposed into some combination of Arrow typeclasses which accomplish the same thing. Using the principal of least-power is a good rule of thumb here. Generally you should use the lowest-power abstraction you can reasonably encode your program with, that will ensure you'll have the strongest potential for analysis.

In Summary

We've discovered that by switching from the Functor-Applicative-Monad effect system to a Category and Arrow hierarchy we can express significantly more complex and expressive programs while maintaining the ability to deeply introspect the programs we create.

We learned how we can collect additional typeclasses to gain more expressive power, and how we can implement custom instances to analyze and even diagram our programs.

Lastly we took a look at Arrow notation and how it improves the burden of syntax for writing these sorts of programs.

So, should we all abandon Monads and write everything using Arrows instead? Truthfully, I do believe they comprise a better foundation; so while the current Haskell ecosystem is all-in on Monads, if you the reader happen to be designing the effects system for a brand new functional programming language, why not give Arrows a try?

Hopefully you learned something 🤞! Did you know I'm currently writing a book? It's all about Lenses and Optics! It takes you all the way from beginner to optics-wizard and it's currently in early access! Consider supporting it, and more posts like this one by pledging on my Patreon page! It takes quite a bit of work to put these things together, if I managed to teach your something or even just entertain you for a minute or two maybe send a few bucks my way for a coffee? Cheers! �

October 16, 2025 12:00 AM

Arrows to Arrows, Categories to Queries

I’ve had a little time off of work as of late, and been spending it in characteristically unwise ways. In particular, I’ve written a little programming language that compiles to SQL. I call it catlang. That’s not to say that I’ve written a new query language. It’s a programming language, whose compiler spits out one giant SELECT statement. When you run that query in postgres, you get the output of your program.

Why have I done this? Because I needed a funny compilation target to test out the actual features of the language, which is that its intermediary language is a bunch of abstract category theory nonsense. Which I’ll get to. But I’m sure you first want to see this bad boy in action.

Behold, the function that returns 100 regardless of what input you give it. But it does it with the equivalent of a while loop:

count : Int -> Int
count =
  x ->
    loop x
      i ->
        n <- join id id -< i
        z <- abs . (-) -< (n, 100)
        case z of
          inl _ -> inr . (+) -< (n, 1)
          inr _ -> inl -< n

If you’re familiar with arrow notation, you’ll notice the above looks kinda like one big proc block. This is not a coincidence (because nothing is a coincidence). I figured if I were to go through all of this work, we might as well get a working arrow desugarer out of the mix. But I digress; that’s a story for another time.

Anyway, what’s going on here is we have an arrow count, which takes a single argument x. We then loop, starting from the value of x. Inside the loop, we now have a new variable i, which we do some voodoo on to compute n—the current value of the loop variable. Then we subtract 100 from n, and take the absolute value. The abs function here is a bit odd; it returns Left (abs x) if the input was negative, and Right x otherwise. Then we branch on the output of abs, where Left and Right have been renamed inl and inr respectively. If n - 100 was less than zero, we find ourselves in the inl case, where we add 1 to n and wrap the whole thing in inr—which the loop interprets as “loop again with this new value.” Otherwise, n - 100 was non-negative, and so we can return n directly.

Is it roundabout? You bet! The obtuseness here is not directly a feature, I was just looking for conceptually simple things I could do which would be easy to desugar into category-theoretical stuff. Which brings us to the intermediary language. After desugaring the source syntax for count above, we’re left with this IL representation:

  id △ id
⨟ cochoice
    ( undist
    ⨟   ( (prj₁ ⨟ id ▽ id) △ id
          ⨟   ( prj₁ △ 100
              ⨟ (-)
              ⨟ abs
              )
            △ id
          ⨟ prj₁ △ id
          ⨟ dist
          ⨟   ( (prj₂ ⨟ prj₂ ⨟ prj₁) △ 1
              ⨟ (+)
              ⨟ inr
              )
            ▽ ( prj₂
              ⨟ prj₂
              ⨟ prj₁
              ⨟ inl
              )
        )
      △ prj₂
    ⨟ dist
    )
⨟ prj₁

We’ll discuss all of this momentarily, but for now, just let your eyes glaze over the pretty unicode.

The underlying idea here is that each of these remaining symbols has very simple and specific algebraic semantics. For example, A ⨟ B means “do A and pipe the result into B.” By giving a transformation from this categorical IL into other domains, it becomes trivial to compile catlang to all sorts of weird compilation targets. Like SQL.

You’re probably wondering what the generated SQL looks like. Take a peek if you dare.

Ungodly Compiled SQL

SELECT
f0 AS f0
FROM
(SELECT
 f0 AS f0, f1 AS f1
 FROM
 (SELECT *
  FROM
  (WITH t0 AS
   (SELECT *
    FROM
    (WITH RECURSIVE recursion AS
     (SELECT
      clock_timestamp() as step
      , *
      FROM
      (WITH t1 AS
       (SELECT *
        FROM
        (SELECT
         f0 AS f0, f1 AS f1, NULL::integer AS f2, NULL::integer AS f3
         FROM
         (WITH t2 AS
          (SELECT * FROM (SELECT 0 as f0) AS _)
          SELECT *
          FROM
          (SELECT * FROM (SELECT f0 AS f0 FROM t2 AS _) AS _
           CROSS JOIN
           (SELECT f0 AS f1 FROM t2 AS _))
          AS _)
         AS _)
        AS _)
       SELECT *
       FROM
       (WITH t3 AS
        (SELECT *
         FROM
         (-- undist
          SELECT *
          FROM
          (SELECT
           f0 AS f0, NULL::integer AS f1, f1 AS f2
           FROM
           (-- undist1
            SELECT * FROM t1 AS _ WHERE "f0" IS NOT NULL)
           AS _)
          AS _
          UNION
          SELECT *
          FROM
          (SELECT
           NULL::integer AS f0, f2 AS f1, f3 AS f2
           FROM
           (-- dist2
            SELECT * FROM t1 AS _ WHERE "f2" IS NOT NULL)
           AS _)
          AS _)
         AS _)
        SELECT *
        FROM
        (WITH t4 AS
         (SELECT *
          FROM
          (SELECT *
           FROM
           (SELECT
            f0 AS f0, f1 AS f1
            FROM
            (WITH t5 AS
             (SELECT * FROM t3 AS _)
             SELECT *
             FROM
             (WITH t6 AS
              (SELECT *
               FROM
               (SELECT *
                FROM
                (SELECT
                 f0 AS f0
                 FROM
                 (WITH t7 AS
                  (SELECT * FROM (SELECT f0 AS f0, f1 AS f1 FROM t5 AS _) AS _)
                  SELECT *
                  FROM
                  (SELECT *
                   FROM
                   (SELECT
                    f0 AS f0
                    FROM
                    (-- join1
                     SELECT * FROM t7 AS _ WHERE "f0" IS NOT NULL)
                    AS _)
                   AS _
                   UNION
                   SELECT *
                   FROM
                   (SELECT
                    f1 AS f0
                    FROM
                    (-- join2
                     SELECT * FROM t7 AS _ WHERE "f1" IS NOT NULL)
                    AS _)
                   AS _)
                  AS _)
                 AS _)
                AS _
                CROSS JOIN
                (SELECT f0 AS f1, f1 AS f2, f2 AS f3 FROM t5 AS _))
               AS _)
              SELECT *
              FROM
              (WITH t8 AS
               (SELECT *
                FROM
                (SELECT *
                 FROM
                 (SELECT
                  f0 AS f0, f1 AS f1
                  FROM
                  (WITH t9 AS
                   (SELECT *
                    FROM
                    (SELECT
                     f0 - f1 AS f0
                     FROM
                     (WITH t10 AS
                      (SELECT * FROM t6 AS _)
                      SELECT *
                      FROM
                      (SELECT *
                       FROM
                       (SELECT f0 AS f0 FROM (SELECT f0 AS f0 FROM t10 AS _) AS _)
                       AS _
                       CROSS JOIN
                       (SELECT f0 AS f1 FROM (SELECT 100 as f0 FROM t10 AS _) AS _))
                      AS _)
                     AS _)
                    AS _)
                   SELECT *
                   FROM
                   (SELECT *
                    FROM
                    (SELECT
                     abs(f0) as f0, NULL::integer as f1
                     FROM
                     t9
                     AS _
                     WHERE
                     f0 < 0)
                    AS _
                    UNION
                    SELECT *
                    FROM
                    (SELECT NULL::integer as f0, f0 as f1 FROM t9 AS _ WHERE f0 >= 0)
                    AS _)
                   AS _)
                  AS _)
                 AS _
                 CROSS JOIN
                 (SELECT f0 AS f2, f1 AS f3, f2 AS f4, f3 AS f5 FROM t6 AS _))
                AS _)
               SELECT *
               FROM
               (WITH t11 AS
                (SELECT *
                 FROM
                 (SELECT *
                  FROM
                  (SELECT
                   f0 AS f0, f1 AS f1
                   FROM
                   (SELECT f0 AS f0, f1 AS f1 FROM t8 AS _)
                   AS _)
                  AS _
                  CROSS JOIN
                  (SELECT
                   f0 AS f2, f1 AS f3, f2 AS f4, f3 AS f5, f4 AS f6, f5 AS f7
                   FROM
                   t8
                   AS _))
                 AS _)
                SELECT *
                FROM
                (WITH t12 AS
                 (SELECT *
                  FROM
                  (-- dist
                   SELECT *
                   FROM
                   (SELECT
                    f0 AS f0, f2 AS f1, NULL::integer AS f10, NULL::integer AS f11, NULL::integer AS f12, NULL::integer AS f13, f3 AS f2, f4 AS f3, f5 AS f4, f6 AS f5, f7 AS f6, NULL::integer AS f7, NULL::integer AS f8, NULL::integer AS f9
                    FROM
                    (-- dist1
                     SELECT * FROM t11 AS _ WHERE "f0" IS NOT NULL)
                    AS _)
                   AS _
                   UNION
                   SELECT *
                   FROM
                   (SELECT
                    NULL::integer AS f0, NULL::integer AS f1, f4 AS f10, f5 AS f11, f6 AS f12, f7 AS f13, NULL::integer AS f2, NULL::integer AS f3, NULL::integer AS f4, NULL::integer AS f5, NULL::integer AS f6, f1 AS f7, f2 AS f8, f3 AS f9
                    FROM
                    (-- dist2
                     SELECT * FROM t11 AS _ WHERE "f1" IS NOT NULL)
                    AS _)
                   AS _)
                  AS _)
                 SELECT *
                 FROM
                 (SELECT *
                  FROM
                  (SELECT
                   NULL::integer AS f0, f0 AS f1
                   FROM
                   (SELECT
                    f0 + f1 AS f0
                    FROM
                    (WITH t13 AS
                     (SELECT *
                      FROM
                      (SELECT
                       f0 AS f0, f1 AS f1, f2 AS f2, f3 AS f3, f4 AS f4, f5 AS f5, f6 AS f6
                       FROM
                       (-- join1
                        SELECT * FROM t12 AS _
                        WHERE
                        ("f0" IS NOT NULL) AND ((("f1" IS NOT NULL) OR ("f2" IS NOT NULL)) AND (("f3" IS NOT NULL) AND ((("f4" IS NOT NULL) OR ("f5" IS NOT NULL)) AND ("f6" IS NOT NULL)))))
                       AS _)
                      AS _)
                     SELECT *
                     FROM
                     (SELECT *
                      FROM
                      (SELECT
                       f0 AS f0
                       FROM
                       (SELECT
                        f0 AS f0
                        FROM
                        (SELECT
                         f2 AS f0, f3 AS f1, f4 AS f2, f5 AS f3
                         FROM
                         (SELECT
                          f1 AS f0, f2 AS f1, f3 AS f2, f4 AS f3, f5 AS f4, f6 AS f5
                          FROM
                          t13
                          AS _)
                         AS _)
                        AS _)
                       AS _)
                      AS _
                      CROSS JOIN
                      (SELECT f0 AS f1 FROM (SELECT 1 as f0 FROM t13 AS _) AS _))
                     AS _)
                    AS _)
                   AS _)
                  AS _
                  UNION
                  SELECT *
                  FROM
                  (SELECT
                   f0 AS f0, NULL::integer AS f1
                   FROM
                   (SELECT
                    f0 AS f0
                    FROM
                    (SELECT
                     f2 AS f0, f3 AS f1, f4 AS f2, f5 AS f3
                     FROM
                     (SELECT
                      f1 AS f0, f2 AS f1, f3 AS f2, f4 AS f3, f5 AS f4, f6 AS f5
                      FROM
                      (SELECT
                       f7 AS f0, f8 AS f1, f9 AS f2, f10 AS f3, f11 AS f4, f12 AS f5, f13 AS f6
                       FROM
                       (-- join2
                        SELECT * FROM t12 AS _
                        WHERE
                        ("f7" IS NOT NULL) AND ((("f8" IS NOT NULL) OR ("f9" IS NOT NULL)) AND (("f10" IS NOT NULL) AND ((("f11" IS NOT NULL) OR ("f12" IS NOT NULL)) AND ("f13" IS NOT NULL)))))
                       AS _)
                      AS _)
                     AS _)
                    AS _)
                   AS _)
                  AS _)
                 AS _)
                AS _)
               AS _)
              AS _)
             AS _)
            AS _)
           AS _
           CROSS JOIN
           (SELECT f0 AS f2 FROM (SELECT f2 AS f0 FROM t3 AS _) AS _))
          AS _)
         SELECT *
         FROM
         (-- dist
          SELECT *
          FROM
          (SELECT
           f0 AS f0, f2 AS f1, NULL::integer AS f2, NULL::integer AS f3
           FROM
           (-- dist1
            SELECT * FROM t4 AS _ WHERE "f0" IS NOT NULL)
           AS _)
          AS _
          UNION
          SELECT *
          FROM
          (SELECT
           NULL::integer AS f0, NULL::integer AS f1, f1 AS f2, f2 AS f3
           FROM
           (-- dist2
            SELECT * FROM t4 AS _ WHERE "f1" IS NOT NULL)
           AS _)
          AS _)
         AS _)
        AS _)
       AS _)
      AS _
      UNION ALL
      SELECT
      clock_timestamp() as step
      , *
      FROM
      (SELECT *
       FROM
       (WITH t14 AS
        (SELECT * FROM recursion AS _)
        SELECT *
        FROM
        (WITH t15 AS
         (SELECT *
          FROM
          (-- undist
           SELECT *
           FROM
           (SELECT
            f0 AS f0, NULL::integer AS f1, f1 AS f2
            FROM
            (-- undist1
             SELECT * FROM t14 AS _ WHERE "f0" IS NOT NULL)
            AS _)
           AS _
           UNION
           SELECT *
           FROM
           (SELECT
            NULL::integer AS f0, f2 AS f1, f3 AS f2
            FROM
            (-- dist2
             SELECT * FROM t14 AS _ WHERE "f2" IS NOT NULL)
            AS _)
           AS _)
          AS _)
         SELECT *
         FROM
         (WITH t16 AS
          (SELECT *
           FROM
           (SELECT *
            FROM
            (SELECT
             f0 AS f0, f1 AS f1
             FROM
             (WITH t17 AS
              (SELECT * FROM t15 AS _)
              SELECT *
              FROM
              (WITH t18 AS
               (SELECT *
                FROM
                (SELECT *
                 FROM
                 (SELECT
                  f0 AS f0
                  FROM
                  (WITH t19 AS
                   (SELECT * FROM (SELECT f0 AS f0, f1 AS f1 FROM t17 AS _) AS _)
                   SELECT *
                   FROM
                   (SELECT *
                    FROM
                    (SELECT
                     f0 AS f0
                     FROM
                     (-- join1
                      SELECT * FROM t19 AS _ WHERE "f0" IS NOT NULL)
                     AS _)
                    AS _
                    UNION
                    SELECT *
                    FROM
                    (SELECT
                     f1 AS f0
                     FROM
                     (-- join2
                      SELECT * FROM t19 AS _ WHERE "f1" IS NOT NULL)
                     AS _)
                    AS _)
                   AS _)
                  AS _)
                 AS _
                 CROSS JOIN
                 (SELECT f0 AS f1, f1 AS f2, f2 AS f3 FROM t17 AS _))
                AS _)
               SELECT *
               FROM
               (WITH t20 AS
                (SELECT *
                 FROM
                 (SELECT *
                  FROM
                  (SELECT
                   f0 AS f0, f1 AS f1
                   FROM
                   (WITH t21 AS
                    (SELECT *
                     FROM
                     (SELECT
                      f0 - f1 AS f0
                      FROM
                      (WITH t22 AS
                       (SELECT * FROM t18 AS _)
                       SELECT *
                       FROM
                       (SELECT *
                        FROM
                        (SELECT f0 AS f0 FROM (SELECT f0 AS f0 FROM t22 AS _) AS _)
                        AS _
                        CROSS JOIN
                        (SELECT f0 AS f1 FROM (SELECT 100 as f0 FROM t22 AS _) AS _))
                       AS _)
                      AS _)
                     AS _)
                    SELECT *
                    FROM
                    (SELECT *
                     FROM
                     (SELECT
                      abs(f0) as f0, NULL::integer as f1
                      FROM
                      t21
                      AS _
                      WHERE
                      f0 < 0)
                     AS _
                     UNION
                     SELECT *
                     FROM
                     (SELECT NULL::integer as f0, f0 as f1 FROM t21 AS _ WHERE f0 >= 0)
                     AS _)
                    AS _)
                   AS _)
                  AS _
                  CROSS JOIN
                  (SELECT f0 AS f2, f1 AS f3, f2 AS f4, f3 AS f5 FROM t18 AS _))
                 AS _)
                SELECT *
                FROM
                (WITH t23 AS
                 (SELECT *
                  FROM
                  (SELECT *
                   FROM
                   (SELECT
                    f0 AS f0, f1 AS f1
                    FROM
                    (SELECT f0 AS f0, f1 AS f1 FROM t20 AS _)
                    AS _)
                   AS _
                   CROSS JOIN
                   (SELECT
                    f0 AS f2, f1 AS f3, f2 AS f4, f3 AS f5, f4 AS f6, f5 AS f7
                    FROM
                    t20
                    AS _))
                  AS _)
                 SELECT *
                 FROM
                 (WITH t24 AS
                  (SELECT *
                   FROM
                   (-- dist
                    SELECT *
                    FROM
                    (SELECT
                     f0 AS f0, f2 AS f1, NULL::integer AS f10, NULL::integer AS f11, NULL::integer AS f12, NULL::integer AS f13, f3 AS f2, f4 AS f3, f5 AS f4, f6 AS f5, f7 AS f6, NULL::integer AS f7, NULL::integer AS f8, NULL::integer AS f9
                     FROM
                     (-- dist1
                      SELECT * FROM t23 AS _ WHERE "f0" IS NOT NULL)
                     AS _)
                    AS _
                    UNION
                    SELECT *
                    FROM
                    (SELECT
                     NULL::integer AS f0, NULL::integer AS f1, f4 AS f10, f5 AS f11, f6 AS f12, f7 AS f13, NULL::integer AS f2, NULL::integer AS f3, NULL::integer AS f4, NULL::integer AS f5, NULL::integer AS f6, f1 AS f7, f2 AS f8, f3 AS f9
                     FROM
                     (-- dist2
                      SELECT * FROM t23 AS _ WHERE "f1" IS NOT NULL)
                     AS _)
                    AS _)
                   AS _)
                  SELECT *
                  FROM
                  (SELECT *
                   FROM
                   (SELECT
                    NULL::integer AS f0, f0 AS f1
                    FROM
                    (SELECT
                     f0 + f1 AS f0
                     FROM
                     (WITH t25 AS
                      (SELECT *
                       FROM
                       (SELECT
                        f0 AS f0, f1 AS f1, f2 AS f2, f3 AS f3, f4 AS f4, f5 AS f5, f6 AS f6
                        FROM
                        (-- join1
                         SELECT * FROM t24 AS _
                         WHERE
                         ("f0" IS NOT NULL) AND ((("f1" IS NOT NULL) OR ("f2" IS NOT NULL)) AND (("f3" IS NOT NULL) AND ((("f4" IS NOT NULL) OR ("f5" IS NOT NULL)) AND ("f6" IS NOT NULL)))))
                        AS _)
                       AS _)
                      SELECT *
                      FROM
                      (SELECT *
                       FROM
                       (SELECT
                        f0 AS f0
                        FROM
                        (SELECT
                         f0 AS f0
                         FROM
                         (SELECT
                          f2 AS f0, f3 AS f1, f4 AS f2, f5 AS f3
                          FROM
                          (SELECT
                           f1 AS f0, f2 AS f1, f3 AS f2, f4 AS f3, f5 AS f4, f6 AS f5
                           FROM
                           t25
                           AS _)
                          AS _)
                         AS _)
                        AS _)
                       AS _
                       CROSS JOIN
                       (SELECT f0 AS f1 FROM (SELECT 1 as f0 FROM t25 AS _) AS _))
                      AS _)
                     AS _)
                    AS _)
                   AS _
                   UNION
                   SELECT *
                   FROM
                   (SELECT
                    f0 AS f0, NULL::integer AS f1
                    FROM
                    (SELECT
                     f0 AS f0
                     FROM
                     (SELECT
                      f2 AS f0, f3 AS f1, f4 AS f2, f5 AS f3
                      FROM
                      (SELECT
                       f1 AS f0, f2 AS f1, f3 AS f2, f4 AS f3, f5 AS f4, f6 AS f5
                       FROM
                       (SELECT
                        f7 AS f0, f8 AS f1, f9 AS f2, f10 AS f3, f11 AS f4, f12 AS f5, f13 AS f6
                        FROM
                        (-- join2
                         SELECT * FROM t24 AS _
                         WHERE
                         ("f7" IS NOT NULL) AND ((("f8" IS NOT NULL) OR ("f9" IS NOT NULL)) AND (("f10" IS NOT NULL) AND ((("f11" IS NOT NULL) OR ("f12" IS NOT NULL)) AND ("f13" IS NOT NULL)))))
                        AS _)
                       AS _)
                      AS _)
                     AS _)
                    AS _)
                   AS _)
                  AS _)
                 AS _)
                AS _)
               AS _)
              AS _)
             AS _)
            AS _
            CROSS JOIN
            (SELECT f0 AS f2 FROM (SELECT f2 AS f0 FROM t15 AS _) AS _))
           AS _)
          SELECT *
          FROM
          (-- dist
           SELECT *
           FROM
           (SELECT
            f0 AS f0, f2 AS f1, NULL::integer AS f2, NULL::integer AS f3
            FROM
            (-- dist1
             SELECT * FROM t16 AS _ WHERE "f0" IS NOT NULL)
            AS _)
           AS _
           UNION
           SELECT *
           FROM
           (SELECT
            NULL::integer AS f0, NULL::integer AS f1, f1 AS f2, f2 AS f3
            FROM
            (-- dist2
             SELECT * FROM t16 AS _ WHERE "f1" IS NOT NULL)
            AS _)
           AS _)
          AS _)
         AS _)
        AS _)
       AS _
       WHERE
       ("f2" IS NOT NULL) AND ("f3" IS NOT NULL))
      AS _)
     SELECT * FROM recursion ORDER BY step DESC LIMIT 1)
    AS _)
   SELECT *
   FROM
   (WITH t26 AS
    (SELECT *
     FROM
     (-- undist
      SELECT *
      FROM
      (SELECT
       f0 AS f0, NULL::integer AS f1, f1 AS f2
       FROM
       (-- undist1
        SELECT * FROM t0 AS _ WHERE "f0" IS NOT NULL)
       AS _)
      AS _
      UNION
      SELECT *
      FROM
      (SELECT
       NULL::integer AS f0, f2 AS f1, f3 AS f2
       FROM
       (-- dist2
        SELECT * FROM t0 AS _ WHERE "f2" IS NOT NULL)
       AS _)
      AS _)
     AS _)
    SELECT *
    FROM
    (WITH t27 AS
     (SELECT *
      FROM
      (SELECT *
       FROM
       (SELECT
        f0 AS f0, f1 AS f1
        FROM
        (WITH t28 AS
         (SELECT * FROM t26 AS _)
         SELECT *
         FROM
         (WITH t29 AS
          (SELECT *
           FROM
           (SELECT *
            FROM
            (SELECT
             f0 AS f0
             FROM
             (WITH t30 AS
              (SELECT * FROM (SELECT f0 AS f0, f1 AS f1 FROM t28 AS _) AS _)
              SELECT *
              FROM
              (SELECT *
               FROM
               (SELECT
                f0 AS f0
                FROM
                (-- join1
                 SELECT * FROM t30 AS _ WHERE "f0" IS NOT NULL)
                AS _)
               AS _
               UNION
               SELECT *
               FROM
               (SELECT
                f1 AS f0
                FROM
                (-- join2
                 SELECT * FROM t30 AS _ WHERE "f1" IS NOT NULL)
                AS _)
               AS _)
              AS _)
             AS _)
            AS _
            CROSS JOIN
            (SELECT f0 AS f1, f1 AS f2, f2 AS f3 FROM t28 AS _))
           AS _)
          SELECT *
          FROM
          (WITH t31 AS
           (SELECT *
            FROM
            (SELECT *
             FROM
             (SELECT
              f0 AS f0, f1 AS f1
              FROM
              (WITH t32 AS
               (SELECT *
                FROM
                (SELECT
                 f0 - f1 AS f0
                 FROM
                 (WITH t33 AS
                  (SELECT * FROM t29 AS _)
                  SELECT *
                  FROM
                  (SELECT *
                   FROM
                   (SELECT f0 AS f0 FROM (SELECT f0 AS f0 FROM t33 AS _) AS _)
                   AS _
                   CROSS JOIN
                   (SELECT f0 AS f1 FROM (SELECT 100 as f0 FROM t33 AS _) AS _))
                  AS _)
                 AS _)
                AS _)
               SELECT *
               FROM
               (SELECT *
                FROM
                (SELECT
                 abs(f0) as f0, NULL::integer as f1
                 FROM
                 t32
                 AS _
                 WHERE
                 f0 < 0)
                AS _
                UNION
                SELECT *
                FROM
                (SELECT NULL::integer as f0, f0 as f1 FROM t32 AS _ WHERE f0 >= 0)
                AS _)
               AS _)
              AS _)
             AS _
             CROSS JOIN
             (SELECT f0 AS f2, f1 AS f3, f2 AS f4, f3 AS f5 FROM t29 AS _))
            AS _)
           SELECT *
           FROM
           (WITH t34 AS
            (SELECT *
             FROM
             (SELECT *
              FROM
              (SELECT
               f0 AS f0, f1 AS f1
               FROM
               (SELECT f0 AS f0, f1 AS f1 FROM t31 AS _)
               AS _)
              AS _
              CROSS JOIN
              (SELECT
               f0 AS f2, f1 AS f3, f2 AS f4, f3 AS f5, f4 AS f6, f5 AS f7
               FROM
               t31
               AS _))
             AS _)
            SELECT *
            FROM
            (WITH t35 AS
             (SELECT *
              FROM
              (-- dist
               SELECT *
               FROM
               (SELECT
                f0 AS f0, f2 AS f1, NULL::integer AS f10, NULL::integer AS f11, NULL::integer AS f12, NULL::integer AS f13, f3 AS f2, f4 AS f3, f5 AS f4, f6 AS f5, f7 AS f6, NULL::integer AS f7, NULL::integer AS f8, NULL::integer AS f9
                FROM
                (-- dist1
                 SELECT * FROM t34 AS _ WHERE "f0" IS NOT NULL)
                AS _)
               AS _
               UNION
               SELECT *
               FROM
               (SELECT
                NULL::integer AS f0, NULL::integer AS f1, f4 AS f10, f5 AS f11, f6 AS f12, f7 AS f13, NULL::integer AS f2, NULL::integer AS f3, NULL::integer AS f4, NULL::integer AS f5, NULL::integer AS f6, f1 AS f7, f2 AS f8, f3 AS f9
                FROM
                (-- dist2
                 SELECT * FROM t34 AS _ WHERE "f1" IS NOT NULL)
                AS _)
               AS _)
              AS _)
             SELECT *
             FROM
             (SELECT *
              FROM
              (SELECT
               NULL::integer AS f0, f0 AS f1
               FROM
               (SELECT
                f0 + f1 AS f0
                FROM
                (WITH t36 AS
                 (SELECT *
                  FROM
                  (SELECT
                   f0 AS f0, f1 AS f1, f2 AS f2, f3 AS f3, f4 AS f4, f5 AS f5, f6 AS f6
                   FROM
                   (-- join1
                    SELECT * FROM t35 AS _
                    WHERE
                    ("f0" IS NOT NULL) AND ((("f1" IS NOT NULL) OR ("f2" IS NOT NULL)) AND (("f3" IS NOT NULL) AND ((("f4" IS NOT NULL) OR ("f5" IS NOT NULL)) AND ("f6" IS NOT NULL)))))
                   AS _)
                  AS _)
                 SELECT *
                 FROM
                 (SELECT *
                  FROM
                  (SELECT
                   f0 AS f0
                   FROM
                   (SELECT
                    f0 AS f0
                    FROM
                    (SELECT
                     f2 AS f0, f3 AS f1, f4 AS f2, f5 AS f3
                     FROM
                     (SELECT
                      f1 AS f0, f2 AS f1, f3 AS f2, f4 AS f3, f5 AS f4, f6 AS f5
                      FROM
                      t36
                      AS _)
                     AS _)
                    AS _)
                   AS _)
                  AS _
                  CROSS JOIN
                  (SELECT f0 AS f1 FROM (SELECT 1 as f0 FROM t36 AS _) AS _))
                 AS _)
                AS _)
               AS _)
              AS _
              UNION
              SELECT *
              FROM
              (SELECT
               f0 AS f0, NULL::integer AS f1
               FROM
               (SELECT
                f0 AS f0
                FROM
                (SELECT
                 f2 AS f0, f3 AS f1, f4 AS f2, f5 AS f3
                 FROM
                 (SELECT
                  f1 AS f0, f2 AS f1, f3 AS f2, f4 AS f3, f5 AS f4, f6 AS f5
                  FROM
                  (SELECT
                   f7 AS f0, f8 AS f1, f9 AS f2, f10 AS f3, f11 AS f4, f12 AS f5, f13 AS f6
                   FROM
                   (-- join2
                    SELECT * FROM t35 AS _
                    WHERE
                    ("f7" IS NOT NULL) AND ((("f8" IS NOT NULL) OR ("f9" IS NOT NULL)) AND (("f10" IS NOT NULL) AND ((("f11" IS NOT NULL) OR ("f12" IS NOT NULL)) AND ("f13" IS NOT NULL)))))
                   AS _)
                  AS _)
                 AS _)
                AS _)
               AS _)
              AS _)
             AS _)
            AS _)
           AS _)
          AS _)
         AS _)
        AS _)
       AS _
       CROSS JOIN
       (SELECT f0 AS f2 FROM (SELECT f2 AS f0 FROM t26 AS _) AS _))
      AS _)
     SELECT *
     FROM
     (-- dist
      SELECT *
      FROM
      (SELECT
       f0 AS f0, f2 AS f1, NULL::integer AS f2, NULL::integer AS f3
       FROM
       (-- dist1
        SELECT * FROM t27 AS _ WHERE "f0" IS NOT NULL)
       AS _)
      AS _
      UNION
      SELECT *
      FROM
      (SELECT
       NULL::integer AS f0, NULL::integer AS f1, f1 AS f2, f2 AS f3
       FROM
       (-- dist2
        SELECT * FROM t27 AS _ WHERE "f1" IS NOT NULL)
       AS _)
      AS _)
     AS _)
    AS _)
   AS _)
  AS _
  WHERE
  ("f0" IS NOT NULL) AND ("f1" IS NOT NULL))
 AS _)
AS _;

It’s not pretty, rather amazingly, running the above query in postgres 17 will in fact return a single row with a single column whose value is 100. And you’d better believe it does it by actually looping its way up to 100. If you don’t believe me, make the following change:

-     SELECT * FROM recursion ORDER BY step DESC LIMIT 1)
+     SELECT * FROM recursion ORDER BY step DESC)

which will instead return a row for each step of the iteration.

There are some obvious optimizations I could make to the generated SQL, but it didn’t seem worth my time, since that’s not the interesting part of the project.

What the Hell Is Going On?

Let’s take some time to discuss the underlying category theory here. I am by no means an expert, but what I have learned after a decade of bashing my head against this stuff is that a little goes a long way.

For our intents and purposes, we have types, and arrows (functions) between types. We always have the identity “do nothing arrow” id:

id  :: a ~> a

and we can compose arrows by lining up one end to another:¹

(⨟) :: (a ~> b) -> (b ~> c) -> (a ~> c)

Unlike Haskell (or really any programming language, for that matter), we DO NOT have the notion of function application. That is, there is no arrow:

-- doesn't exist!
($) :: (a ~> b) -> a -> b

You can only compose arrows, you can’t apply them. That’s why we call these things “arrows” rather than “functions.”

There are a bundle of arrows for working with product types. The two projection functions correspond to fst and snd, taking individual components out of pairs:

prj₁ :: (a, b) ~> a
prj₂ :: (a, b) ~> b

How do we get things into pairs in the first place? We can use the “fork” operation, which takes two arrows computing b and c, and generates a new arrow which generates a pair of (b, c):

(△)  :: (a ~> b) -> (a ~> c) -> (a ~> (b, c))

If you’re coming from a Haskell background, it’s tempting to think of this operation merely as the (,) pair constructor. But you’ll notice from the type of the computation that there can be no data dependency between b and c, thus we are free to parallelize each side of the pair.

In category theory, the distinction between left and right sides of an arrow is rather arbitrary. This gives rise to a notion called duality where we can flip the arrows around, and get cool new behavior. If we dualize all of our product machinery, we get the coproduct machinery, where a coproduct of a and b is “either a or b, but definitely not both nor neither.”

Swapping the arrow direction of prj₁ and prj₂, and replacing (,) with Either gives us the following injections:

inl :: a ~> Either a b
inr :: b ~> Either a b

and the following “join” operation for eliminating coproducts:

(▽) :: (a ~> c) -> (b ~> c) -> (Either a b ~> c)

Again, coming from Haskell this is just the standard either function. It corresponds to a branch between one of two cases.

As you can see, with just these eight operations, we already have a tremendous amount of expressivity. We can express data dependencies via ⨟ and branching via ▽. With △ we automatically encode opportunities for parallelism, and gain the ability to build complicated data structures, with prj₁ and prj₂ allowing us to get the information back out of the data structures.

You’ll notice in the IL that there are no variable names anywhere to be found. The desugaring of the source language builds a stack (via the something to allocate △ id pattern), and replaces subsequent variable lookups with a series of projections on the stack to find the value again. On one hand, this makes the categorical IL rather hard to read, but it makes it very easy to re-target! Many domains do have a notion of grouping, but don’t have a native notion of naming.

For example, in an electronic circuit, I can have a ribbon of 32 wires which represents an Int32. If I have another ribbon of 32 wires, I can trivially route both wires into a 64-wire ribbon corresponding to a pair of (Int32, Int32).

By eliminating names before we get to the IL, it means no compiler backend ever needs to deal with names. They can just work on a stack representation, and are free to special-case optimize series of projections if they are able to.

Of particular interest to this discussion is how we desugar loops in catlang. The underlying primitive is cochoice:

cochoice :: (Either a c ~> Either b c) -> (a ~> b)

which magically turns an arrow on Eithers into an arrow without the eithers. We obviously must run that arrow on eithers. If that function returns inl, then we’re happy and we can just output that. But if the function returns inr, we have no choice but to pass it back in to the eithered arrow. In Haskell, cochoice is implemented as:

cochoiceHask :: (Either a c -> Either b c) -> a -> c
cochoiceHask f = go . Left
  where
    go :: Either a c -> b
    go eac =
      case f eac of
        Left b -> b
        Right c -> go (Right c)

which as you can see, will loop until f finally returns a Left. What’s neat about this formulation of a loop is that we can statically differentiate between our first and subsequent passes through the loop body. The first time through eac is Left, while for all other times it is Right. We don’t take advantage of it in the original count program, but how many times have you written loop code that needs to initialize something its first time through?

Compiling to SQL

So that’s the underlying theory behind the IL. How can we compile this to SQL now?

As alluded to before, we simply need to give SQL implementations for each of the operations in the intermediary language. As a simple example, id compiles to SELECT * FROM {}, where {} is the input of the arrow.

The hardest part here was working out a data representation. It seems obvious to encode each element of a product as a new column, but what do we do about coproducts? After much work thought, I decided to flatten out the coproducts. So, for example, the type:

(Int, Either Int Int)

would be represented as three columns:

( f1 INT NOT NULL
, f2 INT
, f3 INT
)

with the constraint that exactly one of f2 or f3 would be IS NOT NULL at any given point in time.

With this hammered out, almost everything else is pretty trivial. Composition corresponds to a nested query. Forks are CROSS JOINs which concatenate the columns of each sub-query. Joins are UNIONs, where we add a WHERE field IS NOT NULL clause to enforce we’re looking at the correct coproduct constructor.

Cochoice is the only really tricky thing, but it corresponds to a recursive CTE. Generating a recursive CTE table for the computation isn’t too hard, but getting the final value out of it was surprisingly tricky. The semantics of SQL tables is that they are multisets and come with an arbitrary greatest element. Which is to say, you need an column structured in a relevant way in order to query the final result. Due to some quirks in what postgres accepts, and in how I structured my queries, it was prohibitively hard to insert a “how many times have I looped” column and order by that. So instead I cheated and added a clock_timestamp() as step column which looks at the processor clock and ordered by that.

This is clearly a hack, and presumably will cause problems if I ever add some primitives which generate more than one row, but again, this is just for fun and who cares. Send me a pull request if you’re offended by my chicanery!

Stupid Directions To Go In the Future

I’ve run out of vacation time to work on this project, so I’m probably not going to get around to the meta-circular stupidity I was planning.

The compiler still needs a few string-crunching primitives (which are easy to add), but then it would be simple to write a little brainfuck interpreter in catlang. Which I could then compile to SQL. Now we’ve got a brainfuck interpreter running in postgres. Of course, this has been done by hand before, but to my knowledge, never via compilation.

There exist C to brainfuck compilers. And postgres is written in C. So in a move that would make Xzibit proud, we could run postgres in postgres. And of course, it would be fun to run brainfuck in brainfuck. That’d be a cool catlang backend if someone wanted to contribute such a thing.

Notes and Due Diligence and What Have You

I am not the first person to do anything like this. The source language of catlang is heavily inspired by Haskell’s arrow syntax, which in turn is essentially a desugaring algorithm for Arrows. Arrows are slightly the wrong abstraction because they require an operation arr :: (a -> b) -> (a ~> b)—which requires you to be able to embed Haskell functions in your category, something which is almost never possible.

Unfortunately, arrow syntax in Haskell desugars down to arr for almost everything it does, which in turn makes arrow notation effectively useless. In an ideal world, everything I described in this blog post would be a tiny little Haskell library, with arrow notation doing the heavy lifting. But that is just not the world we live in.

Nor am I the first person to notice that there are categorical semantics behind programming languages. I don’t actually know whom to cite on this one, but it is well-established folklore that the lambda calculus corresponds to cartesian-closed categories. The “closed” part of “cartesian-closed” means we have an operation eval :: (a ~> b, a) ~> b, but everyone and their dog has implemented the lambda calculus, so I thought it would be fun to see how far we can get without it. This is not a limitation on catlang’s turing completeness (since cochoice gives us everything we need.)

I’ve been thinking about writing a category-first programming language for the better part of a decade, ever since I read Compiling to Categories. That paper takes Haskell and desugars it back down to categories. I stole many of the tricks here from that paper.

Anyway. All of the code is available on github if you’re interested in taking a look. The repo isn’t up to my usual coding standards, for which you have my apologies. Of note is the template-haskell backend which can spit out Haskell code; meaning it wouldn’t be very hard to make a quasiquoter to compile catlang into what Haskell’s arrow desugaring ought to be. If there’s enough clamor for such a thing, I’ll see about turning this part into a library.

---

1. When looking at the types of arrows in this essay, we make the distinction that ~> are arrows that we can write in catlang, while -> exist in the metatheory.↩︎

October 14, 2025 02:31 PM