EXPLAIN EXTENDED

This year, I'll be implementing a Lisp interpreter in SQL.

Now, what's Lisp, and why would I want to do that? Well, let me tell you a little story about that.

Several decades ago, I got a New Year's present from my roommate's girlfriend. It was a book. She got it at a used bookstore in the UK. She wasn't sure what to get me, so she turned for advice to the store clerk. He asked her what kind of person I was, and she aptly described me as "a guy who loves math and mutters to himself". The clerk, without batting an eyelash, handed her a book with a yellow bird on its cover and told her I would like it.

He turned out to be right. I did like the book. It was written by Raymond M. Smullyan, and its title was "To Mock a Mockingbird".

By that time, I was already familiar with the author. I had read his books before. They were collections of logic puzzles, set in the now-popular Knights-and-Knaves world of his own invention. "To Mock a Mockingbird", at first glance, was the same. Its first two chapters were collections of logic puzzles as well. The puzzles weren't too easy, nor were they too hard. Each of them would make you flex your brain just the right amount. Back then, I used to commute a lot every day, and these puzzles turned out to be perfect time killers during long commutes. It took me something like two weeks to get through the first two chapters.

The third chapter, as is typical for the genre, started with a preface explaining the setup. Instead of knights and knaves, this chapter had a forest inhabited by magic birds. The birds are programmed to call out each other's names. When, say, a finch hears "parrot", it would (always) respond with "jay". When a parrot would hear "jay", it would say "crane", and so on, and so forth. All the birds have to say something when they hear another bird's name. This chain never stops.

The very first puzzle introduced a couple of conditions (which didn't look like much), and asked to prove some facts about the birds.

At first, I thought it would be the same old, same old. It wasn't. I couldn't solve it. Not in five minutes, not in an hour, not in a day.

I lost sleep for a week.

I had been reading a lot of math puzzle books, so I sort of knew there were math concepts behind the fantasy setup. It was obviously some kind of logic. I was pretty good with regular, first-order logic. It was easy. There's data: numbers and facts. There are functions, or formulas, which operate on the data. The two never mix. You can add two numbers together, or you can combine two theorems to prove a new one. But you can't "subtract" the Pythagorean theorem from the law of the excluded middle, or "multiply" Bézout's lemma by two; it doesn't make sense. You know exactly what's what.

With those damned birds, all the bets were off. If it's logic, are the birds data or functions in that logic? Remember the finch. It hears "parrot", it says "jay". It maps one to the other. When something maps things to things, it's a function, so "parrot" and "jay" must be data. Ok, parrots are data. But at the same time, the parrot maps "jay" to "crane", so the parrot is a function. So now the birds are functions? And the data? Should we put their name in quotes when they're data? Double quotes when they're a function again? It never stops. You think you've put your finger on it, and then it eludes you again.

It wasn't just that I couldn't find the solution; I didn't even know where to start looking. I spent (I believe) two months of my life pondering this problem. And then, in a surge of inspiration, I just saw the solution, clear as day. I still remember where I was at that moment.

The book had promised that the solution would be "extremely ingenious". It was. To this day, the fact that I found it without looking it up fills me with pride. I won't spoil it for you. I'll leave finding the book and going through the same experience as an exercise for the curious reader.

That exact feeling came back to me several times after that.

I had that feeling when I started learning programming and came across the concept of first-class functions. Store functions as if they were data? Call a variable as if it were a function? What a weird idea at first! And what a brilliant one, when you start thinking about it.

I had it again when I came across what turned out to be the theory behind the bird puzzles: the lambda calculus and its evil twin, the combinatory logic. It takes the idea of combining data and functions to the extreme: There's no data at all, only functions. There's no starting point, nor the stopping one; it's the functions all the way down. And yet, if you're clever enough, you can build arithmetic, algebra, and programming languages using only these functions that have no beginning and no end.

And then I had it again, almost as a déjà vu, when I first came across Lisp.

What is Lisp?

Lisp is a really old programming language (or, rather, a family of languages). It was invented by John McCarthy in 1958. Some would even say it was "discovered" rather than invented. It wasn't even supposed to be a programming language. It was a clever way to describe computations.

Back then, people would describe computer languages in terms of Turing machines. A Turing machine is a set of rules, telling the computer how to move from one state to another, depending on what's in memory and CPU registers. It's powerful, but really tedious. McCarthy didn't like it, so he invented a notation of his own, called S-expressions. A typical S-expression looks like this:

((defn factorial [n]
  (reduce * (range 1 (inc n)))) 5)

This expression is a set of nested lists, each list defined by a pair of parentheses: ( ). All dialects of Lisp look like someone dropped a bucket of parens. Lists and symbols within these lists can denote either data or computations on data. Computations serve to simplify, or shrink, the expressions. E.g. (+ 1 2) can be simplified to 3, and (reduce * (1 2 3 4 5)) could be simplified to 120. How exactly it's done is left up to the language designer. Thinking of language design in terms of "how do I go from (+ 1 2) to 3?" was supposed to be much easier than in terms of manipulating, saving, and restoring register states.

McCarthy wanted to prove that S-expressions were easier than Turing machines. To this end, he wrote an algorithm to "evaluate" every S-expression and simplify it to the bare minimum. Such an algorithm is called a "universal function". Of course, he described this algorithm in what he thought was the best way to describe any algorithm: using S-expressions. McCarthy called his algorithm "eval". As expected, it came out very neat and concise. This algorithm was only intended for publication. In McCarthy's own words:

Another way to show that LISP was neater than Turing machines was to write a universal LISP function and show that it is briefer and more comprehensible than the description of a universal Turing machine. This was the LISP function eval[e,a], which computes the value of a LISP expression e - the second argument a being a list of assignments of values to variables. (a is needed to make the recursion work). Writing eval required inventing a notation representing LISP functions as LISP data, and such a notation was devised for the purposes of the paper with no thought that it would be used to express LISP programs in practice.

To his surprise, one of his students, Steve Russell, offered to implement this "eval" algorithm, and promptly did it. Thus, the first Lisp "evaluator" was born. You could feed it Lisp expressions, and it would compute their values.

If you fed the evaluator something like (* 10 50), it would simplify it to 500. If you fed it (defun fac (n) (if (= n 1) 1 (* n (fac (- n 1))))), it would simplify it to a function that computes factorials. And if you fed the evaluator the expression for "eval", it would simplify it to a function capable of processing Lisp expressions — a working evaluator.

There is no beginning and no end to this endless chain. Lisp expressions turn into data, which turns into expressions, and so on, and so forth, with such ease and grace that few other languages can dream of. Just like Smullyan's birds from "To Mock the Mockingbird". Back in the day, it took me some time to notice the resemblance, but when I did, it hit me hard.

I was fascinated with Lisp ever since.

If you've been programming computers for an even remotely extended period of time, chances are you've heard this spiel already. Apparently, Lisp is supposed to make you a better programmer. Lisp can make you rich. It's supposed to be the best programming language ever designed.

You might be thinking that I'm one of those weird people who are trying to get others on the Lisp bandwagon.

You're right. I think every computer programmer should learn Lisp. In case I wasn't clear enough: If you haven't written a single Lisp program in your life, go and do it.

SQL implementation of Lisp

A quick reminder for the new readers. Every New Year's Eve, I publish an article where I do what I think is some cool stuff in SQL. I use SQL to draw ray-traced 3D pictures, play music, and implement working Large Language Models. I do this all in pure SQL, as a single query (usually in PostgreSQL), with no user-defined functions and no use of procedural languages.

This year will be no exception. I'm about to write a single SQL query that will take a Lisp expression (as a string parameter), evaluate it, and return the result of the evaluation, also as a string.

Lisp is a family of languages. To implement it in SQL, I will need to pick a dialect. There are many available, but I've picked a really cool a simple one, called Mal. Mal, which stands for "Make A Lisp", is a toy Lisp dialect, specifically designed as a learning tool for aspiring compiler hackers. It has a ton of implementations in other languages and comes with a manual that guides you through all the steps of implementing a Lisp interpreter.

Lisp programs consist of nested expressions, which lend themselves easily to evaluation in recursive functions. Pure SQL, however, doesn't have a concept of recursive functions (or any kind of functions, for that matter), so we don't have this luxury. We will need to implement our own "virtual machine" of sorts to be able to evaluate Lisp expressions.

Here's how it's gonna work.

SQL doesn't have recursive functions, but it does have recursive CTEs. They can be used to emulate a loop. Because loops are all that we have, we'll need to do something that John McCarthy loathed so much, and implement a Turing machine.

Each iteration of the recursive CTE will return exactly one row. This row will contain the whole state of the machine. It will keep the call stack, the heap, and the registers, each in a separate field.

On every invocation of the recursive part of the CTE, it will look at the state of the stack, heap, and the registers, and "manipulate" them according to some hardcoded rules. Queries don't have the concept of memory, so we cannot really "write" anything on the stack or heap. Every invocation will need to copy the full value of the stack and the heap, and apply the rules to make the changes. As is often the case with abusing SQL for the purposes of general programming, it's not going to be fast or efficient.

PostgreSQL has first-class support for JSON values, and a very rich set of functions and operators to manipulate them. It also has a native datatype for efficient storage of JSON data, called JSONB. We'll use it to store our virtual machine's data.

For the stack, we're going to use a single JSONB array, with nested arrays serving as stack frames. Regular programming languages, of course, use the stack as well. On a CPU, the stack is usually flat, and stack frames are separated with special instructions, if at all. Here, we can explicitly mark frame boundaries with JSONB arrays.

We will encode Lisp structures in JSONB. It's an almost one-to-one mapping. Lisp lists will become JSONB arrays; symbols, numbers, booleans, and nils will become JSONB strings, numbers, booleans, and nulls, respectively; all other datatypes will be stored as JSONB objects with the properties t and v (for "type" and "value", respectively).

The heap will be a flat JSONB array. Our implementation doesn't have garbage collection, so we never remove anything from the heap, only add.

Functions and macros will be stored by value and copied between the stack and the heap when accessed. It's a little bit wasteful, but easier to implement. Every function has a reference to the parent environment, a list of parameters (as a list of strings), and its body (the AST expression).

The rules for transforming the stack, the heap, and the registers will be defined according to the value of the last stack frame. Every stack frame is always an array. Its first value will define a special form, a function, or a built-in operator; the rest are the parameters and intermediate variables.

Functions on the stack frames can return values by appending them to the previous stack frame and removing themselves from the stack. This is not unlike how functions work on a regular CPU, except that we won't be doing repeated popping and pushing, and will do all the replacements in a single operation, in one fell swoop.

Stack frames won't have a clear distinction between parameters, variables, and values returned by functions down the stack. This is intended because it will allow some elegant optimizations.

Here's a brief outline of what the virtual machine would do:

As you can see, on each step, the query mechanically transforms the stack and other fields, according to some internal rules, which we will hardcode in SQL.

Print

Let's start writing our query by implementing print. It's a very simple operation: it should put its first argument to the field output, remove itself from the stack, and pass the value null as a result of its operation. (In Lisp, all expressions return some kind of result).

We'll write a simple CTE query that will look at the first value of the last stack frame, and treat it as an "opcode" to our virtual machine.

To do this, we will add some boilerplate code that will come in handy later:

1. We'll implement every opcode as a separate subquery, which we'll call in a LEFT JOIN LATERAL, and use the value of the opcode as a join condition.
2. Technically, each subquery only needs the value of the stack. However, there are some pieces of the stack that the opcode processors will need more often. This includes the value of the first item on the last stack frame (the opcode itself), and everything on the last stack frame except the opcode (it would be arguments/variables/return values from subsequent calls). It makes sense to expose them explicitly as fields, so the opcode queries down the line could access them more easily.
3. There are several ways we can manipulate the stack. For now, we can only return values and remove the current frame. This is what most functions do anyway. To make the implementation easier, we will expose the return value as a separate field from every opcode query that does return a value.
4. There will be some improvements to the boilerplate code further down the line

And here's our print processor:

WITH    RECURSIVE
        loop (stack, output, step) AS
        (
        SELECT  '[["print"], ["print"], ["print", {"t": "str", "v": "Hello world"}]]'::JSONB, NULL::TEXT, 0
        UNION ALL
        SELECT  new.new_stack, new.new_output, step + 1
        FROM    loop
        -- The subquery below exposes the value of the opcode and arguments for easier use
        CROSS JOIN LATERAL (SELECT stack #>> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]')) q_call (opcode, args)
        -- This query will only return something if the first value of the last frame on the stack equals to the string "print".
        -- We can say that it will process the opcode "print"
        LEFT JOIN LATERAL
                (
                SELECT  'null'::JSONB ret,
                        CASE WHEN args #>> '{0, t}' = 'str' THEN args #>> '{0, v}' ELSE args[0]::TEXT END new_output
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        -- For now, we only have one opcode processor, but in the future, there will be many.
        -- They are mutually exclusive (all the join conditions are different).
        -- If any of them returned anything, the COALESCE will take care of that.
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(print.ret),
                        COALESCE(print.new_output)
                ) rets (ret, new_output)
        -- If we have a return value, the expression below will append in to the previous stack frame,
        -- and remove the current one from the stack. This is how function returns work in most languages
        CROSS JOIN LATERAL
                (
                SELECT  JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE) AS new_stack,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  *
FROM    loop

Here's what the processor does on each step:

1. Call the subquery that's responsible for the current opcode (we only have one for now, print)
2. Look at the value in its ret field
3. Append this value to the previous stack frame
4. Remove the last stack frame from the stack

The result is the same as if we called (print(print(print("Hello world"))) in a regular programming language. The innermost print prints "Hello world", and the outermost ones print the results returned to them by the "prints" deeper down (that is, NULL values).

Eval

Now, we'll make a really simple expression evaluator. With some changes (that we'll make later), we can use it as a calculator that works in reverse Polish notation.

The algorithm is as follows:

The opcode for it will be called #eval. A hash symbol in front of the opcode means its arguments need to be sanitized and can't come directly from the user-provided input.

1. If the first argument is not a list, it's returned as is.
2. If the first argument is an empty list, and there are no further arguments, it's returned as is.
3. If the first argument is a non-empty list, its first member is put for further evaluation (passed into a new #eval down the stack), and removed from the list.
4. If the first argument is an empty list, and there are some further arguments, then it's a function call, and needs to be "applied" (that's Lisp-speak for executing a function). Put it on the stack as is, replacing the current frame.

Let's make a print-eval stack and run it up until the point where it would need to make the actual calculations (it can't do them yet):

WITH    RECURSIVE
        loop (stack, output, step) AS
        (
        SELECT  '[["print"], ["#eval", ["+", 1, 2]]]'::JSONB, NULL::TEXT, 0
        UNION ALL
        SELECT  new.new_stack, new.new_output, step + 1
        FROM    loop
        CROSS JOIN LATERAL (SELECT stack[-1], stack #>> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]')) q_call (current_frame, opcode, args)
        LEFT JOIN LATERAL
                (
                SELECT  'null'::JSONB ret,
                        CASE WHEN args #>> '{0, t}' = 'str' THEN args #>> '{0, v}' ELSE args[0]::TEXT END new_output
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL
                (
                -- Our first argument is not a list or an empty list with no follow-up. Return it as is
                SELECT  CASE WHEN calls IS NULL THEN eval_ast END AS ret,
                        calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]'), current_frame) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array') q_array (ast_is_array)
                CROSS JOIN LATERAL (SELECT CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END, JSONB_ARRAY_LENGTH(eval_ret) = 0) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                -- Our first argument is a non-empty list. Remove the first argument from that list and pass it to a new #eval.
                                -- [..., ["#eval", ["+", 1, 2]]] -> [..., ["#eval", [1, 2]], ["eval", "+"]]
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                -- Our first argument is an empty list, and we have something after it.
                                -- It means that whatever was there, has already been evaluated and needs to be applied.
                                -- We just take the evaluated list and put it on the stack as a new frame, replacing the current eval
                                -- [..., ["#eval", [], "+", 1, 2]] -> [..., ["+", 1, 2]]
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                END
                        ) q_calls (calls)
                ) eval ON (opcode = '#eval')
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(print.ret, eval.ret),
                        COALESCE(eval.calls) AS calls,
                        COALESCE(print.new_output)
                ) rets (ret, calls, new_output)
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)) AS new_stack,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  *
FROM    loop
WHERE   step <= 7

By that time, our evaluator has run up until the point where it's about to execute the addition operator on the arguments 1 and 2. We don't have code for it yet. Let's add it!

Addition

The plus sign will serve as an opcode. We'll need to add a hard-coded processor for it in SQL code. It's gonna be a one-liner.

There's a trick to that, however. The way we're organizing our code, putting each opcode into its own LEFT JOIN subquery, has a downside. PostgreSQL query planner works in such a way that all LEFT JOIN LATERAL queries are evaluated first, and only then is the join condition applied. All the join conditions don't depend on the results of the queries at all; it would make sense to evaluate them first, and then, if they come out to be false, not run the query at all. This is, unfortunately, not how PostgreSQL works.

This behavior has two implications for us.

First, it's a little bit of a waste of resources: all the queries get evaluated regardless of the value of the opcode, and their results are discarded.

Second, some SQL expressions, like casting non-numeric JSONB values to numbers, will fail at runtime if these values can't be safely cast. Since all opcode queries are always executed, the arguments to every stack frame will try to be cast to numbers, even if this stack frame has nothing to do with the numeric addition.

For this reason, we need to make sure all type casts and other potentially unsafe operations won't throw SQL-level exceptions. To this end, we need to wrap them in COALESCE or CASE expressions.

It's not ideal, but all the alternatives I could think of look even uglier, so this solution is the lesser evil.

The query below will evaluate an AST that comes from the expression (+ 1 2):

WITH    RECURSIVE
        loop (stack, output, step) AS
        (
        SELECT  '[["print"], ["#eval", ["+", 1, 2]]]'::JSONB, NULL::TEXT, 0
        UNION ALL
        SELECT  new.new_stack, new.new_output, step + 1
        FROM    loop
        CROSS JOIN LATERAL (SELECT stack[-1], stack #>> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]')) q_call (current_frame, opcode, args)
        LEFT JOIN LATERAL
                (
                SELECT  'null'::JSONB ret,
                        CASE WHEN args #>> '{0, t}' = 'str' THEN args #>> '{0, v}' ELSE args[0]::TEXT END new_output
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN calls IS NULL THEN eval_ast END AS ret, calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]'), current_frame) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array') q_array (ast_is_array)
                CROSS JOIN LATERAL (SELECT CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END, JSONB_ARRAY_LENGTH(eval_ret) = 0) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                END
                        ) q_calls (calls)
                ) eval ON (opcode = '#eval')

        -- This part is responsible for calculating addition

        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN JSONB_TYPEOF(args[0]) = 'number' AND JSONB_TYPEOF(args[1]) = 'number' THEN
                        TO_JSONB(args[0]::DOUBLE PRECISION + args[1]::DOUBLE PRECISION) END AS ret
                ) plus ON (opcode = '+')

        --

        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(print.ret, eval.ret, plus.ret),
                        COALESCE(eval.calls) AS calls,
                        COALESCE(print.new_output)
                ) rets (ret, calls, new_output)
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)) AS new_stack,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  *
FROM    loop

We just built an expression evaluator. For now, it can only do addition, but that's already something.

Let's try to feed it a more complex expression, like (+ (+ 1 2) 3):

WITH    RECURSIVE
        loop (stack, output, step) AS
        (
        SELECT  '[["print"], ["#eval", ["+", ["+", 1, 2], 3]]]'::JSONB, NULL::TEXT, 0
        UNION ALL
        SELECT  new.new_stack, new.new_output, step + 1
        FROM    loop
        CROSS JOIN LATERAL (SELECT stack[-1], stack #>> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]')) q_call (current_frame, opcode, args)
        LEFT JOIN LATERAL
                (
                SELECT  'null'::JSONB ret,
                        CASE WHEN args #>> '{0, t}' = 'str' THEN args #>> '{0, v}' ELSE args[0]::TEXT END new_output
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN calls IS NULL THEN eval_ast END AS ret, calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]'), current_frame) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array') q_array (ast_is_array)
                CROSS JOIN LATERAL (SELECT CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END, JSONB_ARRAY_LENGTH(eval_ret) = 0) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                END
                        ) q_calls (calls)
                ) eval ON (opcode = '#eval')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN JSONB_TYPEOF(args[0]) = 'number' AND JSONB_TYPEOF(args[1]) = 'number' THEN
                        TO_JSONB(args[0]::DOUBLE PRECISION + args[1]::DOUBLE PRECISION) END AS ret
                ) plus ON (opcode = '+')
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(print.ret, eval.ret, plus.ret),
                        COALESCE(eval.calls) AS calls,
                        COALESCE(print.new_output)
                ) rets (ret, calls, new_output)
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)) AS new_stack,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  *
FROM    loop

Not only can it do addition, but it can also nest addition expressions. Nice!

Variables and environments

Programming languages need to store data and reference it later. Lisp is no exception. Like most other languages, it has a concept of variables.

Lisp variables live in a special data structure called an "environment". It's a key-value map, which can store values keyed by (usually) a string. In addition, environments are nested; that is, every environment can have a parent environment.

When eval comes across a symbol it doesn't know about, it assumes it's a variable and tries to evaluate it by looking up its value. Every eval is accompanied by a reference to an environment. At first, eval tries to find the value in the key-value map of the current environment, using the symbol as a key. If it can't find it in the current environment, it looks it up in the parent of the current environment, then in the grandparent, and so on, until it reaches the topmost environment. If the value still can't be found, the virtual machine throws a runtime exception.

On JavaScript

As a side note, the notion of environments turned out to be extremely useful to help implement programming languages with lexical scope. Take JavaScript. It was heavily influenced by Lisp (to the point that some people even call it "Lisp in C's clothing").

In JavaScript, you can create a function within another function. The innermost function will be able to see and even change the variables declared in the outermost function. It works because the names and values of the variables live in a special hidden object called "scope" that is implicitly created when a function runs. The child function saves ("captures") to its definition when it's created, and uses it as a parent for its own scope when it's run. When JavaScript looks up a variable, it traverses the chain of scopes all the way up to the topmost scope until it finds the variable.

If you look closely, you can see that JavaScript scopes are Lisp environments in a very thin disguise.

Environments in SQL Mal

To support environments in the SQL implementation, we'll make some non-trivial additions to our query.

1. Introduce two more fields: heap and env.
   • heap will be a JSONB array. It will store data that needs to stay around for a long time, regardless of what's on the stack.
   • env will be an integer field. It will store the reference to the current environment. The environment itself will live in the heap, and its reference will be just the index to its position in the JSONB array.

   Our toy implementation of Mal doesn't use garbage collection, so we never delete anything from the heap.

2. Add a new opcode, #get-env. It will treat its first argument as a symbol, look it its value recursively in the current environment, and return it, if found.
3. To support the perfectly expected situation that a variable is not found in the environment, we'll add another opcode, #throw. For now, it will accept one argument, a string. When executed, this opcode will print the string and empty the stack, so that the program terminates right away. This will require some more boilerplate code.
4. Change the eval logic. When it comes across a symbol (that we encode as JSONB strings), and it's not a built-in function (like the addition operator +), it will put an instruction on the stack to look this symbol up.

Since eval (and, potentially, any opcode) now needs a reference to an existing environment, we'll need to add at least one environment to the heap on startup. We'll do it manually. An environment is just a two-element array: the reference to the parent, and the key-value map (a JSONB object).

We'll set the variable four to the value 4, and will try to evaluate the expression (+ four four):

WITH    RECURSIVE
        constants AS
        (
        -- These are the symbols that we won't be looking up during evaluation, they will always evaluate to themselves
        SELECT  ARRAY['+'] AS builtin_functions
        ),
        loop (heap, stack, env, output, step) AS
        (
        -- We add the variable four = 4 to the default environment
        SELECT  '[[null, {"four": 4}]]'::JSONB, '[["print"], ["#eval", ["+", "four", "four"]]]'::JSONB, 0, NULL::TEXT, 0
        UNION ALL
        SELECT  new.new_heap, new.new_stack, new.new_env, new.new_output, step + 1
        FROM    loop
        CROSS JOIN constants
        CROSS JOIN LATERAL (SELECT stack[-1], stack #>> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]')) q_call (current_frame, opcode, args)
        LEFT JOIN LATERAL
                (
                SELECT  'null'::JSONB ret,
                        CASE WHEN args #>> '{0, t}' = 'str' THEN args #>> '{0, v}' ELSE args[0]::TEXT END new_output
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN calls IS NULL THEN eval_ast END AS ret, calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]'), current_frame) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array', JSONB_TYPEOF(eval_ast) = 'string') q_array (ast_is_array, ast_is_symbol)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END,
                                JSONB_ARRAY_LENGTH(eval_ret) = 0
                        ) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL (SELECT COALESCE(eval_ast #>> '{}' = ANY(builtin_functions), FALSE)) q_callable (is_builtin_function)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                -- If we are evaluating a symbol that is not a built-in function, we need to look it up
                                WHEN ast_is_symbol AND NOT is_builtin_function THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#get-env', eval_ast))
                                END
                        ) q_calls (calls)
                ) eval ON (opcode = '#eval')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        CASE WHEN value IS NULL THEN FORMAT('Variable %s not found', key) END AS throws
                FROM    (SELECT args ->> 0) AS q_key (key)
                LEFT JOIN LATERAL
                        (
                        -- This is a nested recursive subquery (PostgreSQL supports those, which is extremely nice)
                        -- It follows the chain of environments and tries to look it the value of its first argument in each of them
                        WITH    RECURSIVE get (current_env) AS
                                (
                                SELECT  heap -> env
                                UNION ALL
                                SELECT  heap -> (current_env ->> 0)::INT
                                FROM    get
                                WHERE   current_env IS NOT NULL
                                )
                        SELECT  vals -> key
                        FROM    get
                        CROSS JOIN LATERAL (SELECT current_env -> 1) q (vals)
                        WHERE   vals ? key
                        LIMIT   1
                        ) AS env_value (value) ON TRUE
                ) get_env ON (opcode = '#get-env')

        -- This is the processor for the opcode "#throw". It rewrites the stack.

        LEFT JOIN LATERAL (SELECT args #>> '{0}' AS new_output, '[]'::JSONB AS new_stack) throw ON (opcode = 'throw')

        --

        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN JSONB_TYPEOF(args[0]) = 'number' AND JSONB_TYPEOF(args[1]) = 'number' THEN
                        TO_JSONB(args[0]::DOUBLE PRECISION + args[1]::DOUBLE PRECISION) END AS ret
                ) plus ON (opcode = '+')
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(heap),
                        COALESCE(env),
                        COALESCE(print.new_output, throw.new_output),
                        COALESCE(throw.new_stack),
                        COALESCE(print.ret, eval.ret, plus.ret, get_env.ret),
                        COALESCE(eval.calls) AS calls,
                        COALESCE(get_env.throws) AS throws
                ) rets (new_heap, new_env, new_output, new_stack, ret, calls, throws)
        CROSS JOIN LATERAL
                (
                SELECT  rets.new_heap,
                        COALESCE(
                                -- If an opcode decides to overwrite the stack, it trumps throws, returns, and calls
                                rets.new_stack,
                                -- We have a new field, throws, that can come from opcodes. It overrides returns and calls
                                CASE WHEN rets.throws IS NOT NULL THEN stack || JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('throw', rets.throws)) END,
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)) AS new_stack,
                        rets.new_env,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  *
FROM    loop

It came out just right.

What if we try to evaluate (+ five five)? Remember that the symbol five is undefined:

WITH    RECURSIVE
        constants AS
        (
        SELECT  ARRAY['+'] AS builtin_functions
        ),
        loop (heap, stack, env, output, step) AS
        (
        SELECT  '[[null, {"four": 4}]]'::JSONB, '[["print"], ["#eval", ["+", "five", "five"]]]'::JSONB, 0, NULL::TEXT, 0
        UNION ALL
        SELECT  new.new_heap, new.new_stack, new.new_env, new.new_output, step + 1
        FROM    loop
        CROSS JOIN constants
        CROSS JOIN LATERAL (SELECT stack[-1], stack #>> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]')) q_call (current_frame, opcode, args)
        LEFT JOIN LATERAL
                (
                SELECT  'null'::JSONB ret,
                        CASE WHEN args #>> '{0, t}' = 'str' THEN args #>> '{0, v}' ELSE args[0]::TEXT END new_output
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN calls IS NULL THEN eval_ast END AS ret, calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]'), current_frame) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array', JSONB_TYPEOF(eval_ast) = 'string') q_array (ast_is_array, ast_is_symbol)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END,
                                JSONB_ARRAY_LENGTH(eval_ret) = 0
                        ) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL (SELECT COALESCE(eval_ast #>> '{}' = ANY(builtin_functions), FALSE)) q_callable (is_builtin_function)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                -- If we are evaluating a symbol that is not a built-in function, we need to look it up
                                WHEN ast_is_symbol AND NOT is_builtin_function THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#get-env', eval_ast))
                                END
                        ) q_calls (calls)
                ) eval ON (opcode = '#eval')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        CASE WHEN value IS NULL THEN FORMAT('Variable %s not found', key) END AS throws
                FROM    (SELECT args ->> 0) AS q_key (key)
                LEFT JOIN LATERAL
                        (
                        -- This is a nested recursive subquery (PostgreSQL supports those, which is extremely nice)
                        -- It follows the chain of environments and tries to look it the value of its first argument in each of them
                        WITH    RECURSIVE get (current_env) AS
                                (
                                SELECT  heap -> env
                                UNION ALL
                                SELECT  heap -> (current_env ->> 0)::INT
                                FROM    get
                                WHERE   current_env IS NOT NULL
                                )
                        SELECT  vals -> key
                        FROM    get
                        CROSS JOIN LATERAL (SELECT current_env -> 1) q (vals)
                        WHERE   vals ? key
                        LIMIT   1
                        ) AS env_value (value) ON TRUE
                ) get_env ON (opcode = '#get-env')
        LEFT JOIN LATERAL (SELECT args #>> '{0}' AS new_output, '[]'::JSONB AS new_stack) throw ON (opcode = 'throw')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN JSONB_TYPEOF(args[0]) = 'number' AND JSONB_TYPEOF(args[1]) = 'number' THEN
                        TO_JSONB(args[0]::DOUBLE PRECISION + args[1]::DOUBLE PRECISION) END AS ret
                ) plus ON (opcode = '+')
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(heap),
                        COALESCE(env),
                        COALESCE(print.new_output, throw.new_output),
                        COALESCE(throw.new_stack),
                        COALESCE(print.ret, eval.ret, plus.ret, get_env.ret),
                        COALESCE(eval.calls) AS calls,
                        COALESCE(get_env.throws) AS throws
                ) rets (new_heap, new_env, new_output, new_stack, ret, calls, throws)
        CROSS JOIN LATERAL
                (
                SELECT  rets.new_heap,
                        COALESCE(
                                -- If an opcode decides to overwrite the stack, it trumps throws, returns, and calls
                                rets.new_stack,
                                -- We have a new field, throws, that can come from opcodes. It overrides returns and calls
                                CASE WHEN rets.throws IS NOT NULL THEN stack || JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('throw', rets.throws)) END,
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)) AS new_stack,
                        rets.new_env,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  *
FROM    loop

We have an exception, which is printed on the program output.

Special forms

In Lisp, expressions (pieces of data) that can be fed to eval without an error are called "forms".

By default, eval works by recursively evaluating all items in the forms, and then, if it's a list, calculate its value by "applying" the first element of the list (as a function) to the rest of them (as its arguments).

Such evaluations are powerful, but their power is limited. In particular, lazy evaluation of expressions (and, hence, recursion) is impossible in this setup: all arguments to every function need to be evaluated before they can be provided to the function.

To solve this problem, Lisps introduce the concept of "special forms".

Special forms are lists that start with a particular symbol, which can be thought of as a keyword. As the name suggests, they have special evaluation rules. In particular, members of special forms can be evaluated in a different order than they normally are, or not at all. This opens a whole new range of possibilities.

Here are the special forms that exist in Mal:

• (def! var value) — set the symbol var (unevaluated) to value (evaluated) in the current environment.

  Analog of var / let / const in JavaScript.

• (fn* (arg1 arg2 …) form) — Create a function, capture the current environment.

  Analog of function in JavaScript.

• (let (arg1 value1 arg2 value2 …) form)
  1. Create a new environment
  2. Evaluate value1, and set it to arg1 in the new environment
  3. Evaluate value2 (with arg1 already defined), and set it to arg2
  4. Repeat until the list is exhausted. Finally, evaluate form in the new environment

  Analog of defining variables within an anonymous block in JavaScript: { let b = 2; }

• (do form1 form2) — Evaluate all the forms in the list one by one, left to right, and return the value of the last evaluation.

  Analog of statements in JavaScript.

• (if cond form-yes form-no) — Evaluate cond. If it evaluates to a truthy value (anything other than false or nil), evaluate and return form-yes; else, evaluate and return form-no.

  Analog of if / else in JavaScript.

• (defmacro! var form) — Define a macro. Macro is a special type of function that generates AST (rather than a value) and then evaluates it.

  No direct analog in JavaScript.

• (quote ast) — Don't evaluate AST; return it as is.

  No direct analog in JavaScript.

• (quasiquote ast) — Don't evaluate AST; return it as is, unless marked.

  No direct analog in JavaScript.

• (unquote form) — Evaluate form, when inside a quasiquote. Normally, forms within quasiquote are not evaluated.

  (quasiquote a (unquote (+ 1 2)) b) will evaluate to (a 3 b)

• (splice-unquote form) — Evaluate form, when inside a quasiquote. If it returns a list, splice it into the AST.

  (quasiquote a (splice-unquote ((+ 1 2) (+ 2 3))) b) will evaluate to (a 3 5 b)

• (try* form (catch* exception-var handler)) — catch exceptions.

  Analog of the try/catch construct in JavaScript

Functions

Of all the special forms, fn*, the special form that creates functions, is of greatest interest, because, obviously, functions are what make the computers tick.

We will represent functions as JSONB objects of the following shape:

{"t": "fn*", "v": [env, [arg1, arg2, …], ast]}

, where:

• env is the environment (integer) which was active at the time the function was created
• [arg1, arg2, …] is a list of symbols that will be set to function arguments when the function gets applied (executed)
• ast is the code of the function

In our implementation, functions are value types rather than reference types, and they won't be put on the heap when created. It will mean, among other things, that two different functions that happen to be created in the same environment with the same list of parameters and the same AST will be treated as equal. I don't think it will be much of a problem.

The list of arguments and the function body are, in fact, already present on the AST in the same exact shape that they will be in the function value. So, to create a function, we just need to append them to the value of env, and wrap all this into an object.

As I said before, fn* is a special form. We'll need to add support for special forms to our eval code. That is, if we're evaluating a list and the first element in this list happens to be a special form symbol, we'll put this list on the stack as is and let the opcode processors handle it.

Of course, we'll need to add an opcode handler for fn*. This opcode comes straight from the AST, so we'll need to validate it: just make sure that the first argument is a list of symbols. Mal specification says that only two arguments matter for fn*, but it's not a problem if there are more: even if they end up on the stack, we'll just ignore them.

Let's try to create a function that doubles its argument. We'll do it by evaluating the expression (fn* (a) (+ a a))

WITH    RECURSIVE
        constants AS
        (
        SELECT  ARRAY['+'] AS builtin_functions,
                -- We're keeping a list of special forms here
                ARRAY['fn*'] AS special_forms,
                -- We'll be using it quite a lot, so we'll add a constant for it and save us several dozens of keystrokes.
                'null'::JSONB AS c_null
        ),
        loop (heap, stack, env, output, step) AS
        (
        SELECT  '[[null, {}]]'::JSONB, '[["print"], ["#eval", ["fn*", ["a"], ["+", "a", "a"]]]]'::JSONB, 0, NULL::TEXT, 0
        UNION ALL
        SELECT  new.new_heap, new.new_stack, new.new_env, new.new_output, step + 1
        FROM    loop
        CROSS JOIN constants
        CROSS JOIN LATERAL (SELECT stack[-1], stack #>> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]')) q_call (current_frame, opcode, args)
        LEFT JOIN LATERAL
                (
                SELECT  'null'::JSONB ret,
                        CASE WHEN args #>> '{0, t}' = 'str' THEN args #>> '{0, v}' ELSE args[0]::TEXT END new_output
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN calls IS NULL THEN eval_ast END AS ret, calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]'), current_frame) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array', JSONB_TYPEOF(eval_ast) = 'string') q_array (ast_is_array, ast_is_symbol)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END,
                                JSONB_ARRAY_LENGTH(eval_ret) = 0
                        ) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL
                        (
                        SELECT  COALESCE(eval_ast #>> '{0}' = ANY(special_forms), FALSE),
                                COALESCE(eval_ast #>> '{}' = ANY(builtin_functions), FALSE)
                        ) q_callable (is_special_form, is_builtin_function)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                -- This condition handles special forms. We just place the form on the stack as is. It should be handled first
                                WHEN ret_empty AND is_special_form THEN JSONB_BUILD_ARRAY(eval_ast)
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                WHEN ast_is_symbol AND NOT is_builtin_function THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#get-env', eval_ast))
                                END
                        ) q_calls (calls)
                ) eval ON (opcode = '#eval')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        CASE WHEN value IS NULL THEN FORMAT('Variable %s not found', key) END AS throws
                FROM    (SELECT args ->> 0) AS q_key (key)
                LEFT JOIN LATERAL
                        (
                        WITH    RECURSIVE get (current_env) AS
                                (
                                SELECT  heap -> env
                                UNION ALL
                                SELECT  heap -> (current_env ->> 0)::INT
                                FROM    get
                                WHERE   current_env IS NOT NULL
                                )
                        SELECT  vals -> key
                        FROM    get
                        CROSS JOIN LATERAL (SELECT current_env -> 1) q (vals)
                        WHERE   vals ? key
                        LIMIT   1
                        ) AS env_value (value) ON TRUE
                ) get_env ON (opcode = '#get-env')
        LEFT JOIN LATERAL (SELECT args #>> '{0}' AS new_output, '[]'::JSONB AS new_stack) throw ON (opcode = 'throw')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN JSONB_TYPEOF(args[0]) = 'number' AND JSONB_TYPEOF(args[1]) = 'number' THEN
                        TO_JSONB(args[0]::DOUBLE PRECISION + args[1]::DOUBLE PRECISION) END AS ret
                ) plus ON (opcode = '+')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_OBJECT('t', 'fn*', 'v', JSONB_BUILD_ARRAY(env, args[0], COALESCE(args[1], c_null))) ret,
                        CASE
                        WHEN JSONB_TYPEOF(args[0]) <> 'array' OR EXISTS (SELECT FROM JSONB_ARRAY_ELEMENTS(args[0]) arg WHERE JSONB_TYPEOF(arg) <> 'string') THEN
                                'The first argument to fn* should be a list of symbols'
                        END throws
                ) fn ON (opcode = 'fn*')
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(heap),
                        COALESCE(env),
                        COALESCE(print.new_output, throw.new_output),
                        COALESCE(throw.new_stack),
                        COALESCE(print.ret, eval.ret, plus.ret, get_env.ret, fn.ret),
                        COALESCE(eval.calls) AS calls,
                        COALESCE(get_env.throws, fn.throws) AS throws
                ) rets (new_heap, new_env, new_output, new_stack, ret, calls, throws)
        CROSS JOIN LATERAL
                (
                SELECT  rets.new_heap,
                        COALESCE(
                                rets.new_stack,
                                CASE WHEN rets.throws IS NOT NULL THEN stack || JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('throw', rets.throws)) END,
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)) AS new_stack,
                        rets.new_env,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  *
FROM    loop

We have successfully created a function value. Now we need a way to apply it.

Function application

To apply a function, we need to do some preparation first:

1. Create a new environment. To do that, we need to modify our heap, something that we haven't done yet. We'll add a new opcode, #add-heap, to handle this. Later, it will come in handy for other things. This opcode will return an integer, a reference to the position of the new environment (or any other value passed to #add-heap) in the heap array.
2. Set the newly created environment as active. We'll need to modify the value of the env field in our loop. That's also something we haven't done before. To do this, we'll create a new opcode, #push-env.
3. Populate the now-active environment with argument values. We have a list of argument names in the function definition object, and the list of their values on the call stack. We need to put these names and values into the environment map object.

   To do this, we'll create a new opcode #fill-args. In this opcode's processor, we'll need to zip an array of names with an array of values to create a key-value map object, and then merge this object with the environment.

   PostgreSQL supports object merging natively, but not array zipping. We'll have to code it up in SQL. Fortunately, it's not that hard.

4. Save the reference to the old environment on the stack. Once the function application is over, we will need to restore the old environment. This will be done by the new opcode #pop-env.
5. Finally, we just need to replace the current stack frame with an #eval, giving it the AST from the function definition as a parameter.

After all these preparations, the stack will look like this:

["#pop-env", <ENV>]
["#eval", <FN-AST>]
["#fill-args", <FN-ARGS>, <ARGS>]
["#push-env", <FN-ENV>]


Tail-call optimization

In many places of our code, when we need to emit a new opcode, we just replace the current stack frame with it, instead of pushing it on the stack. This is an optimization trick.

Let's imagine we're evaluating a form, and we have the values and the opcode ready. We could have coded our #eval the straightforward way: push the opcode on the stack, wait for it to return the value, then, when we have the value, return it to the caller.

This would require at least three "ticks" of our virtual machine. We would also need to add some kind of a marker for #eval to distinguish between the states when it needs to call the opcode, and when it needs to return the value. That's, as a matter of fact, what compilers for many languages actually do when generating machine code.

But why waste two ticks and stack space, if we know that the only thing we'll do is pass the value back? We could (and we did) just replace the #eval frame with the next opcode, and have it return the value straight to the caller.

This trick is called "tail-call optimization". If we're in a state where we're waiting for a result of an operation downstream with the sole intent to pass this result upstream, we can safely remove ourselves from this state. We just need to tell the guy downstream to talk directly to the guy upstream, and cut the middleman.

Normally, when you watch the execution stack of a language without tail-call optimization, it grows until the very end, and then decreases sharply, when the last operation in the chain needs to pass its result forty layers up the bucket line. All the callers are patiently sitting there, waiting for the result, taking up precious stack space, and wasting CPU cycles on stack unwinding.

In a language with tail-call optimization, the stack usually stays low. Once everything is done to prepare the work for the next guy, the caller knows that it's not needed anymore. It gives the floor to whoever is doing the real job, tells them where to deliver the result, and removes itself from the process. Just the way it works at a well-run company with good management.

It's very satisfactory to watch tail-call optimization done right. It's reassuring to see that control flow, through a series of well-orchestrated moves, reaches a measly service function ten levels of indirection deep, calls it, and has it return its result straight to His Majesty the End User. It conveys a very powerful message: "We've done all the preparatory work, and we're not babysitting anyone anymore. This guy is right for the job. Whatever he does is what you've asked of us." It gives off an air of confidence.

And, of course, it becomes a pain to debug when something inevitable doesn't go according to plan.

But I digress.

TCO in function calls

We did the TCO in #eval implementation, but we can't do it in function application, not without a bit of hackery.

The reason is the #pop-env opcode, which goes before #eval. #eval doesn't return its result straight to the caller. It needs to go through #pop-env first. #pop-env will forward the result to the caller anyway, but it will also restore the old environment.

If we have a lot of functions calling each other, even in a tail position, the stack will look like this:


["#pop-env", <ENV1>]
["#pop-env", <ENV2>]
["#pop-env", <ENV3>]
["#pop-env", <ENV4>]
["#pop-env", <ENV5>]
["#eval", <FN-AST>]
["#fill-args", <FN-ARGS>, <ARGS>]
["#push-env", <FN-ENV>]


The result will have to bubble up through all the #pop-env's, which is inefficient. In addition, if our call chain is deep enough, it can lead to a stack overflow.

Can we fix it?

The #pop-env's are doing exactly two things: restore the environment, and pass the result up the stack. We can see that once control flow reaches the uppermost #pop-env, the execution environment will get set <ENV1> regardless of its previous history.

It means that all the #pop-env's after the first one are, in essence, useless. The environments they restore will change again right on the next step. We might as well not even bother putting them there, except for the very first one.

That's exactly what we'll do in our implementation. When applying a function, we'll check if the previous frame on the call stack is a #pop-env. If it is, we won't put a new one there.

Let's try to apply the number-doubling function to an argument: ((fn* (a) (+ a a)) 5). This expression might be a little bit hard to parse if you're not used to Lisp notation, but it's very similar to IIFE (Immediately Invoked Function Expressions) in JavaScript. Basically, we're defining a function (something we did on the previous step), wrap it with parens, and provide it with an argument, so it's immediately applied right after definition.

Here's the SQL:

WITH    RECURSIVE
        constants AS
        (
        SELECT  ARRAY['+'] AS builtin_functions,
                ARRAY['fn*'] AS special_forms,
                'null'::JSONB AS c_null
        ),
        loop (heap, stack, env, output, step) AS
        (
        SELECT  '[[null, {}]]'::JSONB, '[["print"], ["#eval", [["fn*", ["a"], ["+", "a", "a"]], 5]]]'::JSONB, 0, NULL::TEXT, 0
        UNION ALL
        SELECT  new.new_heap, new.new_stack, new.new_env, new.new_output, step + 1
        FROM    loop
        CROSS JOIN constants
        CROSS JOIN LATERAL
                (
                SELECT  stack[-1], stack #> '{-1, 0}' AS callable, JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]'), stack #>> '{-2, 0}' = '#pop-env'
                ) q_args (current_frame, callable, args, can_tco)
        CROSS JOIN LATERAL
                (
                SELECT  CASE
                        WHEN JSONB_TYPEOF(callable) = 'string' THEN callable #>> '{}'
                        -- Function value is not a string, so we can't map it straight to the opcode. We'll need to make up one.
                        WHEN callable ->> 't' = 'fn*' THEN '#fn-apply'
                        END
                ) q_call (opcode)
        LEFT JOIN LATERAL
                (
                SELECT  'null'::JSONB ret,
                        CASE WHEN args #>> '{0, t}' = 'str' THEN args #>> '{0, v}' ELSE args[0]::TEXT END new_output
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN calls IS NULL THEN eval_ast END AS ret, calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]'), current_frame) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array', JSONB_TYPEOF(eval_ast) = 'string') q_array (ast_is_array, ast_is_symbol)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END,
                                JSONB_ARRAY_LENGTH(eval_ret) = 0
                        ) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL
                        (
                        SELECT  COALESCE(eval_ast #>> '{0}' = ANY(special_forms), FALSE),
                                COALESCE(eval_ast #>> '{}' = ANY(builtin_functions), FALSE)
                        ) q_callable (is_special_form, is_builtin_function)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                -- This condition handles special forms. We just place the form on the stack as is. It should be handled first
                                WHEN ret_empty AND is_special_form THEN JSONB_BUILD_ARRAY(eval_ast)
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                WHEN ast_is_symbol AND NOT is_builtin_function THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#get-env', eval_ast))
                                END
                        ) q_calls (calls)
                ) eval ON (opcode = '#eval')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        CASE WHEN value IS NULL THEN FORMAT('Variable %s not found', key) END AS throws
                FROM    (SELECT args ->> 0) AS q_key (key)
                LEFT JOIN LATERAL
                        (
                        WITH    RECURSIVE get (current_env) AS
                                (
                                SELECT  heap -> env
                                UNION ALL
                                SELECT  heap -> (current_env ->> 0)::INT
                                FROM    get
                                WHERE   current_env IS NOT NULL
                                )
                        SELECT  vals -> key
                        FROM    get
                        CROSS JOIN LATERAL (SELECT current_env -> 1) q (vals)
                        WHERE   vals ? key
                        LIMIT   1
                        ) AS env_value (value) ON TRUE
                ) get_env ON (opcode = '#get-env')
        LEFT JOIN LATERAL (SELECT args #>> '{0}' AS new_output, '[]'::JSONB AS new_stack) throw ON (opcode = 'throw')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN JSONB_TYPEOF(args[0]) = 'number' AND JSONB_TYPEOF(args[1]) = 'number' THEN
                        TO_JSONB(args[0]::DOUBLE PRECISION + args[1]::DOUBLE PRECISION) END AS ret
                ) plus ON (opcode = '+')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_OBJECT('t', 'fn*', 'v', JSONB_BUILD_ARRAY(env, args[0], COALESCE(args[1], c_null))) ret,
                        CASE
                        WHEN JSONB_TYPEOF(args[0]) <> 'array' OR EXISTS (SELECT FROM JSONB_ARRAY_ELEMENTS(args[0]) arg WHERE JSONB_TYPEOF(arg) <> 'string') THEN
                                'The first argument to fn* should be a list of symbols'
                        END throws
                ) fn ON (opcode = 'fn*')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN can_tco THEN next_frames ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', call_env), FALSE) END AS calls
                FROM    (SELECT CASE WHEN callable ->> 't' = 'fn*' THEN (callable #>> '{v, 0}') END::INT) AS q_call_args (call_env)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#eval', callable #> '{v, 2}'),
                                        JSONB_BUILD_ARRAY('#fill-args', callable #> '{v, 1}', args),
                                        JSONB_BUILD_ARRAY('#push-env', call_env)
                                )
                        ) AS q_next_frames (next_frames)
                ) fn_apply ON (callable ->> 't' = 'fn*')
        LEFT JOIN LATERAL (SELECT CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0)::INT END new_env, args['1'] ret) pop_env ON (opcode = '#pop-env')
        LEFT JOIN LATERAL
                (
                SELECT  new_env,
                        CASE
                        WHEN new_env IS NULL THEN
                                JSONB_BUILD_ARRAY(
                                        current_frame,
                                        JSONB_BUILD_ARRAY('#add-heap', JSONB_BUILD_ARRAY(old_env, JSONB_BUILD_OBJECT()))
                                )
                        END AS calls
                FROM    (SELECT CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0)::INT END, CASE WHEN JSONB_TYPEOF(args['1']) = 'number' THEN (args ->> 1)::INT END) q_args (old_env, new_env)
                ) push_env ON (opcode = '#push-env')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_SET(heap, ARRAY[env::TEXT, 1::TEXT], env_data || new_data) AS new_heap
                FROM    (
                        SELECT  CASE WHEN opcode = '#fill-args' AND JSONB_TYPEOF(args['0']) = 'array' THEN args[0] END,
                                CASE WHEN opcode = '#fill-args' AND JSONB_TYPEOF(args['1'])  = 'array' THEN args[1] END
                        ) q_args (keys, values)
                CROSS JOIN LATERAL (SELECT heap[env::TEXT]['1']) q_env_data (env_data)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_OBJECT_AGG(key #>> '{}', COALESCE(value, c_null) ORDER BY index)
                        FROM    JSONB_ARRAY_ELEMENTS(keys) WITH ORDINALITY q_keys (key, index)
                        LEFT JOIN
                                JSONB_ARRAY_ELEMENTS(values) WITH ORDINALITY q_values (value, index)
                        USING   (index)
                        ) q_new_data (new_data)
                ) fill_args ON (opcode = '#fill-args')
        LEFT JOIN LATERAL
                (
                SELECT  new_heap, TO_JSONB(JSONB_ARRAY_LENGTH(new_heap) - 1) ret
                FROM    (SELECT JSONB_INSERT(heap, '{-1}', args[0], TRUE)) AS q_heap (new_heap)
                ) add_heap ON (opcode = '#add-heap')
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(fill_args.new_heap, add_heap.new_heap, heap),
                        COALESCE(pop_env.new_env, push_env.new_env, env),
                        COALESCE(print.new_output, throw.new_output),
                        COALESCE(throw.new_stack),
                        COALESCE(print.ret, eval.ret, plus.ret, get_env.ret, fn.ret, pop_env.ret, add_heap.ret),
                        COALESCE(eval.calls, fn_apply.calls, push_env.calls) AS calls,
                        COALESCE(get_env.throws, fn.throws) AS throws
                ) rets (new_heap, new_env, new_output, new_stack, ret, calls, throws)
        CROSS JOIN LATERAL
                (
                SELECT  rets.new_heap,
                        COALESCE(
                                rets.new_stack,
                                CASE WHEN rets.throws IS NOT NULL THEN stack || JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('throw', rets.throws)) END,
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)) AS new_stack,
                        rets.new_env,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  *
FROM    loop

It starts to feel like a real language now!

Try/catch

In the implementation we've made so far, all exceptions are show-stoppers. Let's make a way to handle them.

In Mal, there's a special form for that, which has the following shape: (try* <FORM> (catch* <EXCEPTION-VAR> <HANDLER-FORM>)). It evaluates <FORM>. If it results in an exception, <EXCEPTION-VAR> gets set to the value of that exception in a new environment, and <HANDLER-FORM> is evaluated.

To add support for handling exceptions, we'll do the following:

1. Before evaluating forms that come from a try* block, put the instruction #catch on the stack with four preset parameters:
   1. The constant false
   2. The environment active at the moment try* was called
   3. The name of the variable that will hold the exception value
   4. The AST of the catch* block
2. Change the handler of the opcode throw:
   1. Go up the stack and find the closest #catch instruction.
   2. If it's there, change its first parameter to true and put the value of the exception as its last (fifth) parameter.
   3. If it's not there, invoke the default handler: wipe the stack completely and call the opcode print with the value of the exception.
3. Add a handler for the opcode #catch. This handler will look at the first parameter and, based on its value, decide what to do next:
   1. If the parameter is false, just return the last (fifth) argument. This argument will be the result of evaluating the form in the try* block if there was no exception.
   2. If the parameter is true, create a new environment, set the value of the exception variable to the exception's value (which has been put on the stack by this moment), and evaluate the handler. This is done in a way similar to how fn* and let* handlers work.

You'll be able to see the implementation of try*/catch* in the next chapter.

Other special forms

For the sake of brevity, I won't dive into the implementation details of other special forms. By this moment, it's pretty straightforward.

One little thing I find interesting: to implement do, I found it handy to implement an additional opcode, #nop. As the name suggests, it just swallows the result and passes control up the stack. It doesn't return anything, doesn't call new opcodes, doesn't change the heap or the current environment, and doesn't throw exceptions.

With all the boilerplate code we've written so far, here's what the implementation of this opcode looks like in all its glory:

LEFT JOIN LATERAL (SELECT) nop ON (opcode = '#nop')

It doesn't really do anything, and we could just as well remove it. But I decided to leave it in. I think it's pretty neat and conveys the intent really clearly.

Parser

So far, I've been manually converting S-expressions into our JSONB representation and putting them on the stack. It's time we automated this. To this end, we'll need to implement a reader and a parser.

The creators of Mal have provided a regular expression that parses a string and returns Mal tokens. We'll wrap these tokens into an object called "reader". It will be a stateful opaque object that will live on the heap: basically, an array of string representations of tokens, and a pointer to the position in this array. This reader will be created by the opcode #tokenize. It will use #add-heap to put the reader on the heap, and then wrap its reference into a reader object that can be safely used on the stack.

The parser will read the stream of (string) tokens and create the AST out of them.

The opcode responsible for that will be called #read-form. It will be a "stateful" opcode, which means that it will call itself in a loop and change the values of its arguments. If the first argument to #read-form is an opening token of some sort (paren, regular bracket, or curly bracket), then it will keep accruing tokens and forms (read recursively) until it encounters a closing token. Otherwise, it will return the token as is.

The opcode responsible for converting a string representation of a token into JSONB representation is called #next-reader. It does a double job: converts the tokens and manages the state of the reader.

To mark the end of the token stream, we'll introduce a new value, the EOF. It will be represented by the JSONB object {"t": "eof"}

Because #read-form is stateful, we need its user-callable counterpart, read-form. It serves a double purpose. First, it sanitizes the arguments that it passes to #read-form. Second, #read-form (with the hash), unless it's in a list/vector/map evaluation state, passes closing tokens down the line as is. If we have an unbalanced closing paren (that is, one closing paren too many), read-form is the only one able to catch it.

Let's try to evaluate the expression (+ 1 (+ 2 3)). Note that this time, we're putting it on the stack as a string, and not as a manually-parsed AST as we did before. Because of that, we're not using the opcode #eval directly, but rather its user-facing version eval. Otherwise, we won't be able to catch errors like unbalanced closing brackets.

That's how it works:

WITH    RECURSIVE
        constants AS
        (
        SELECT  ARRAY[
                'tokenize', 'print', 'to-json', 'read-input', 'read-form', 'throw', 'eval', 'list', 'cons', 'concat', 'pr-str',
                '+', '-', '*', '/', '='] AS builtin_functions,
                ARRAY['fn*', 'def!', 'let*', 'if', 'do', 'quote', 'quasiquote', 'defmacro!'] AS special_forms,
                ARRAY['(', ')', '[', ']', '{', '}', '''', '`', '~', '~@'] AS symbols,
                TO_JSONB('('::TEXT) AS c_open_paren, TO_JSONB(')'::TEXT) AS c_closed_paren,
                TO_JSONB('['::TEXT) AS c_open_bracket, TO_JSONB(']'::TEXT) AS c_closed_bracket,
                TO_JSONB('{'::TEXT) AS c_open_curly, TO_JSONB('}'::TEXT) AS c_closed_curly,
                TO_JSONB('unquote'::TEXT) AS c_unquote, TO_JSONB('splice-unquote'::TEXT) AS c_splice_unquote,
                'null'::JSONB AS c_null, '{"t": "eof"}'::JSONB AS c_eof,
                '{"''": "quote", "`": "quasiquote", "~": "unquote", "~@": "splice-unquote"}'::JSONB AS c_reader_macros
        ),
        loop (heap, stack, env, output, step) AS
        (
        SELECT  '[[null, {"eof": {"t": "eof"}}]]'::JSONB,
                '[["print"], ["eval"], ["read-form"], ["tokenize", {"t": "str", "v": "(+ 1 (+ 2 3))"}]]'::JSONB,
                0, NULL::TEXT, 1
        FROM    constants
        UNION ALL
        SELECT  new.*, step + 1
        FROM    loop
        CROSS JOIN constants
        CROSS JOIN LATERAL (SELECT stack #> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]'), stack['-1'], stack #>> '{-2, 0}' = '#pop-env') q_call (callable, args, current_frame, can_tco)
        CROSS JOIN LATERAL
                (
                SELECT  CASE
                        WHEN JSONB_TYPEOF(callable) = 'string' THEN callable #>> '{}'
                        WHEN callable ->> 't' = 'fn*' THEN '#fn-apply'
                        WHEN callable ->> 't' = 'macro' THEN '#macro-apply'
                        END
                ) q_opcode (opcode)
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#tokenize', args[0])) AS calls,
                        CASE WHEN (args #>> '{0, t}' = 'str') IS DISTINCT FROM TRUE THEN 'Usage: (tokenize string)' END AS throws
                ) tokenize ON (opcode = 'tokenize')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN args[1] IS NOT NULL THEN JSONB_BUILD_OBJECT('t', 'reader', 'v', args[1]) END AS ret,
                        CASE WHEN args[1] IS NULL THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#add-heap', JSONB_BUILD_ARRAY(0, tokens))) END AS calls
                FROM    (
                        SELECT  COALESCE(JSONB_AGG(TO_JSONB(token) ORDER BY index), '[]'::JSONB)
                        FROM    REGEXP_MATCHES(args #>> '{0, v}', '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}(''"`~^,;)]*)', 'gm') WITH ORDINALITY AS q (match, index)
                        CROSS JOIN LATERAL (SELECT match[1]) q_token (token)
                        WHERE   token > '' AND NOT token ^@ ';'
                        ) q_tokens (tokens)
                ) tokenize2 ON (opcode = '#tokenize')
        LEFT JOIN LATERAL (SELECT NULL::JSONB AS ret) read_input ON (opcode = 'read-input')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN is_string THEN c_null END AS ret,
                        CASE WHEN is_string THEN args #>> '{0, v}' END new_output,
                        CASE WHEN NOT is_string THEN JSONB_BUILD_ARRAY(JSON_BUILD_ARRAY(opcode), JSONB_BUILD_ARRAY('pr-str', COALESCE(args[0], c_null))) END AS calls
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL (SELECT TO_JSONB(args['0']::TEXT) AS ret) _to_json ON (opcode = 'to-json')
        LEFT JOIN LATERAL
                (
                SELECT  *,
                        CASE
                        WHEN type = 'array' AND JSONB_ARRAY_LENGTH(value) > 0 THEN NULL
                        ELSE JSONB_BUILD_OBJECT('t', 'str', 'v', TO_JSONB(
                                CASE
                                WHEN type IN ('number', 'boolean') THEN value::TEXT
                                WHEN type = 'string' THEN value #>> '{}'
                                WHEN type = 'null' THEN 'nil'
                                WHEN complex_type = 'str' THEN (value -> 'v')::TEXT
                                WHEN type = 'array' AND JSONB_ARRAY_LENGTH(value) = 0 THEN
                                (
                                SELECT  '(' || COALESCE(STRING_AGG(element #>> '{v}', ' ' ORDER BY index), '') || ')'
                                FROM    JSONB_ARRAY_ELEMENTS(rest) WITH ORDINALITY q (element, index)
                                )
                                WHEN complex_type IS NOT NULL THEN FORMAT('#<%s>', complex_type)
                                ELSE 'Unprintable value'
                                END))
                        END
                        AS ret,
                        CASE WHEN type = 'array' AND JSONB_ARRAY_LENGTH(value) > 0 THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('pr-str', value['0'])) END AS calls
                FROM    (SELECT args[0], JSONB_TYPEOF(args[0]), args[0] ->> 't', JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]')) q (value, type, complex_type, rest)
                ) pr_str ON (opcode = 'pr-str')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN catch_index IS NOT NULL THEN
                                JSONB_PATH_QUERY_ARRAY(stack, '$[0 to $index - 1]', JSONB_BUILD_OBJECT('index', catch_index)) ||
                                JSONB_BUILD_ARRAY(JSONB_SET(stack[catch_index], '{1}', 'true'::JSONB) || COALESCE(args[0], c_null))
                        ELSE JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('print', args[0]))
                        END
                        AS new_stack
                FROM    (SELECT) q
                LEFT JOIN LATERAL
                        (
                        SELECT  index::INT - 1
                        FROM    JSONB_ARRAY_ELEMENTS(stack) WITH ORDINALITY q_frames (frame, index)
                        WHERE   (frame ->> 0) = '#catch*'
                        ORDER BY
                                index DESC
                        LIMIT 1
                        ) q_catch_index (catch_index) ON TRUE
                ) throw ON (opcode = 'throw')
        LEFT JOIN LATERAL
                (
                SELECT  new_heap, TO_JSONB(JSONB_ARRAY_LENGTH(new_heap) - 1) ret
                FROM    (SELECT JSONB_INSERT(heap, '{-1}', args[0], TRUE)) AS q_heap (new_heap)
                ) add_heap ON (opcode = '#add-heap')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN value IS NULL THEN c_eof
                        WHEN value = 'nil' THEN c_null
                        WHEN value ~ '^[-+]?\d+' OR value IN ('true', 'false') THEN value::JSONB
                        WHEN value ^@ '"' THEN JSONB_BUILD_OBJECT('t', 'str', 'v', value::JSONB)
                        ELSE TO_JSONB(value)
                        END AS ret,
                        CASE WHEN value IS NOT NULL THEN JSONB_SET(heap, ARRAY[reader_ptr, '0'], TO_JSONB(position + 1)) END AS new_heap
                FROM    (SELECT args['0']) AS q_reader_ref (reader_ref)
                CROSS JOIN LATERAL (SELECT reader_ref ->> 'v') AS q_reader_ptr (reader_ptr)
                CROSS JOIN LATERAL (SELECT heap[reader_ptr]) q_reader (reader)
                CROSS JOIN LATERAL (SELECT CASE WHEN JSONB_TYPEOF(reader['0']) = 'number' THEN (reader['0'] #> '{}')::INT END) q_position (position)
                CROSS JOIN LATERAL (SELECT reader['1'] ->> position) AS q_value (value)
                ) next_reader ON (opcode = '#next-reader')
        LEFT JOIN LATERAL
                (
                SELECT  ret,
                        CASE WHEN ret IS NULL THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#read-form', reader_ref)) END AS calls,
                        CASE
                        WHEN (reader_ref ->> 't') = 'reader' IS DISTINCT FROM TRUE THEN 'Invalid reader reference'
                        WHEN ret #>> '{}' IN (')', ']', '}') THEN 'Unbalanced parens'
                        END AS throws
                FROM    (SELECT  args[0], args[1]) q_args (reader_ref, ret)
                ) read_form ON (opcode = 'read-form')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN calls IS NOT NULL THEN NULL
                        WHEN is_open_paren AND is_closed_paren THEN chunk
                        WHEN is_open_bracket AND is_closed_bracket THEN JSONB_BUILD_OBJECT('t', 'vec', 'v', chunk)
                        WHEN is_open_curly AND is_closed_curly AND JSONB_ARRAY_LENGTH(chunk) % 2 = 0 THEN
                                (
                                SELECT  JSONB_BUILD_OBJECT('t', 'map', 'v', COALESCE(JSONB_OBJECT_AGG(key #>> '{}', value), '{}'::JSONB))
                                FROM    JSONB_ARRAY_ELEMENTS(chunk) WITH ORDINALITY keys (key, index)
                                JOIN    JSONB_ARRAY_ELEMENTS(chunk) WITH ORDINALITY values (value, index)
                                ON      values.index = keys.index + 1
                                WHERE   keys.index % 2 = 1
                                )
                        WHEN NOT is_open THEN first_token
                        END AS ret,
                        calls,
                        CASE
                        WHEN (is_open AND is_eof) OR
                             (is_closed AND (
                                     (is_open_paren AND NOT is_closed_paren) OR
                                     (is_open_bracket AND NOT is_closed_bracket) OR
                                     (is_open_curly AND NOT is_closed_curly)
                                     )) THEN 'Unbalanced parens'
                        WHEN is_open_curly AND NOT is_closed_curly AND JSONB_ARRAY_LENGTH(chunk) % 2 = 1 AND JSONB_TYPEOF(chunk[-1]) <> 'string' THEN
                                FORMAT('Cannot use token "%s" as a map key', last_token)
                        END AS throws
                FROM    (SELECT  args[0] reader_ref, args[1] first_token, args[-1] last_token, JSONB_PATH_QUERY_ARRAY(args, '$[2 to last - 1]') chunk) q_tokens
                CROSS JOIN LATERAL
                        (
                        SELECT  COALESCE(first_token = c_open_paren, FALSE) is_open_paren,
                                COALESCE(last_token = c_closed_paren, FALSE) is_closed_paren,
                                COALESCE(first_token = c_open_bracket, FALSE) is_open_bracket,
                                COALESCE(last_token = c_closed_bracket, FALSE) is_closed_bracket,
                                COALESCE(first_token = c_open_curly, FALSE) is_open_curly,
                                COALESCE(last_token = c_closed_curly, FALSE) is_closed_curly,
                                COALESCE(last_token = c_eof, FALSE) is_eof,
                                c_reader_macros ->> (first_token #>> '{}') reader_macro_form
                        ) q_state
                CROSS JOIN LATERAL
                        (
                        SELECT  is_open_paren OR is_open_curly OR is_open_bracket AS is_open,
                                is_closed_paren OR is_closed_curly OR is_closed_bracket AS is_closed
                        ) q_state2
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN first_token IS NULL THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#next-reader', reader_ref))
                                WHEN is_open AND NOT (is_closed OR is_eof) THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#read-form', reader_ref))
                                WHEN reader_macro_form IS NOT NULL THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('list', reader_macro_form), JSONB_BUILD_ARRAY('#read-form', reader_ref))
                                END
                        ) q_calls (calls)
                ) read_form2 ON (opcode = '#read-form')
        LEFT JOIN LATERAL (SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', COALESCE(args[0], c_null))) AS calls) eval ON (opcode = 'eval')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN eval_calls IS NULL THEN eval_ast END AS ret,
                        eval_calls AS calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]')) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array', JSONB_TYPEOF(eval_ast) = 'string') q_array (ast_is_array, ast_is_symbol)
                CROSS JOIN LATERAL (SELECT CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END, JSONB_ARRAY_LENGTH(eval_ret) = 0) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL
                        (
                        SELECT  COALESCE(eval_ast #>> '{0}' = ANY(special_forms), FALSE),
                                COALESCE(eval_ast #>> '{}' = ANY(builtin_functions), FALSE)
                        ) q_callable (is_special_form, is_builtin_function)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN ret_empty AND is_special_form THEN JSONB_BUILD_ARRAY(eval_ast)
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                WHEN ast_is_symbol AND NOT is_builtin_function THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#get-env', eval_ast))
                                END
                        ) q_calls (eval_calls)
                ) eval2 ON (opcode = '#eval')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_OBJECT('t', 'fn*', 'v', JSONB_BUILD_ARRAY(env, args[0], COALESCE(args[1], c_null))) ret,
                        CASE
                        WHEN JSONB_TYPEOF(args[0]) <> 'array' OR EXISTS (SELECT FROM JSONB_ARRAY_ELEMENTS(args[0]) arg WHERE JSONB_TYPEOF(arg) <> 'string') THEN
                                'The first argument to fn* should be a list of symbols'
                        END throws
                ) fn ON (opcode = 'fn*')
        LEFT JOIN LATERAL
                (
                SELECT  ret,
                        CASE WHEN ret IS NULL THEN FORMAT('Error applying operator: (%s %s %s)', opcode, args -> 0, args -> 1) END AS throws
                FROM    (
                        SELECT  CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0) END::DOUBLE PRECISION,
                                CASE WHEN JSONB_TYPEOF(args['1']) = 'number' THEN (args ->> 1) END::DOUBLE PRECISION
                        ) q_args (arg1, arg2)
                LEFT JOIN LATERAL
                        (
                        SELECT  TO_JSONB(
                                CASE opcode
                                WHEN '+' THEN TO_JSONB(arg1 + arg2)
                                WHEN '-' THEN TO_JSONB(arg1 - arg2)
                                WHEN '*' THEN TO_JSONB(arg1 * arg2)
                                WHEN '/' THEN TO_JSONB(arg1 / arg2)
                                END
                                )
                        ) q_ret (ret) ON TRUE
                ) math_ops ON (opcode IN ('+', '-', '*', '/'))
        LEFT JOIN LATERAL
                (
                SELECT  TO_JSONB(COALESCE(args[0] = args[1], FALSE)) AS ret
                ) eq ON (opcode = '=')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN can_tco THEN next_frames ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', env), FALSE) END AS calls
                FROM    (SELECT CASE WHEN callable ->> 't' = 'fn*' THEN (callable #>> '{v, 0}') END::INT) AS q_call_args (call_env)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#eval', callable #> '{v, 2}'),
                                        JSONB_BUILD_ARRAY('#fill-args', callable #> '{v, 1}', args),
                                        JSONB_BUILD_ARRAY('#push-env', call_env)
                                )
                        ) AS q_next_frames (next_frames)
                ) fn_apply ON (callable ->> 't' = 'fn*')
        LEFT JOIN LATERAL (SELECT JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval'), JSONB_SET(current_frame, '{0, t}', TO_JSONB('fn*'::TEXT))) AS calls) macro_apply ON (callable ->> 't' = 'macro')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        CASE WHEN value IS NULL THEN FORMAT('Variable %s not found', key) END AS throws
                FROM    (SELECT args ->> 0) AS q_key (key)
                LEFT JOIN LATERAL
                        (
                        WITH    RECURSIVE get (current_env) AS
                                (
                                SELECT  heap -> env
                                UNION ALL
                                SELECT  heap -> (current_env ->> 0)::INT
                                FROM    get
                                WHERE   current_env IS NOT NULL
                                )
                        SELECT  vals -> key
                        FROM    get
                        CROSS JOIN LATERAL (SELECT current_env -> 1) q (vals)
                        WHERE   vals ? key
                        LIMIT   1
                        ) AS env_value (value) ON TRUE
                ) get_env ON (opcode = '#get-env')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        JSONB_SET(heap, ARRAY[env::TEXT, 1::TEXT, key], value, TRUE) AS new_heap
                FROM    (SELECT args ->> 0, args['1']) q (key, value)
                ) set_env ON (opcode = '#set-env')
        LEFT JOIN LATERAL
                (
                SELECT  new_env,
                        CASE
                        WHEN new_env IS NULL THEN
                                JSONB_BUILD_ARRAY(
                                        current_frame,
                                        JSONB_BUILD_ARRAY('#add-heap', JSONB_BUILD_ARRAY(old_env, JSONB_BUILD_OBJECT()))
                                )
                        END AS calls
                FROM    (SELECT CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0)::INT END, CASE WHEN JSONB_TYPEOF(args['1']) = 'number' THEN (args ->> 1)::INT END) q_args (old_env, new_env)
                ) push_env ON (opcode = '#push-env')
        LEFT JOIN LATERAL (SELECT CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0)::INT END new_env, args['1'] ret) pop_env ON (opcode = '#pop-env')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_SET(heap, ARRAY[env::TEXT, 1::TEXT], env_data || new_data) AS new_heap
                FROM    (
                        SELECT  CASE WHEN opcode = '#fill-args' AND JSONB_TYPEOF(args['0']) = 'array' THEN args[0] END,
                                CASE WHEN opcode = '#fill-args' AND JSONB_TYPEOF(args['1'])  = 'array' THEN args[1] END
                        ) q_args (keys, values)
                CROSS JOIN LATERAL (SELECT heap[env::TEXT]['1']) q_env_data (env_data)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_OBJECT_AGG(key #>> '{}', COALESCE(value, c_null) ORDER BY index)
                        FROM    JSONB_ARRAY_ELEMENTS(keys) WITH ORDINALITY q_keys (key, index)
                        LEFT JOIN
                                JSONB_ARRAY_ELEMENTS(values) WITH ORDINALITY q_values (value, index)
                        USING   (index)
                        ) q_new_data (new_data)
                ) fill_args ON (opcode = '#fill-args')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN can_tco THEN next_frames
                        ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', env), FALSE)
                        END AS calls,
                        CASE
                        WHEN NOT vars_is_array THEN 'The first argument to let* should be a list'
                        WHEN body IS NULL THEN 'There should be two arguments to let*'
                        END AS throws
                FROM    (SELECT args['0'] IS NOT NULL AND JSONB_TYPEOF(args['0']) = 'array', args['0'], args['1']) q_vars_array (vars_is_array, vars, body)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#let*', vars, body),
                                        JSONB_BUILD_ARRAY('#push-env', env)
                                )
                        ) q_next_frames (next_frames)
                ) let ON (opcode = 'let*')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN vars_is_array AND JSONB_ARRAY_LENGTH(vars) = 0 THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', body))
                        ELSE JSONB_BUILD_ARRAY(
                                JSONB_SET(current_frame, '{1}', JSONB_PATH_QUERY_ARRAY(vars, '$[2 to last]')),
                                JSONB_BUILD_ARRAY('#set-env', key ->> 'v'),
                                JSONB_BUILD_ARRAY('#eval', value)
                        )
                        END AS calls,
                        CASE WHEN JSONB_TYPEOF(key) <> 'string' THEN 'let*: variable names should be symbols' END AS throws
                FROM    (SELECT args[0], args[1]) q_vars_body (vars, body)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(vars) = 'array', vars[0], COALESCE(vars[1], c_null)) q_key_value (vars_is_array, key, value)
                ) let2 ON (opcode = '#let*')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#set-env', key), JSONB_BUILD_ARRAY('#eval', value)) AS calls,
                        CASE
                        WHEN (JSONB_TYPEOF(key) = 'string') IS DISTINCT FROM TRUE THEN 'def!: variable name should be a symbol'
                        WHEN value IS NULL THEN 'def!: value should be provided'
                        END AS throws
                FROM    (SELECT args[0], args[1]) q_vars (key, value)
                ) def ON (opcode = 'def!')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#set-env', key), JSONB_BUILD_ARRAY('#fn-to-macro'), JSONB_BUILD_ARRAY('#eval', value)) AS calls,
                        CASE
                        WHEN JSONB_TYPEOF(key) = 'string' IS DISTINCT FROM TRUE THEN 'defmacro!: variable name should be a symbol'
                        END AS throws
                FROM    (SELECT args[0], args[1]) q_vars (key, value)
                ) defmacro ON (opcode = 'defmacro!')
        LEFT JOIN LATERAL
                (
                SELECT  CASE args #>> '{0, t}'
                        WHEN 'macro' THEN args[0]
                        WHEN 'fn*' THEN JSONB_SET(args[0], '{t}', TO_JSONB('macro'::TEXT), FALSE)
                        END AS ret,
                        CASE
                        WHEN NOT COALESCE(args #>> '{0, t}' IN ('fn*', 'macro'), FALSE) THEN 'defmacro!: the second argument should evaluate to a function or a macro'
                        END AS throws
                ) macro ON (opcode = '#fn-to-macro')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(
                                JSONB_BUILD_ARRAY('#if2', yes, COALESCE(no, c_null)),
                                JSONB_BUILD_ARRAY('#eval', condition)
                        ) AS calls,
                        CASE WHEN condition IS NULL OR yes IS NULL THEN 'if should have at least two arguments' END throws
                FROM    (SELECT args[0], args[1], args[2]) q_args (condition, yes, no)
                ) if ON (opcode = 'if')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN result IS NULL OR result IN (c_null, 'false'::JSONB) THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', no))
                        ELSE JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', yes))
                        END AS calls
                FROM    (SELECT args[0], args[1], args[2]) q_args (yes, no, result)
                ) if2 ON (opcode = '#if2')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN total > 1 THEN
                                JSONB_BUILD_ARRAY(
                                        current_frame - 1,
                                        JSONB_BUILD_ARRAY('#nop'),
                                        eval_frame
                                )
                        ELSE    JSONB_BUILD_ARRAY(eval_frame)
                        END AS calls
                FROM    (SELECT args['0'], JSONB_ARRAY_LENGTH(args)) AS q_args (next, total)
                CROSS JOIN LATERAL (SELECT JSONB_BUILD_ARRAY('#eval', COALESCE(next, c_null))) AS q_eval_frame (eval_frame)
                ) _do ON (opcode = 'do')
        LEFT JOIN LATERAL (SELECT  COALESCE(args[0], c_null) AS ret) quote ON (opcode = 'quote')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN NOT is_array THEN COALESCE(value, '[]'::JSONB)
                        WHEN is_array AND JSONB_ARRAY_LENGTH(value) = 0 THEN JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]')
                        END ret,
                        CASE
                        WHEN maybe_special = c_unquote THEN JSONB_BUILD_ARRAY(patched_frame, JSONB_BUILD_ARRAY('eval', form[1]))
                        WHEN maybe_special = c_splice_unquote THEN JSONB_BUILD_ARRAY(patched_frame, JSONB_BUILD_ARRAY('#splice'), JSONB_BUILD_ARRAY('eval', form[1]))
                        ELSE JSONB_BUILD_ARRAY(patched_frame, JSONB_BUILD_ARRAY(opcode, form))
                        END calls
                FROM    (SELECT args[0], args[0][0], args[0][0][0], COALESCE(JSONB_TYPEOF(args[0]) = 'array', FALSE)) q_args (value, form, maybe_special, is_array)
                CROSS JOIN LATERAL (SELECT current_frame #- '{1, 0}') q_patched_frame (patched_frame)
                ) quasiquote ON (opcode = 'quasiquote')
        LEFT JOIN LATERAL (SELECT JSONB_SET(stack - (-1), '{-1}', stack['-2'] || args['0']) AS new_stack) splice ON (opcode = '#splice')
        LEFT JOIN LATERAL (SELECT args AS ret) list ON (opcode = 'list')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(head) || list AS ret,
                        CASE WHEN is_list IS DISTINCT FROM TRUE THEN 'Second argument to cons should be a list' END AS throws
                FROM    (SELECT args['0'], args['1'], JSONB_TYPEOF(args['1']) = 'array') AS q_args (head, list, is_list)
                ) cons ON (opcode = 'cons')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN NOT has_non_arrays THEN
                                (
                                SELECT  JSONB_AGG(element ORDER BY arg_index, element_index)
                                FROM    JSONB_ARRAY_ELEMENTS(args) WITH ORDINALITY q_args (arg, arg_index)
                                CROSS JOIN LATERAL
                                        JSONB_ARRAY_ELEMENTS(arg) WITH ORDINALITY q_element (element, element_index)
                                )
                        END AS ret,
                        CASE WHEN has_non_arrays THEN 'All arguments to concat should be lists' END AS throws
                FROM    (
                        SELECT  COALESCE(BOOL_OR(JSONB_TYPEOF(arg) <> 'array'), FALSE)
                        FROM    JSONB_ARRAY_ELEMENTS(args) arg
                        ) q (has_non_arrays)
                ) _concat ON (opcode = 'concat')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(
                                JSONB_BUILD_ARRAY('#catch*', FALSE, env, exception_symbol, handler_body),
                                JSONB_BUILD_ARRAY('#eval', args[0])
                                ) AS calls,
                        CASE WHEN NOT COALESCE(catch_symbol #>> '{}' = 'catch*', FALSE) OR NOT COALESCE(JSONB_TYPEOF(exception_symbol) = 'string', FALSE) THEN
                                'Usage: (try* form (catch* exception handler_form))'
                        END AS throws
                FROM    (SELECT args[1][0] AS catch_symbol, args[1][1] AS exception_symbol, args[1][2] AS handler_body) q_args
                ) try ON (opcode = 'try*')
        LEFT JOIN LATERAL
                (
                SELECT  CASE caught WHEN 'false'::JSONB THEN args[4] END ret,
                        CASE
                        WHEN caught = 'false'::JSONB THEN NULL
                        WHEN can_tco THEN next_frames
                        ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', catch_env), FALSE)
                        END AS calls
                FROM    (SELECT args[0] caught, args[1] catch_env, args[2] exception_symbol, args[3] handler_body, args[4] value) q_args
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#eval', handler_body),
                                        JSONB_BUILD_ARRAY('#nop'),
                                        JSONB_BUILD_ARRAY('#set-env', exception_symbol, value),
                                        JSONB_BUILD_ARRAY('#push-env', catch_env)
                                )
                        ) q (next_frames)
                ) catch ON (opcode = '#catch*')
        LEFT JOIN LATERAL (SELECT) nop ON (opcode = '#nop')
        LEFT JOIN LATERAL (SELECT FORMAT('Invalid opcode: %s', callable) AS throws) invalid_opcode ON (opcode IS NULL)
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(add_heap.new_heap, next_reader.new_heap, fill_args.new_heap, set_env.new_heap, heap),
                        COALESCE(throw.new_stack, splice.new_stack),
                        COALESCE(push_env.new_env, pop_env.new_env, env),
                        COALESCE(
                                print.ret, _to_json.ret, read_input.ret,
                                pr_str.ret, read_form.ret, read_form2.ret, tokenize2.ret, add_heap.ret, next_reader.ret,
                                eval2.ret, fn.ret, macro.ret,
                                get_env.ret, math_ops.ret, eq.ret, pop_env.ret, set_env.ret,
                                quote.ret, cons.ret, list.ret, _concat.ret, quasiquote.ret, catch.ret
                                ),
                        COALESCE(
                                print.calls, tokenize.calls, tokenize2.calls, pr_str.calls, read_form.calls, read_form2.calls,
                                eval.calls, eval2.calls, fn_apply.calls, macro_apply.calls,
                                push_env.calls, let.calls, let2.calls, def.calls, defmacro.calls, if.calls, if2.calls, _do.calls,
                                quasiquote.calls, try.calls, catch.calls),
                        COALESCE(
                                tokenize.throws, get_env.throws, read_form.throws, read_form2.throws, fn.throws, math_ops.throws, let2.throws,
                                let.throws, def.throws, defmacro.throws, macro.throws, if.throws, cons.throws, _concat.throws, try.throws,
                                invalid_opcode.throws),
                        COALESCE(print.new_output)
                ) rets (new_heap, new_stack, new_env, ret, calls, throws, new_output)
        CROSS JOIN LATERAL
                (
                SELECT  rets.new_heap,
                        COALESCE(
                                rets.new_stack,
                                CASE
                                WHEN rets.throws IS NOT NULL THEN
                                        stack || JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('throw', JSONB_BUILD_OBJECT('t', 'str', 'v', rets.throws)))
                                END,
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)
                        ) AS new_stack,
                        rets.new_env,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT * FROM loop

REPL

Traditionally, Lisp programs run in a Read-Print-Eval loop, or REPL for short. So far, we have covered the read, print, and eval parts. What about the loop part?

We could easily slap another opcode into the query, but that would be unsportmanlike and against the spirit of Lisp. We have to code the REPL loop in Mal itself.

To run Mal programs in our interpreter, we need to get Mal programs in there, and we can't get Mal programs in there before we can write a REPL loop in Mal to run them. We're having a sort of chicken-and-egg problem here.

This is, of course, not new, so we need to put some bootstrap code on the stack manually. (As a side remark, that's exactly how "bootstrapping" came to mean "self-initialization": the program needs to lift itself by pulling by its own bootstraps, so to speak). But it has to be the bare minimum.

For this purpose, we'll create just one new opcode called #read-input. It will read a string from the initialization part of the query. We'll also put bootstrap code right on the stack, as a string with a Mal program. There will be only three opcodes on the stack: [["eval"], ["read-form"], ["tokenize"]], plus the query will dynamically add the arguments for tokenize.

How do we implement a REPL loop in Mal?

Normally, we would read forms in a loop, call eval, and print results. Mal, however, doesn't have loops out of the box. We could use recursion instead of loops, but there's a problem: we want all our evals to run in the same environment, so that later evals could see variables introduced by the previous evals that ran in the loop. Each recursion invocation creates its own environment, though. If we do it this way, eval environments get isolated, and further evals won't see the side effects of the previous ones.

Here's where macros get really useful.

On macros

In Lisps, macros are a way to generate Lisp programs dynamically, on the fly, and evaluate them right there and then. Other languages sometimes support this (to an extent), but usually don't treat this functionality as a first-class citizen.

What are some examples of that?

• In procedural extensions to database languages (PL/SQL, pl/pgsql, TSQL and others), you can compose a string with SQL or procedural code in it, and call it. This is called "dynamic SQL". Everyone does it, and everyone is embarrassed to admit it, because it feels kludgy.
• In non-procedural SQL, there's no concept of the sort.
• In JavaScript, there's eval. When you take into account the, how do I put it, lispness on JavaScript, it's not surprising at all.

  eval, though, is the pariah of the JavaScript world. It's there, but it's shunned, not allowed in the clean part of the house, and is not to be mentioned at the dinner table.

• In C#, you can create instances of the Expression class, which stores the AST of C# programs, by writing C# code right inside your source files, without converting it to a string first.

  You can then compile the expressions, which will turn them into executable delegates. Or you can use them in a pattern known as "fluent builders", which means using pieces of C# AST to build expressions in another language, such as SQL, MongoDB, Elasticsearch, and such like.

  Unlike other popular languages, building, evaluating, and using AST at runtime is not stigmatized in C#. That's in no small way due to the ability to generate language AST right in the language itself, at runtime, without an intermediate string representation. It's a very lispy thing to do.

It is sometimes said that as languages evolve, they inevitably converge to Lisp. This is, apparently, because their creators keep adding features that existed in Lisp for decades. C# is a shiny example of that.

The integrated ability to generate and use ASP at runtime was added in C# 3.0 (2007).

What about design time? There's an ability to have your editor run C# code every time you press a key in the editor. This code evaluates the AST of your program as you type it, and annotates it with squiggly lines: hints, warnings, and errors. It's called "Roslyn analyzers", and it made it to production in 2015.

How about build time? There's another feature of C# compilers, called "source generators". They, too, analyze the AST of the program you build, and create new ASTs, which they add into the build source tree. They were added in C# 9.0 (2020).

Even now, writing Roslyn analyzers and source code generators, and integrating them with your project, is not for the faint of heart. They require quite a lot of boilerplate.

JavaScript has Babel, and writing Babel code is not a pleasant experience at all. But at least it's there (since 2014).

Lisp had it all for decades, built right inside the language, as part of its core functionality. The reason for that is that Lisp programs are not strings (as they are in other languages), but lists, just like Lisp data. Lisp makes it really easy to have no distinction between code and data, and it's up to the programmer to draw the line.

Let me get on my soapbox again, just for a little while.

In the lambda calculus, all you have is an endless sea of functions pointlessly flowing into one another. To make them useful, you need to take one function by the tail and say: "From now on, you're special, and you mean something". (Usually, it's the identity function.) Only then, and not before, do they get a purpose in their life and start making sense.

Lisp is the same. Thank you for coming to my TED talk.

REPL in Mal

Here's the REPL code which we'll be using to bootstrap our interpreter:

((let* ()
    (do
      (def! reader (tokenize (read-input)))
      (def! read
        (fn* () (read-form reader)))
      (defmacro! repl
        (fn* ()
          (do
            (def! form (read))
            (if (= eof form)
              eof
              `(do
                (print (try* ~form (catch* exception exception)))
                (~repl)))))))))

Let's go through it piece by piece:

(def! reader (tokenize (read-input)))

(tokenize (read-input)) returns an instance of Reader, and we're assigning it to the variable reader.

(def! read
  (fn* () (read-form reader)))

Calling (read-form reader) returns the next form from this reader (and updates its internal state). We don't want to expose the reader to the outside. So we expose a generator: a function that closes over reader. The generator is called without parameters, and yet produces a new value each time.

We're saving the generator in the variable read. We can now call it like this: (read), which will evaluate to the next form from the input string.

(fn* ()
  (do
    (def! form (read))
    (if (= eof form)
      eof
      `(do
        (print (try* ~form (catch* exception exception)))
        (~repl)))))

This is a function that evaluates to an unparsed form (AST). The backtick ` on line 6 is a shorthand syntax for the special form quasiquote. It tells the evaluator that it should avoid evaluating the AST, unless specially instructed to do so. It is instructed to do so on lines 7 and 8, with the special form unquote (for which the tilde ~ is shorthand).

This function doesn't have any parameters, but closes over the variables repl and read, which come from the environment where the function was defined.

(defmacro! repl
  (fn* ()
    (do
      (def! form (read))
      (if (= eof form)
        eof
        `(do
          (print (try* ~form (catch* exception exception)))
          (~repl))))))

Here's where the magic is happening. Macro transforms a regular function into something called a "macro function". Calling a macro function is a two-stage process.

First, the evaluator calls the function that was provided as a source for the macro. The arguments to this function are pieces of unparsed AST that go after the macro call.

Instead of producing a value, the macro-backing function produces an AST. But, unlike the AST that comes from read-form, it can contain already evaluated functions, macros, and other objects: something that read-form can't produce. These values usually come from the environment that the function had closed over when it was created.

Second, the evaluator evaluates the new AST as it normally would. The evaluation happens in the same environment the macro function was called.

There's no way in Mal to define a macro object without putting it into the environment. It means that if we want our default REPL environment to be free from pollution, we should come up with something.

Here's how we do it:

((let* ()
    (do
      (def! reader …)
      (def! read …)
      (defmacro! repl …)))

We are wrapping the code that creates the variables read and repl into a let* form. This form creates a new environment, which repl closes over at the time of its creation.

Now, here's the trick. We can't create a macro without putting it into an environment. But defmacro!, besides creating a macro, also returns it. So the output of the chain (let* () (do … (defmacro! (…)))) will be a macro.

All that's left to do is immediately apply this parameterless macro. It can be just by wrapping the let* form into an additional pair of parentheses.

This way, all the forms that come from the input will be evaluated in the default environments. At the same time, it will be free from pollution. No variables will get created on the default environment except those that come from the evaluations of the user code.

Running the REPL

Let's try evaluate multiple expressions that come from the input:

(def! plus1 (fn* (x) (+ 1 x)))
(def! times2 (fn* (x) (* x 2)))
(def! result (plus1 (times2 3))

We'll only show the lines that do have output. In addition, we'll dump the list of symbols set in the default environment.

WITH    RECURSIVE
        constants AS
        (
        SELECT  ARRAY[
                'tokenize', 'print', 'to-json', 'read-input', 'read-form', 'throw', 'eval', 'list', 'cons', 'concat', 'pr-str',
                '+', '-', '*', '/', '='] AS builtin_functions,
                ARRAY['fn*', 'def!', 'let*', 'if', 'do', 'quote', 'quasiquote', 'defmacro!', 'try*'] AS special_forms,
                ARRAY['(', ')', '[', ']', '{', '}', '''', '`', '~', '~@'] AS symbols,
                TO_JSONB('('::TEXT) AS c_open_paren, TO_JSONB(')'::TEXT) AS c_closed_paren,
                TO_JSONB('['::TEXT) AS c_open_bracket, TO_JSONB(']'::TEXT) AS c_closed_bracket,
                TO_JSONB('{'::TEXT) AS c_open_curly, TO_JSONB('}'::TEXT) AS c_closed_curly,
                TO_JSONB('unquote'::TEXT) AS c_unquote, TO_JSONB('splice-unquote'::TEXT) AS c_splice_unquote,
                'null'::JSONB AS c_null, '{"t": "eof"}'::JSONB AS c_eof,
                '{"''": "quote", "`": "quasiquote", "~": "unquote", "~@": "splice-unquote"}'::JSONB AS c_reader_macros
        ),
        bootstrap (code, input) AS
        (
        SELECT  '
((let* ()
    (do
      (def! reader (tokenize (read-input)))
      (def! read
        (fn* () (read-form reader)))
      (defmacro! repl
        (fn* ()
          (do
            (def! form (read))
            (if (= eof form)
              eof
              `(do
                (print (try* ~form (catch* exception exception)))
                (~repl)))))))))
        ',
        '
(def! plus1 (fn* (x) (+ 1 x)))
(def! times2 (fn* (x) (* x 2)))
undefined-variable
(def! result (plus1 (times2 3)))
        '
        ),
        loop (heap, stack, env, output, step) AS
        (
        SELECT  '[[null, {"eof": {"t": "eof"}}]]'::JSONB,
                JSONB_INSERT('[["eval"], ["read-form"], ["tokenize"]]'::JSONB, '{-1, -1}', (SELECT JSONB_BUILD_OBJECT('t', 'str', 'v', TO_JSONB(code)) FROM bootstrap), TRUE),
                0, NULL::TEXT, 1
        FROM    constants
        UNION ALL
        SELECT  new.*, step + 1
        FROM    loop
        CROSS JOIN constants
        CROSS JOIN LATERAL (SELECT stack #> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]'), stack['-1'], stack #>> '{-2, 0}' = '#pop-env') q_call (callable, args, current_frame, can_tco)
        CROSS JOIN LATERAL
                (
                SELECT  CASE
                        WHEN JSONB_TYPEOF(callable) = 'string' THEN callable #>> '{}'
                        WHEN callable ->> 't' = 'fn*' THEN '#fn-apply'
                        WHEN callable ->> 't' = 'macro' THEN '#macro-apply'
                        END
                ) q_opcode (opcode)
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#tokenize', args[0])) AS calls,
                        CASE WHEN (args #>> '{0, t}' = 'str') IS DISTINCT FROM TRUE THEN 'Usage: (tokenize string)' END AS throws
                ) tokenize ON (opcode = 'tokenize')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN args[1] IS NOT NULL THEN JSONB_BUILD_OBJECT('t', 'reader', 'v', args[1]) END AS ret,
                        CASE WHEN args[1] IS NULL THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#add-heap', JSONB_BUILD_ARRAY(0, tokens))) END AS calls
                FROM    (
                        SELECT  COALESCE(JSONB_AGG(TO_JSONB(token) ORDER BY index), '[]'::JSONB)
                        FROM    REGEXP_MATCHES(args #>> '{0, v}', '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}(''"`~^,;)]*)', 'gm') WITH ORDINALITY AS q (match, index)
                        CROSS JOIN LATERAL (SELECT match[1]) q_token (token)
                        WHERE   token > '' AND NOT token ^@ ';'
                        ) q_tokens (tokens)
                ) tokenize2 ON (opcode = '#tokenize')
        LEFT JOIN LATERAL (SELECT JSONB_BUILD_OBJECT('t', 'str', 'v', TO_JSONB(input)) AS ret FROM bootstrap) read_input ON (opcode = 'read-input')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN is_string THEN c_null END AS ret,
                        CASE WHEN is_string THEN args #>> '{0, v}' END new_output,
                        CASE WHEN NOT is_string THEN JSONB_BUILD_ARRAY(JSON_BUILD_ARRAY(opcode), JSONB_BUILD_ARRAY('pr-str', COALESCE(args[0], c_null))) END AS calls
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL (SELECT TO_JSONB(args['0']::TEXT) AS ret) _to_json ON (opcode = 'to-json')
        LEFT JOIN LATERAL
                (
                SELECT  *,
                        CASE
                        WHEN type = 'array' AND JSONB_ARRAY_LENGTH(value) > 0 THEN NULL
                        ELSE JSONB_BUILD_OBJECT('t', 'str', 'v', TO_JSONB(
                                CASE
                                WHEN type IN ('number', 'boolean') THEN value::TEXT
                                WHEN type = 'string' THEN value #>> '{}'
                                WHEN type = 'null' THEN 'nil'
                                WHEN complex_type = 'str' THEN (value -> 'v')::TEXT
                                WHEN type = 'array' AND JSONB_ARRAY_LENGTH(value) = 0 THEN
                                (
                                SELECT  '(' || COALESCE(STRING_AGG(element #>> '{v}', ' ' ORDER BY index), '') || ')'
                                FROM    JSONB_ARRAY_ELEMENTS(rest) WITH ORDINALITY q (element, index)
                                )
                                WHEN complex_type IS NOT NULL THEN FORMAT('#<%s>', complex_type)
                                ELSE 'Unprintable value'
                                END))
                        END
                        AS ret,
                        CASE WHEN type = 'array' AND JSONB_ARRAY_LENGTH(value) > 0 THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('pr-str', value['0'])) END AS calls
                FROM    (SELECT args[0], JSONB_TYPEOF(args[0]), args[0] ->> 't', JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]')) q (value, type, complex_type, rest)
                ) pr_str ON (opcode = 'pr-str')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN catch_index IS NOT NULL THEN
                                JSONB_PATH_QUERY_ARRAY(stack, '$[0 to $index - 1]', JSONB_BUILD_OBJECT('index', catch_index)) ||
                                JSONB_BUILD_ARRAY(JSONB_SET(stack[catch_index], '{1}', 'true'::JSONB) || COALESCE(args[0], c_null))
                        ELSE JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('print', args[0]))
                        END
                        AS new_stack
                FROM    (SELECT) q
                LEFT JOIN LATERAL
                        (
                        SELECT  index::INT - 1
                        FROM    JSONB_ARRAY_ELEMENTS(stack) WITH ORDINALITY q_frames (frame, index)
                        WHERE   (frame ->> 0) = '#catch*'
                        ORDER BY
                                index DESC
                        LIMIT 1
                        ) q_catch_index (catch_index) ON TRUE
                ) throw ON (opcode = 'throw')
        LEFT JOIN LATERAL
                (
                SELECT  new_heap, TO_JSONB(JSONB_ARRAY_LENGTH(new_heap) - 1) ret
                FROM    (SELECT JSONB_INSERT(heap, '{-1}', args[0], TRUE)) AS q_heap (new_heap)
                ) add_heap ON (opcode = '#add-heap')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN value IS NULL THEN c_eof
                        WHEN value = 'nil' THEN c_null
                        WHEN value ~ '^[-+]?\d+' OR value IN ('true', 'false') THEN value::JSONB
                        WHEN value ^@ '"' THEN JSONB_BUILD_OBJECT('t', 'str', 'v', value::JSONB)
                        ELSE TO_JSONB(value)
                        END AS ret,
                        CASE WHEN value IS NOT NULL THEN JSONB_SET(heap, ARRAY[reader_ptr, '0'], TO_JSONB(position + 1)) END AS new_heap
                FROM    (SELECT args['0']) AS q_reader_ref (reader_ref)
                CROSS JOIN LATERAL (SELECT reader_ref ->> 'v') AS q_reader_ptr (reader_ptr)
                CROSS JOIN LATERAL (SELECT heap[reader_ptr]) q_reader (reader)
                CROSS JOIN LATERAL (SELECT CASE WHEN JSONB_TYPEOF(reader['0']) = 'number' THEN (reader['0'] #> '{}')::INT END) q_position (position)
                CROSS JOIN LATERAL (SELECT reader['1'] ->> position) AS q_value (value)
                ) next_reader ON (opcode = '#next-reader')
        LEFT JOIN LATERAL
                (
                SELECT  ret,
                        CASE WHEN ret IS NULL THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#read-form', reader_ref)) END AS calls,
                        CASE
                        WHEN (reader_ref ->> 't') = 'reader' IS DISTINCT FROM TRUE THEN 'Invalid reader reference'
                        WHEN ret #>> '{}' IN (')', ']', '}') THEN 'Unbalanced parens'
                        END AS throws
                FROM    (SELECT  args[0], args[1]) q_args (reader_ref, ret)
                ) read_form ON (opcode = 'read-form')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN calls IS NOT NULL THEN NULL
                        WHEN is_open_paren AND is_closed_paren THEN chunk
                        WHEN is_open_bracket AND is_closed_bracket THEN JSONB_BUILD_OBJECT('t', 'vec', 'v', chunk)
                        WHEN is_open_curly AND is_closed_curly AND JSONB_ARRAY_LENGTH(chunk) % 2 = 0 THEN
                                (
                                SELECT  JSONB_BUILD_OBJECT('t', 'map', 'v', COALESCE(JSONB_OBJECT_AGG(key #>> '{}', value), '{}'::JSONB))
                                FROM    JSONB_ARRAY_ELEMENTS(chunk) WITH ORDINALITY keys (key, index)
                                JOIN    JSONB_ARRAY_ELEMENTS(chunk) WITH ORDINALITY values (value, index)
                                ON      values.index = keys.index + 1
                                WHERE   keys.index % 2 = 1
                                )
                        WHEN NOT is_open THEN first_token
                        END AS ret,
                        calls,
                        CASE
                        WHEN (is_open AND is_eof) OR
                             (is_closed AND (
                                     (is_open_paren AND NOT is_closed_paren) OR
                                     (is_open_bracket AND NOT is_closed_bracket) OR
                                     (is_open_curly AND NOT is_closed_curly)
                                     )) THEN 'Unbalanced parens'
                        WHEN is_open_curly AND NOT is_closed_curly AND JSONB_ARRAY_LENGTH(chunk) % 2 = 1 AND JSONB_TYPEOF(chunk[-1]) <> 'string' THEN
                                FORMAT('Cannot use token "%s" as a map key', last_token)
                        END AS throws
                FROM    (SELECT  args[0] reader_ref, args[1] first_token, args[-1] last_token, JSONB_PATH_QUERY_ARRAY(args, '$[2 to last - 1]') chunk) q_tokens
                CROSS JOIN LATERAL
                        (
                        SELECT  COALESCE(first_token = c_open_paren, FALSE) is_open_paren,
                                COALESCE(last_token = c_closed_paren, FALSE) is_closed_paren,
                                COALESCE(first_token = c_open_bracket, FALSE) is_open_bracket,
                                COALESCE(last_token = c_closed_bracket, FALSE) is_closed_bracket,
                                COALESCE(first_token = c_open_curly, FALSE) is_open_curly,
                                COALESCE(last_token = c_closed_curly, FALSE) is_closed_curly,
                                COALESCE(last_token = c_eof, FALSE) is_eof,
                                c_reader_macros ->> (first_token #>> '{}') reader_macro_form
                        ) q_state
                CROSS JOIN LATERAL
                        (
                        SELECT  is_open_paren OR is_open_curly OR is_open_bracket AS is_open,
                                is_closed_paren OR is_closed_curly OR is_closed_bracket AS is_closed
                        ) q_state2
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN first_token IS NULL THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#next-reader', reader_ref))
                                WHEN is_open AND NOT (is_closed OR is_eof) THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#read-form', reader_ref))
                                WHEN reader_macro_form IS NOT NULL THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('list', reader_macro_form), JSONB_BUILD_ARRAY('#read-form', reader_ref))
                                END
                        ) q_calls (calls)
                ) read_form2 ON (opcode = '#read-form')
        LEFT JOIN LATERAL (SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', COALESCE(args[0], c_null))) AS calls) eval ON (opcode = 'eval')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN eval_calls IS NULL THEN eval_ast END AS ret,
                        eval_calls AS calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]')) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array', JSONB_TYPEOF(eval_ast) = 'string') q_array (ast_is_array, ast_is_symbol)
                CROSS JOIN LATERAL (SELECT CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END, JSONB_ARRAY_LENGTH(eval_ret) = 0) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL
                        (
                        SELECT  COALESCE(eval_ast #>> '{0}' = ANY(special_forms), FALSE),
                                COALESCE(eval_ast #>> '{}' = ANY(builtin_functions), FALSE)
                        ) q_callable (is_special_form, is_builtin_function)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN ret_empty AND is_special_form THEN JSONB_BUILD_ARRAY(eval_ast)
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                WHEN ast_is_symbol AND NOT is_builtin_function THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#get-env', eval_ast))
                                END
                        ) q_calls (eval_calls)
                ) eval2 ON (opcode = '#eval')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_OBJECT('t', 'fn*', 'v', JSONB_BUILD_ARRAY(env, args[0], COALESCE(args[1], c_null))) ret,
                        CASE
                        WHEN JSONB_TYPEOF(args[0]) <> 'array' OR EXISTS (SELECT FROM JSONB_ARRAY_ELEMENTS(args[0]) arg WHERE JSONB_TYPEOF(arg) <> 'string') THEN
                                'The first argument to fn* should be a list of symbols'
                        END throws
                ) fn ON (opcode = 'fn*')
        LEFT JOIN LATERAL
                (
                SELECT  ret,
                        CASE WHEN ret IS NULL THEN FORMAT('Error applying operator: (%s %s %s)', opcode, args -> 0, args -> 1) END AS throws
                FROM    (
                        SELECT  CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0) END::DOUBLE PRECISION,
                                CASE WHEN JSONB_TYPEOF(args['1']) = 'number' THEN (args ->> 1) END::DOUBLE PRECISION
                        ) q_args (arg1, arg2)
                LEFT JOIN LATERAL
                        (
                        SELECT  TO_JSONB(
                                CASE opcode
                                WHEN '+' THEN TO_JSONB(arg1 + arg2)
                                WHEN '-' THEN TO_JSONB(arg1 - arg2)
                                WHEN '*' THEN TO_JSONB(arg1 * arg2)
                                WHEN '/' THEN TO_JSONB(arg1 / arg2)
                                END
                                )
                        ) q_ret (ret) ON TRUE
                ) math_ops ON (opcode IN ('+', '-', '*', '/'))
        LEFT JOIN LATERAL
                (
                SELECT  TO_JSONB(COALESCE(args[0] = args[1], FALSE)) AS ret
                ) eq ON (opcode = '=')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN can_tco THEN next_frames ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', env), FALSE) END AS calls
                FROM    (SELECT CASE WHEN callable ->> 't' = 'fn*' THEN (callable #>> '{v, 0}') END::INT) AS q_call_args (call_env)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#eval', callable #> '{v, 2}'),
                                        JSONB_BUILD_ARRAY('#fill-args', callable #> '{v, 1}', args),
                                        JSONB_BUILD_ARRAY('#push-env', call_env)
                                )
                        ) AS q_next_frames (next_frames)
                ) fn_apply ON (callable ->> 't' = 'fn*')
        LEFT JOIN LATERAL (SELECT JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval'), JSONB_SET(current_frame, '{0, t}', TO_JSONB('fn*'::TEXT))) AS calls) macro_apply ON (callable ->> 't' = 'macro')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        CASE WHEN value IS NULL THEN FORMAT('Variable %s not found', key) END AS throws
                FROM    (SELECT args ->> 0) AS q_key (key)
                LEFT JOIN LATERAL
                        (
                        WITH    RECURSIVE get (current_env) AS
                                (
                                SELECT  heap -> env
                                UNION ALL
                                SELECT  heap -> (current_env ->> 0)::INT
                                FROM    get
                                WHERE   current_env IS NOT NULL
                                )
                        SELECT  vals -> key
                        FROM    get
                        CROSS JOIN LATERAL (SELECT current_env -> 1) q (vals)
                        WHERE   vals ? key
                        LIMIT   1
                        ) AS env_value (value) ON TRUE
                ) get_env ON (opcode = '#get-env')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        JSONB_SET(heap, ARRAY[env::TEXT, 1::TEXT, key], value, TRUE) AS new_heap
                FROM    (SELECT args ->> 0, args['1']) q (key, value)
                ) set_env ON (opcode = '#set-env')
        LEFT JOIN LATERAL
                (
                SELECT  new_env,
                        CASE
                        WHEN new_env IS NULL THEN
                                JSONB_BUILD_ARRAY(
                                        current_frame,
                                        JSONB_BUILD_ARRAY('#add-heap', JSONB_BUILD_ARRAY(old_env, JSONB_BUILD_OBJECT()))
                                )
                        END AS calls
                FROM    (SELECT CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0)::INT END, CASE WHEN JSONB_TYPEOF(args['1']) = 'number' THEN (args ->> 1)::INT END) q_args (old_env, new_env)
                ) push_env ON (opcode = '#push-env')
        LEFT JOIN LATERAL (SELECT CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0)::INT END new_env, args['1'] ret) pop_env ON (opcode = '#pop-env')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_SET(heap, ARRAY[env::TEXT, 1::TEXT], env_data || new_data) AS new_heap
                FROM    (
                        SELECT  CASE WHEN opcode = '#fill-args' AND JSONB_TYPEOF(args['0']) = 'array' THEN args[0] END,
                                CASE WHEN opcode = '#fill-args' AND JSONB_TYPEOF(args['1'])  = 'array' THEN args[1] END
                        ) q_args (keys, values)
                CROSS JOIN LATERAL (SELECT heap[env::TEXT]['1']) q_env_data (env_data)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_OBJECT_AGG(key #>> '{}', COALESCE(value, c_null) ORDER BY index)
                        FROM    JSONB_ARRAY_ELEMENTS(keys) WITH ORDINALITY q_keys (key, index)
                        LEFT JOIN
                                JSONB_ARRAY_ELEMENTS(values) WITH ORDINALITY q_values (value, index)
                        USING   (index)
                        ) q_new_data (new_data)
                ) fill_args ON (opcode = '#fill-args')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN can_tco THEN next_frames
                        ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', env), FALSE)
                        END AS calls,
                        CASE
                        WHEN NOT vars_is_array THEN 'The first argument to let* should be a list'
                        WHEN body IS NULL THEN 'There should be two arguments to let*'
                        END AS throws
                FROM    (SELECT args['0'] IS NOT NULL AND JSONB_TYPEOF(args['0']) = 'array', args['0'], args['1']) q_vars_array (vars_is_array, vars, body)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#let*', vars, body),
                                        JSONB_BUILD_ARRAY('#push-env', env)
                                )
                        ) q_next_frames (next_frames)
                ) let ON (opcode = 'let*')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN vars_is_array AND JSONB_ARRAY_LENGTH(vars) = 0 THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', body))
                        ELSE JSONB_BUILD_ARRAY(
                                JSONB_SET(current_frame, '{1}', JSONB_PATH_QUERY_ARRAY(vars, '$[2 to last]')),
                                JSONB_BUILD_ARRAY('#set-env', key ->> 'v'),
                                JSONB_BUILD_ARRAY('#eval', value)
                        )
                        END AS calls,
                        CASE WHEN JSONB_TYPEOF(key) <> 'string' THEN 'let*: variable names should be symbols' END AS throws
                FROM    (SELECT args[0], args[1]) q_vars_body (vars, body)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(vars) = 'array', vars[0], COALESCE(vars[1], c_null)) q_key_value (vars_is_array, key, value)
                ) let2 ON (opcode = '#let*')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#set-env', key), JSONB_BUILD_ARRAY('#eval', value)) AS calls,
                        CASE
                        WHEN (JSONB_TYPEOF(key) = 'string') IS DISTINCT FROM TRUE THEN 'def!: variable name should be a symbol'
                        WHEN value IS NULL THEN 'def!: value should be provided'
                        END AS throws
                FROM    (SELECT args[0], args[1]) q_vars (key, value)
                ) def ON (opcode = 'def!')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#set-env', key), JSONB_BUILD_ARRAY('#fn-to-macro'), JSONB_BUILD_ARRAY('#eval', value)) AS calls,
                        CASE
                        WHEN JSONB_TYPEOF(key) = 'string' IS DISTINCT FROM TRUE THEN 'defmacro!: variable name should be a symbol'
                        END AS throws
                FROM    (SELECT args[0], args[1]) q_vars (key, value)
                ) defmacro ON (opcode = 'defmacro!')
        LEFT JOIN LATERAL
                (
                SELECT  CASE args #>> '{0, t}'
                        WHEN 'macro' THEN args[0]
                        WHEN 'fn*' THEN JSONB_SET(args[0], '{t}', TO_JSONB('macro'::TEXT), FALSE)
                        END AS ret,
                        CASE
                        WHEN NOT COALESCE(args #>> '{0, t}' IN ('fn*', 'macro'), FALSE) THEN 'defmacro!: the second argument should evaluate to a function or a macro'
                        END AS throws
                ) macro ON (opcode = '#fn-to-macro')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(
                                JSONB_BUILD_ARRAY('#if2', yes, COALESCE(no, c_null)),
                                JSONB_BUILD_ARRAY('#eval', condition)
                        ) AS calls,
                        CASE WHEN condition IS NULL OR yes IS NULL THEN 'if should have at least two arguments' END throws
                FROM    (SELECT args[0], args[1], args[2]) q_args (condition, yes, no)
                ) if ON (opcode = 'if')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN result IS NULL OR result IN (c_null, 'false'::JSONB) THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', no))
                        ELSE JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', yes))
                        END AS calls
                FROM    (SELECT args[0], args[1], args[2]) q_args (yes, no, result)
                ) if2 ON (opcode = '#if2')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN total > 1 THEN
                                JSONB_BUILD_ARRAY(
                                        current_frame - 1,
                                        JSONB_BUILD_ARRAY('#nop'),
                                        eval_frame
                                )
                        ELSE    JSONB_BUILD_ARRAY(eval_frame)
                        END AS calls
                FROM    (SELECT args['0'], JSONB_ARRAY_LENGTH(args)) AS q_args (next, total)
                CROSS JOIN LATERAL (SELECT JSONB_BUILD_ARRAY('#eval', COALESCE(next, c_null))) AS q_eval_frame (eval_frame)
                ) _do ON (opcode = 'do')
        LEFT JOIN LATERAL (SELECT  COALESCE(args[0], c_null) AS ret) quote ON (opcode = 'quote')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN NOT is_array THEN COALESCE(value, '[]'::JSONB)
                        WHEN is_array AND JSONB_ARRAY_LENGTH(value) = 0 THEN JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]')
                        END ret,
                        CASE
                        WHEN maybe_special = c_unquote THEN JSONB_BUILD_ARRAY(patched_frame, JSONB_BUILD_ARRAY('eval', form[1]))
                        WHEN maybe_special = c_splice_unquote THEN JSONB_BUILD_ARRAY(patched_frame, JSONB_BUILD_ARRAY('#splice'), JSONB_BUILD_ARRAY('eval', form[1]))
                        ELSE JSONB_BUILD_ARRAY(patched_frame, JSONB_BUILD_ARRAY(opcode, form))
                        END calls
                FROM    (SELECT args[0], args[0][0], args[0][0][0], COALESCE(JSONB_TYPEOF(args[0]) = 'array', FALSE)) q_args (value, form, maybe_special, is_array)
                CROSS JOIN LATERAL (SELECT current_frame #- '{1, 0}') q_patched_frame (patched_frame)
                ) quasiquote ON (opcode = 'quasiquote')
        LEFT JOIN LATERAL (SELECT JSONB_SET(stack - (-1), '{-1}', stack['-2'] || args['0']) AS new_stack) splice ON (opcode = '#splice')
        LEFT JOIN LATERAL (SELECT args AS ret) list ON (opcode = 'list')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(head) || list AS ret,
                        CASE WHEN is_list IS DISTINCT FROM TRUE THEN 'Second argument to cons should be a list' END AS throws
                FROM    (SELECT args['0'], args['1'], JSONB_TYPEOF(args['1']) = 'array') AS q_args (head, list, is_list)
                ) cons ON (opcode = 'cons')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN NOT has_non_arrays THEN
                                (
                                SELECT  JSONB_AGG(element ORDER BY arg_index, element_index)
                                FROM    JSONB_ARRAY_ELEMENTS(args) WITH ORDINALITY q_args (arg, arg_index)
                                CROSS JOIN LATERAL
                                        JSONB_ARRAY_ELEMENTS(arg) WITH ORDINALITY q_element (element, element_index)
                                )
                        END AS ret,
                        CASE WHEN has_non_arrays THEN 'All arguments to concat should be lists' END AS throws
                FROM    (
                        SELECT  COALESCE(BOOL_OR(JSONB_TYPEOF(arg) <> 'array'), FALSE)
                        FROM    JSONB_ARRAY_ELEMENTS(args) arg
                        ) q (has_non_arrays)
                ) _concat ON (opcode = 'concat')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(
                                JSONB_BUILD_ARRAY('#catch*', FALSE, env, exception_symbol, handler_body),
                                JSONB_BUILD_ARRAY('#eval', args[0])
                                ) AS calls,
                        CASE WHEN NOT COALESCE(catch_symbol #>> '{}' = 'catch*', FALSE) OR NOT COALESCE(JSONB_TYPEOF(exception_symbol) = 'string', FALSE) THEN
                                'Usage: (try* form (catch* exception handler_form))'
                        END AS throws
                FROM    (SELECT args[1][0] AS catch_symbol, args[1][1] AS exception_symbol, args[1][2] AS handler_body) q_args
                ) try ON (opcode = 'try*')
        LEFT JOIN LATERAL
                (
                SELECT  CASE caught WHEN 'false'::JSONB THEN args[4] END ret,
                        CASE
                        WHEN caught = 'false'::JSONB THEN NULL
                        WHEN can_tco THEN next_frames
                        ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', catch_env), FALSE)
                        END AS calls
                FROM    (SELECT args[0] caught, args[1] catch_env, args[2] exception_symbol, args[3] handler_body, args[4] value) q_args
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#eval', handler_body),
                                        JSONB_BUILD_ARRAY('#nop'),
                                        JSONB_BUILD_ARRAY('#set-env', exception_symbol, value),
                                        JSONB_BUILD_ARRAY('#push-env', catch_env)
                                )
                        ) q (next_frames)
                ) catch ON (opcode = '#catch*')
        LEFT JOIN LATERAL (SELECT) nop ON (opcode = '#nop')
        LEFT JOIN LATERAL (SELECT FORMAT('Invalid opcode: %s', callable) AS throws) invalid_opcode ON (opcode IS NULL)
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(add_heap.new_heap, next_reader.new_heap, fill_args.new_heap, set_env.new_heap, heap),
                        COALESCE(throw.new_stack, splice.new_stack),
                        COALESCE(push_env.new_env, pop_env.new_env, env),
                        COALESCE(
                                print.ret, _to_json.ret, read_input.ret,
                                pr_str.ret, read_form.ret, read_form2.ret, tokenize2.ret, add_heap.ret, next_reader.ret,
                                eval2.ret, fn.ret, macro.ret,
                                get_env.ret, math_ops.ret, eq.ret, pop_env.ret, set_env.ret,
                                quote.ret, cons.ret, list.ret, _concat.ret, quasiquote.ret, catch.ret
                                ),
                        COALESCE(
                                print.calls, tokenize.calls, tokenize2.calls, pr_str.calls, read_form.calls, read_form2.calls,
                                eval.calls, eval2.calls, fn_apply.calls, macro_apply.calls,
                                push_env.calls, let.calls, let2.calls, def.calls, defmacro.calls, if.calls, if2.calls, _do.calls,
                                quasiquote.calls, try.calls, catch.calls),
                        COALESCE(
                                tokenize.throws, get_env.throws, read_form.throws, read_form2.throws, fn.throws, math_ops.throws, let2.throws,
                                let.throws, def.throws, defmacro.throws, macro.throws, if.throws, cons.throws, _concat.throws, try.throws,
                                invalid_opcode.throws),
                        COALESCE(print.new_output)
                ) rets (new_heap, new_stack, new_env, ret, calls, throws, new_output)
        CROSS JOIN LATERAL
                (
                SELECT  rets.new_heap,
                        COALESCE(
                                rets.new_stack,
                                CASE
                                WHEN rets.throws IS NOT NULL THEN
                                        stack || JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('throw', JSONB_BUILD_OBJECT('t', 'str', 'v', rets.throws)))
                                END,
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)
                        ) AS new_stack,
                        rets.new_env,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  output, variables
FROM    loop
CROSS JOIN LATERAL (SELECT STRING_AGG(key, ', ') FROM JSONB_OBJECT_KEYS(heap[0][1]) key) q (variables)
WHERE   output IS NOT NULL

The read-print-eval sequence runs in a loop defined in Mal itself. In addition, the default environment is free from runtime pollution. All the side effects from the bootstrapping code have been swept under the rug, and the default environment remains nice and pristine.

New Year code

This implementation of Mal is, of course, far from being complete. Its default environment lacks library functions, and it's far from being able to self-host. However, we can still use it for pretty powerful computations.

As it turns out, 2026 is a happy number. It means that if we take all its digits, sum their squares, and repeat this procedure, eventually we will arrive at the number 1.

Let's write a Mal program that proves this fact. Before that, we'll need to add the definitions of the functions map and any into the REPL environment. Fortunately, by this moment, it's easy to do in Mal itself.

Here are the definitions of map and any:

(def! map
  (let* ()
    (do
      (def! _map
        (fn* (fn source result)
          (if (empty? source)
            result
            (_map fn (rest source) (concat result (list (fn (first source))))))))
      (fn* (fn source) (_map fn source ())))))
(def! any
  (fn* (predicate source)
    (if (empty? source)
      false
      (if (predicate (first source))
        true
        (any predicate (rest source))))))

And here's the code of the program that takes a number and tells if it's happy or not:

(do
  (def! square (fn* (x) (* x x)))
  (def! sum-square-digits
    (fn* (x)
      (+
        (square (% x 10))
        (if (> x 9)
          (sum-square-digits (floor (/ x 10)))
          0))))
  (def! is-happy-number
    (let* ()
      (do
        (def! _is-happy-number
          (fn* (x chain)
            (let* (next (sum-square-digits x) next-chain (concat chain (list next)))
              (if (= 1 next)
                (list true next-chain)
                (if (any (fn* (x) (= next x)) chain)
                  (list false next-chain)
                  (_is-happy-number next next-chain))))))
        (fn* (x) (_is-happy-number x (list x))))))
  (let* (number 2026
         result
         (is-happy-number number)
         happy
         (first result)
         chain
         (first (rest result)))
    (|| (pr-str number) " is " (if happy "a happy" "an unhappy") " number: " (pr-str chain))))

Let's run the program in our SQL implemenation of Mal:

WITH    RECURSIVE
        constants AS
        (
        SELECT  ARRAY[
                'tokenize', 'print', 'to-json', 'read-input', 'read-form', 'throw', 'eval', 'list', 'cons', 'concat', 'pr-str', '||',
                'first', 'rest',
                'empty?',
                '=', '+', '-', '*', '/', '%', '>', '<', 'floor', 'ceiling'] AS builtin_functions,
                ARRAY['fn*', 'def!', 'let*', 'if', 'do', 'quote', 'quasiquote', 'defmacro!', 'try*'] AS special_forms,
                ARRAY['(', ')', '[', ']', '{', '}', '''', '`', '~', '~@'] AS symbols,
                TO_JSONB('('::TEXT) AS c_open_paren, TO_JSONB(')'::TEXT) AS c_closed_paren,
                TO_JSONB('['::TEXT) AS c_open_bracket, TO_JSONB(']'::TEXT) AS c_closed_bracket,
                TO_JSONB('{'::TEXT) AS c_open_curly, TO_JSONB('}'::TEXT) AS c_closed_curly,
                TO_JSONB('unquote'::TEXT) AS c_unquote, TO_JSONB('splice-unquote'::TEXT) AS c_splice_unquote,
                'null'::JSONB AS c_null, '{"t": "eof"}'::JSONB AS c_eof,
                '{"''": "quote", "`": "quasiquote", "~": "unquote", "~@": "splice-unquote"}'::JSONB AS c_reader_macros
        ),
        bootstrap (code, input) AS
        (
        SELECT  '
(do
  (def! map
    (let* ()
      (do
        (def! _map
          (fn* (fn source result)
            (if (empty? source)
              result
              (_map fn (rest source) (concat result (list (fn (first source))))))))
        (fn* (fn source) (_map fn source ())))))
  (def! any
    (fn* (predicate source)
      (if (empty? source)
        false
        (if (predicate (first source))
          true
          (any predicate (rest source))))))
  ((let* ()
      (do
        (def! reader (tokenize (read-input)))
        (def! read
          (fn* () (read-form reader)))
        (defmacro! repl
          (fn* ()
            (do
              (def! form (read))
              (if (= eof form)
                eof
                `(do
                  (print(try* ~form (catch* exception exception)))
                  (~repl))))))))))
        ',
        '
(do
  (def! square (fn* (x) (* x x)))
  (def! sum-square-digits
    (fn* (x)
      (+
        (square (% x 10))
        (if (> x 9)
          (sum-square-digits (floor (/ x 10)))
          0))))
  (def! is-happy-number
    (let* ()
      (do
        (def! _is-happy-number
          (fn* (x chain)
            (let* (next (sum-square-digits x) next-chain (concat chain (list next)))
              (if (= 1 next)
                (list true next-chain)
                (if (any (fn* (x) (= next x)) chain)
                  (list false next-chain)
                  (_is-happy-number next next-chain))))))
        (fn* (x) (_is-happy-number x (list x))))))
  (let* (number 2026
         result
         (is-happy-number number)
         happy
         (first result)
         chain
         (first (rest result)))
    (|| (pr-str number) " is " (if happy "a happy" "an unhappy") " number: " (pr-str chain))))
        '
        ),
        loop (heap, stack, env, output, step) AS
        (
        SELECT  '[[null, {"eof": {"t": "eof"}}]]'::JSONB,
                JSONB_INSERT('[["eval"], ["read-form"], ["tokenize"]]'::JSONB, '{-1, -1}', (SELECT JSONB_BUILD_OBJECT('t', 'str', 'v', TO_JSONB(code)) FROM bootstrap), TRUE),
                0, NULL::TEXT, 1
        FROM    constants
        UNION ALL
        SELECT  new.*, step + 1
        FROM    loop
        CROSS JOIN constants
        CROSS JOIN LATERAL (SELECT stack #> '{-1, 0}', JSONB_PATH_QUERY_ARRAY(stack, '$[last][1 to last]'), stack['-1'], stack #>> '{-2, 0}' = '#pop-env') q_call (callable, args, current_frame, can_tco)
        CROSS JOIN LATERAL
                (
                SELECT  CASE
                        WHEN JSONB_TYPEOF(callable) = 'string' THEN callable #>> '{}'
                        WHEN callable ->> 't' = 'fn*' THEN '#fn-apply'
                        WHEN callable ->> 't' = 'macro' THEN '#macro-apply'
                        END
                ) q_opcode (opcode)
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#tokenize', args[0])) AS calls,
                        CASE WHEN (args #>> '{0, t}' = 'str') IS DISTINCT FROM TRUE THEN 'Usage: (tokenize string)' END AS throws
                ) tokenize ON (opcode = 'tokenize')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN args[1] IS NOT NULL THEN JSONB_BUILD_OBJECT('t', 'reader', 'v', args[1]) END AS ret,
                        CASE WHEN args[1] IS NULL THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#add-heap', JSONB_BUILD_ARRAY(0, tokens))) END AS calls
                FROM    (
                        SELECT  COALESCE(JSONB_AGG(TO_JSONB(token) ORDER BY index), '[]'::JSONB)
                        FROM    REGEXP_MATCHES(args #>> '{0, v}', '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}(''"`~^,;)]*)', 'gm') WITH ORDINALITY AS q (match, index)
                        CROSS JOIN LATERAL (SELECT match[1]) q_token (token)
                        WHERE   token > '' AND NOT token ^@ ';'
                        ) q_tokens (tokens)
                ) tokenize2 ON (opcode = '#tokenize')
        LEFT JOIN LATERAL (SELECT JSONB_BUILD_OBJECT('t', 'str', 'v', TO_JSONB(input)) AS ret FROM bootstrap) read_input ON (opcode = 'read-input')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN is_string THEN c_null END AS ret,
                        CASE WHEN is_string THEN args #>> '{0, v}' END new_output,
                        CASE WHEN NOT is_string THEN JSONB_BUILD_ARRAY(JSON_BUILD_ARRAY(opcode), JSONB_BUILD_ARRAY('#pr-str', COALESCE(args[0], c_null))) END AS calls
                FROM    (SELECT COALESCE(args #>> '{0, t}' = 'str', FALSE)) q (is_string)
                ) print ON (opcode = 'print')
        LEFT JOIN LATERAL (SELECT TO_JSONB(args['0']::TEXT) AS ret) _to_json ON (opcode = 'to-json')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_OBJECT('t', 'str', 'v', COALESCE(STRING_AGG(arg ->> 'v', '' ORDER BY index), '')) AS ret
                FROM    JSONB_ARRAY_ELEMENTS(args) WITH ORDINALITY q_args (arg, index)
                ) str_concat ON (opcode = '||')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#pr-str', args[0])) calls
                ) pr_str ON (opcode = 'pr-str')
        LEFT JOIN LATERAL
                (
                SELECT  *,
                        CASE
                        WHEN type = 'array' AND JSONB_ARRAY_LENGTH(value) > 0 THEN NULL
                        ELSE JSONB_BUILD_OBJECT('t', 'str', 'v', TO_JSONB(
                                CASE
                                WHEN type IN ('number', 'boolean') THEN value::TEXT
                                WHEN type = 'string' THEN value #>> '{}'
                                WHEN type = 'null' THEN 'nil'
                                WHEN complex_type = 'str' THEN (value -> 'v')::TEXT
                                WHEN type = 'array' AND JSONB_ARRAY_LENGTH(value) = 0 THEN
                                (
                                SELECT  '(' || COALESCE(STRING_AGG(element #>> '{v}', ' ' ORDER BY index), '') || ')'
                                FROM    JSONB_ARRAY_ELEMENTS(rest) WITH ORDINALITY q (element, index)
                                )
                                WHEN complex_type IS NOT NULL THEN FORMAT('#<%s>', complex_type)
                                ELSE 'Unprintable value'
                                END))
                        END
                        AS ret,
                        CASE WHEN type = 'array' AND JSONB_ARRAY_LENGTH(value) > 0 THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#pr-str', value['0'])) END AS calls
                FROM    (SELECT args[0], JSONB_TYPEOF(args[0]), args[0] ->> 't', JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]')) q (value, type, complex_type, rest)
                ) pr_str2 ON (opcode = '#pr-str')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN catch_index IS NOT NULL THEN
                                JSONB_PATH_QUERY_ARRAY(stack, '$[0 to $index - 1]', JSONB_BUILD_OBJECT('index', catch_index)) ||
                                JSONB_BUILD_ARRAY(JSONB_SET(stack[catch_index], '{1}', 'true'::JSONB) || COALESCE(args[0], c_null))
                        ELSE JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('print', args[0]))
                        END
                        AS new_stack
                FROM    (SELECT) q
                LEFT JOIN LATERAL
                        (
                        SELECT  index::INT - 1
                        FROM    JSONB_ARRAY_ELEMENTS(stack) WITH ORDINALITY q_frames (frame, index)
                        WHERE   (frame ->> 0) = '#catch*'
                        ORDER BY
                                index DESC
                        LIMIT 1
                        ) q_catch_index (catch_index) ON TRUE
                ) throw ON (opcode = 'throw')
        LEFT JOIN LATERAL
                (
                SELECT  new_heap, TO_JSONB(JSONB_ARRAY_LENGTH(new_heap) - 1) ret
                FROM    (SELECT JSONB_INSERT(heap, '{-1}', args[0], TRUE)) AS q_heap (new_heap)
                ) add_heap ON (opcode = '#add-heap')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN value IS NULL THEN c_eof
                        WHEN value = 'nil' THEN c_null
                        WHEN value ~ '^[-+]?\d+' OR value IN ('true', 'false') THEN value::JSONB
                        WHEN value ^@ '"' THEN JSONB_BUILD_OBJECT('t', 'str', 'v', value::JSONB)
                        ELSE TO_JSONB(value)
                        END AS ret,
                        CASE WHEN value IS NOT NULL THEN JSONB_SET(heap, ARRAY[reader_ptr, '0'], TO_JSONB(position + 1)) END AS new_heap
                FROM    (SELECT args['0']) AS q_reader_ref (reader_ref)
                CROSS JOIN LATERAL (SELECT reader_ref ->> 'v') AS q_reader_ptr (reader_ptr)
                CROSS JOIN LATERAL (SELECT heap[reader_ptr]) q_reader (reader)
                CROSS JOIN LATERAL (SELECT CASE WHEN JSONB_TYPEOF(reader['0']) = 'number' THEN (reader['0'] #> '{}')::INT END) q_position (position)
                CROSS JOIN LATERAL (SELECT reader['1'] ->> position) AS q_value (value)
                ) next_reader ON (opcode = '#next-reader')
        LEFT JOIN LATERAL
                (
                SELECT  ret,
                        CASE WHEN ret IS NULL THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#read-form', reader_ref)) END AS calls,
                        CASE
                        WHEN (reader_ref ->> 't') = 'reader' IS DISTINCT FROM TRUE THEN 'Invalid reader reference'
                        WHEN ret #>> '{}' IN (')', ']', '}') THEN 'Unbalanced parens'
                        END AS throws
                FROM    (SELECT  args[0], args[1]) q_args (reader_ref, ret)
                ) read_form ON (opcode = 'read-form')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN calls IS NOT NULL THEN NULL
                        WHEN is_open_paren AND is_closed_paren THEN chunk
                        WHEN is_open_bracket AND is_closed_bracket THEN JSONB_BUILD_OBJECT('t', 'vec', 'v', chunk)
                        WHEN is_open_curly AND is_closed_curly AND JSONB_ARRAY_LENGTH(chunk) % 2 = 0 THEN
                                (
                                SELECT  JSONB_BUILD_OBJECT('t', 'map', 'v', COALESCE(JSONB_OBJECT_AGG(key #>> '{}', value), '{}'::JSONB))
                                FROM    JSONB_ARRAY_ELEMENTS(chunk) WITH ORDINALITY keys (key, index)
                                JOIN    JSONB_ARRAY_ELEMENTS(chunk) WITH ORDINALITY values (value, index)
                                ON      values.index = keys.index + 1
                                WHERE   keys.index % 2 = 1
                                )
                        WHEN NOT is_open THEN first_token
                        END AS ret,
                        calls,
                        CASE
                        WHEN (is_open AND is_eof) OR
                             (is_closed AND (
                                     (is_open_paren AND NOT is_closed_paren) OR
                                     (is_open_bracket AND NOT is_closed_bracket) OR
                                     (is_open_curly AND NOT is_closed_curly)
                                     )) THEN 'Unbalanced parens'
                        WHEN is_open_curly AND NOT is_closed_curly AND JSONB_ARRAY_LENGTH(chunk) % 2 = 1 AND JSONB_TYPEOF(chunk[-1]) <> 'string' THEN
                                FORMAT('Cannot use token "%s" as a map key', last_token)
                        END AS throws
                FROM    (SELECT  args[0] reader_ref, args[1] first_token, args[-1] last_token, JSONB_PATH_QUERY_ARRAY(args, '$[2 to last - 1]') chunk) q_tokens
                CROSS JOIN LATERAL
                        (
                        SELECT  COALESCE(first_token = c_open_paren, FALSE) is_open_paren,
                                COALESCE(last_token = c_closed_paren, FALSE) is_closed_paren,
                                COALESCE(first_token = c_open_bracket, FALSE) is_open_bracket,
                                COALESCE(last_token = c_closed_bracket, FALSE) is_closed_bracket,
                                COALESCE(first_token = c_open_curly, FALSE) is_open_curly,
                                COALESCE(last_token = c_closed_curly, FALSE) is_closed_curly,
                                COALESCE(last_token = c_eof, FALSE) is_eof,
                                c_reader_macros ->> (first_token #>> '{}') reader_macro_form
                        ) q_state
                CROSS JOIN LATERAL
                        (
                        SELECT  is_open_paren OR is_open_curly OR is_open_bracket AS is_open,
                                is_closed_paren OR is_closed_curly OR is_closed_bracket AS is_closed
                        ) q_state2
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN first_token IS NULL THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#next-reader', reader_ref))
                                WHEN is_open AND NOT (is_closed OR is_eof) THEN JSONB_BUILD_ARRAY(current_frame, JSONB_BUILD_ARRAY('#read-form', reader_ref))
                                WHEN reader_macro_form IS NOT NULL THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('list', reader_macro_form), JSONB_BUILD_ARRAY('#read-form', reader_ref))
                                END
                        ) q_calls (calls)
                ) read_form2 ON (opcode = '#read-form')
        LEFT JOIN LATERAL (SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', COALESCE(args[0], c_null))) AS calls) eval ON (opcode = 'eval')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN eval_calls IS NULL THEN eval_ast END AS ret,
                        eval_calls AS calls
                FROM    (SELECT args['0'], JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]')) q (eval_ast, eval_ret)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(eval_ast) = 'array', JSONB_TYPEOF(eval_ast) = 'string') q_array (ast_is_array, ast_is_symbol)
                CROSS JOIN LATERAL (SELECT CASE WHEN ast_is_array THEN JSONB_ARRAY_LENGTH(eval_ast) = 0 ELSE FALSE END, JSONB_ARRAY_LENGTH(eval_ret) = 0) q_empty (ast_array_empty, ret_empty)
                CROSS JOIN LATERAL
                        (
                        SELECT  COALESCE(eval_ast #>> '{0}' = ANY(special_forms), FALSE),
                                COALESCE(eval_ast #>> '{}' = ANY(builtin_functions), FALSE)
                        ) q_callable (is_special_form, is_builtin_function)
                CROSS JOIN LATERAL
                        (
                        SELECT  CASE
                                WHEN ret_empty AND is_special_form THEN JSONB_BUILD_ARRAY(eval_ast)
                                WHEN ast_is_array AND NOT ast_array_empty THEN JSONB_BUILD_ARRAY(current_frame #- '{1, 0}', JSONB_BUILD_ARRAY('#eval', eval_ast[0]))
                                WHEN ast_array_empty AND NOT ret_empty THEN JSONB_BUILD_ARRAY(eval_ret)
                                WHEN ast_is_symbol AND NOT is_builtin_function THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#get-env', eval_ast))
                                END
                        ) q_calls (eval_calls)
                ) eval2 ON (opcode = '#eval')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_OBJECT('t', 'fn*', 'v', JSONB_BUILD_ARRAY(env, args[0], COALESCE(args[1], c_null))) ret,
                        CASE
                        WHEN JSONB_TYPEOF(args[0]) <> 'array' OR EXISTS (SELECT FROM JSONB_ARRAY_ELEMENTS(args[0]) arg WHERE JSONB_TYPEOF(arg) <> 'string') THEN
                                'The first argument to fn* should be a list of symbols'
                        END throws
                ) fn ON (opcode = 'fn*')
        LEFT JOIN LATERAL
                (
                SELECT  ret,
                        CASE WHEN ret IS NULL THEN FORMAT('Error applying operator: (%s %s %s)', opcode, args -> 0, args -> 1) END AS throws
                FROM    (
                        SELECT  CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0) END::DOUBLE PRECISION,
                                CASE WHEN JSONB_TYPEOF(args['1']) = 'number' THEN (args ->> 1) END::DOUBLE PRECISION
                        ) q_args (arg1, arg2)
                LEFT JOIN LATERAL
                        (
                        SELECT  TO_JSONB(
                                CASE opcode
                                WHEN '+' THEN TO_JSONB(arg1 + arg2)
                                WHEN '-' THEN TO_JSONB(arg1 - arg2)
                                WHEN '*' THEN TO_JSONB(arg1 * arg2)
                                WHEN '/' THEN TO_JSONB(arg1 / arg2)
                                WHEN '>' THEN TO_JSONB(arg1 > arg2)
                                WHEN '<' THEN TO_JSONB(arg1 < arg2)
                                WHEN '%' THEN TO_JSONB(arg1::INT % arg2::INT)
                                WHEN 'floor' THEN TO_JSONB(FLOOR(arg1))
                                WHEN 'ceiling' THEN TO_JSONB(CEILING(arg1))
                                END
                                )
                        ) q_ret (ret) ON TRUE
                ) math_ops ON (opcode IN ('+', '-', '*', '/', '%', '>', '<', 'floor', 'ceiling'))
        LEFT JOIN LATERAL
                (
                SELECT  TO_JSONB(COALESCE(args[0] = args[1], FALSE)) AS ret
                ) eq ON (opcode = '=')
        LEFT JOIN LATERAL
                (
                SELECT  CASE WHEN can_tco THEN next_frames ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', env), FALSE) END AS calls
                FROM    (SELECT CASE WHEN callable ->> 't' = 'fn*' THEN (callable #>> '{v, 0}') END::INT) AS q_call_args (call_env)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#eval', callable #> '{v, 2}'),
                                        JSONB_BUILD_ARRAY('#fill-args', callable #> '{v, 1}', args),
                                        JSONB_BUILD_ARRAY('#push-env', call_env)
                                )
                        ) AS q_next_frames (next_frames)
                ) fn_apply ON (callable ->> 't' = 'fn*')
        LEFT JOIN LATERAL (SELECT JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval'), JSONB_SET(current_frame, '{0, t}', TO_JSONB('fn*'::TEXT))) AS calls) macro_apply ON (callable ->> 't' = 'macro')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        CASE WHEN value IS NULL THEN FORMAT('Variable %s not found', key) END AS throws
                FROM    (SELECT args ->> 0) AS q_key (key)
                LEFT JOIN LATERAL
                        (
                        WITH    RECURSIVE get (current_env) AS
                                (
                                SELECT  heap -> env
                                UNION ALL
                                SELECT  heap -> (current_env ->> 0)::INT
                                FROM    get
                                WHERE   current_env IS NOT NULL
                                )
                        SELECT  vals -> key
                        FROM    get
                        CROSS JOIN LATERAL (SELECT current_env -> 1) q (vals)
                        WHERE   vals ? key
                        LIMIT   1
                        ) AS env_value (value) ON TRUE
                ) get_env ON (opcode = '#get-env')
        LEFT JOIN LATERAL
                (
                SELECT  value AS ret,
                        JSONB_SET(heap, ARRAY[env::TEXT, 1::TEXT, key], value, TRUE) AS new_heap
                FROM    (SELECT args ->> 0, args['1']) q (key, value)
                ) set_env ON (opcode = '#set-env')
        LEFT JOIN LATERAL
                (
                SELECT  new_env,
                        CASE
                        WHEN new_env IS NULL THEN
                                JSONB_BUILD_ARRAY(
                                        current_frame,
                                        JSONB_BUILD_ARRAY('#add-heap', JSONB_BUILD_ARRAY(old_env, JSONB_BUILD_OBJECT()))
                                )
                        END AS calls
                FROM    (
                        SELECT  CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0)::DECIMAL::INT END,
                                CASE WHEN JSONB_TYPEOF(args['1']) = 'number' THEN (args ->> 1)::DECIMAL::INT END
                        ) q_args (old_env, new_env)
                ) push_env ON (opcode = '#push-env')
        LEFT JOIN LATERAL (SELECT CASE WHEN JSONB_TYPEOF(args['0']) = 'number' THEN (args ->> 0)::DECIMAL::INT END new_env, args['1'] ret) pop_env ON (opcode = '#pop-env')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_SET(heap, ARRAY[env::TEXT, 1::TEXT], env_data || new_data) AS new_heap
                FROM    (
                        SELECT  CASE WHEN opcode = '#fill-args' AND JSONB_TYPEOF(args['0']) = 'array' THEN args[0] END,
                                CASE WHEN opcode = '#fill-args' AND JSONB_TYPEOF(args['1'])  = 'array' THEN args[1] END
                        ) q_args (keys, values)
                CROSS JOIN LATERAL (SELECT heap[env::TEXT]['1']) q_env_data (env_data)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_OBJECT_AGG(key #>> '{}', COALESCE(value, c_null) ORDER BY index)
                        FROM    JSONB_ARRAY_ELEMENTS(keys) WITH ORDINALITY q_keys (key, index)
                        LEFT JOIN
                                JSONB_ARRAY_ELEMENTS(values) WITH ORDINALITY q_values (value, index)
                        USING   (index)
                        ) q_new_data (new_data)
                ) fill_args ON (opcode = '#fill-args')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN can_tco THEN next_frames
                        ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', env), FALSE)
                        END AS calls,
                        CASE
                        WHEN NOT vars_is_array THEN 'The first argument to let* should be a list'
                        WHEN body IS NULL THEN 'There should be two arguments to let*'
                        END AS throws
                FROM    (SELECT args['0'] IS NOT NULL AND JSONB_TYPEOF(args['0']) = 'array', args['0'], args['1']) q_vars_array (vars_is_array, vars, body)
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#let*', vars, body),
                                        JSONB_BUILD_ARRAY('#push-env', env)
                                )
                        ) q_next_frames (next_frames)
                ) let ON (opcode = 'let*')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN vars_is_array AND JSONB_ARRAY_LENGTH(vars) = 0 THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', body))
                        ELSE JSONB_BUILD_ARRAY(
                                JSONB_SET(current_frame, '{1}', JSONB_PATH_QUERY_ARRAY(vars, '$[2 to last]')),
                                JSONB_BUILD_ARRAY('#set-env', key),
                                JSONB_BUILD_ARRAY('#eval', value)
                        )
                        END AS calls,
                        CASE WHEN JSONB_TYPEOF(key) <> 'string' THEN 'let*: variable names should be symbols' END AS throws
                FROM    (SELECT args[0], args[1]) q_vars_body (vars, body)
                CROSS JOIN LATERAL (SELECT JSONB_TYPEOF(vars) = 'array', vars[0], COALESCE(vars[1], c_null)) q_key_value (vars_is_array, key, value)
                ) let2 ON (opcode = '#let*')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#set-env', key), JSONB_BUILD_ARRAY('#eval', value)) AS calls,
                        CASE
                        WHEN (JSONB_TYPEOF(key) = 'string') IS DISTINCT FROM TRUE THEN 'def!: variable name should be a symbol'
                        WHEN value IS NULL THEN 'def!: value should be provided'
                        END AS throws
                FROM    (SELECT args[0], args[1]) q_vars (key, value)
                ) def ON (opcode = 'def!')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#set-env', key), JSONB_BUILD_ARRAY('#fn-to-macro'), JSONB_BUILD_ARRAY('#eval', value)) AS calls,
                        CASE
                        WHEN JSONB_TYPEOF(key) = 'string' IS DISTINCT FROM TRUE THEN 'defmacro!: variable name should be a symbol'
                        END AS throws
                FROM    (SELECT args[0], args[1]) q_vars (key, value)
                ) defmacro ON (opcode = 'defmacro!')
        LEFT JOIN LATERAL
                (
                SELECT  CASE args #>> '{0, t}'
                        WHEN 'macro' THEN args[0]
                        WHEN 'fn*' THEN JSONB_SET(args[0], '{t}', TO_JSONB('macro'::TEXT), FALSE)
                        END AS ret,
                        CASE
                        WHEN NOT COALESCE(args #>> '{0, t}' IN ('fn*', 'macro'), FALSE) THEN 'defmacro!: the second argument should evaluate to a function or a macro'
                        END AS throws
                ) macro ON (opcode = '#fn-to-macro')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(
                                JSONB_BUILD_ARRAY('#if2', yes, COALESCE(no, c_null)),
                                JSONB_BUILD_ARRAY('#eval', condition)
                        ) AS calls,
                        CASE WHEN condition IS NULL OR yes IS NULL THEN 'if should have at least two arguments' END throws
                FROM    (SELECT args[0], args[1], args[2]) q_args (condition, yes, no)
                ) if ON (opcode = 'if')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN result IS NULL OR result IN (c_null, 'false'::JSONB) THEN JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', no))
                        ELSE JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('#eval', yes))
                        END AS calls
                FROM    (SELECT args[0], args[1], args[2]) q_args (yes, no, result)
                ) if2 ON (opcode = '#if2')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN total > 1 THEN
                                JSONB_BUILD_ARRAY(
                                        current_frame - 1,
                                        JSONB_BUILD_ARRAY('#nop'),
                                        eval_frame
                                )
                        ELSE    JSONB_BUILD_ARRAY(eval_frame)
                        END AS calls
                FROM    (SELECT args['0'], JSONB_ARRAY_LENGTH(args)) AS q_args (next, total)
                CROSS JOIN LATERAL (SELECT JSONB_BUILD_ARRAY('#eval', COALESCE(next, c_null))) AS q_eval_frame (eval_frame)
                ) _do ON (opcode = 'do')
        LEFT JOIN LATERAL (SELECT  COALESCE(args[0], c_null) AS ret) quote ON (opcode = 'quote')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN NOT is_array THEN COALESCE(value, '[]'::JSONB)
                        WHEN is_array AND JSONB_ARRAY_LENGTH(value) = 0 THEN JSONB_PATH_QUERY_ARRAY(args, '$[1 to last]')
                        END ret,
                        CASE
                        WHEN maybe_special = c_unquote THEN JSONB_BUILD_ARRAY(patched_frame, JSONB_BUILD_ARRAY('eval', form[1]))
                        WHEN maybe_special = c_splice_unquote THEN JSONB_BUILD_ARRAY(patched_frame, JSONB_BUILD_ARRAY('#splice'), JSONB_BUILD_ARRAY('eval', form[1]))
                        ELSE JSONB_BUILD_ARRAY(patched_frame, JSONB_BUILD_ARRAY(opcode, form))
                        END calls
                FROM    (SELECT args[0], args[0][0], args[0][0][0], COALESCE(JSONB_TYPEOF(args[0]) = 'array', FALSE)) q_args (value, form, maybe_special, is_array)
                CROSS JOIN LATERAL (SELECT current_frame #- '{1, 0}') q_patched_frame (patched_frame)
                ) quasiquote ON (opcode = 'quasiquote')
        LEFT JOIN LATERAL (SELECT JSONB_SET(stack - (-1), '{-1}', stack['-2'] || args['0']) AS new_stack) splice ON (opcode = '#splice')
        LEFT JOIN LATERAL (SELECT args AS ret) list ON (opcode = 'list')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(head) || list AS ret,
                        CASE WHEN is_list IS DISTINCT FROM TRUE THEN 'Second argument to cons should be a list' END AS throws
                FROM    (SELECT args['0'], args['1'], JSONB_TYPEOF(args['1']) = 'array') AS q_args (head, list, is_list)
                ) cons ON (opcode = 'cons')
        LEFT JOIN LATERAL
                (
                SELECT  CASE
                        WHEN NOT has_non_arrays THEN
                                (
                                SELECT  JSONB_AGG(element ORDER BY arg_index, element_index)
                                FROM    JSONB_ARRAY_ELEMENTS(args) WITH ORDINALITY q_args (arg, arg_index)
                                CROSS JOIN LATERAL
                                        JSONB_ARRAY_ELEMENTS(arg) WITH ORDINALITY q_element (element, element_index)
                                )
                        END AS ret,
                        CASE WHEN has_non_arrays THEN 'All arguments to concat should be lists' END AS throws
                FROM    (
                        SELECT  COALESCE(BOOL_OR(JSONB_TYPEOF(arg) <> 'array'), FALSE)
                        FROM    JSONB_ARRAY_ELEMENTS(args) arg
                        ) q (has_non_arrays)
                ) _concat ON (opcode = 'concat')
        LEFT JOIN LATERAL
                (
                SELECT  JSONB_BUILD_ARRAY(
                                JSONB_BUILD_ARRAY('#catch*', FALSE, env, exception_symbol, handler_body),
                                JSONB_BUILD_ARRAY('#eval', args[0])
                                ) AS calls,
                        CASE WHEN NOT COALESCE(catch_symbol #>> '{}' = 'catch*', FALSE) OR NOT COALESCE(JSONB_TYPEOF(exception_symbol) = 'string', FALSE) THEN
                                'Usage: (try* form (catch* exception handler_form))'
                        END AS throws
                FROM    (SELECT args[1][0] AS catch_symbol, args[1][1] AS exception_symbol, args[1][2] AS handler_body) q_args
                ) try ON (opcode = 'try*')
        LEFT JOIN LATERAL
                (
                SELECT  CASE caught WHEN 'false'::JSONB THEN args[4] END ret,
                        CASE
                        WHEN caught = 'false'::JSONB THEN NULL
                        WHEN can_tco THEN next_frames
                        ELSE JSONB_INSERT(next_frames, '{0}', JSONB_BUILD_ARRAY('#pop-env', catch_env), FALSE)
                        END AS calls
                FROM    (SELECT args[0] caught, args[1] catch_env, args[2] exception_symbol, args[3] handler_body, args[4] value) q_args
                CROSS JOIN LATERAL
                        (
                        SELECT  JSONB_BUILD_ARRAY(
                                        JSONB_BUILD_ARRAY('#eval', handler_body),
                                        JSONB_BUILD_ARRAY('#nop'),
                                        JSONB_BUILD_ARRAY('#set-env', exception_symbol, value),
                                        JSONB_BUILD_ARRAY('#push-env', catch_env)
                                )
                        ) q (next_frames)
                ) catch ON (opcode = '#catch*')
        LEFT JOIN LATERAL (SELECT COALESCE(args[0][0], c_null) AS ret) first ON (opcode = 'first')
        LEFT JOIN LATERAL (SELECT JSONB_PATH_QUERY_ARRAY(args[0], '$[1 to last]') AS ret) rest ON (opcode = 'rest')
        LEFT JOIN LATERAL
                (
                SELECT  TO_JSONB(
                                CASE opcode
                                WHEN 'empty?' THEN NOT COALESCE(JSONB_TYPEOF(args[0]) = 'array' AND JSONB_ARRAY_LENGTH(args[0]) > 0, FALSE)
                                END
                        ) AS ret
                ) checks ON (opcode IN ('empty?'))
        LEFT JOIN LATERAL (SELECT) nop ON (opcode = '#nop')
        LEFT JOIN LATERAL (SELECT FORMAT('Invalid opcode: %s', callable) AS throws) invalid_opcode ON (opcode IS NULL)
        CROSS JOIN LATERAL
                (
                SELECT  COALESCE(add_heap.new_heap, next_reader.new_heap, fill_args.new_heap, set_env.new_heap, heap),
                        COALESCE(throw.new_stack, splice.new_stack),
                        COALESCE(push_env.new_env, pop_env.new_env, env),
                        COALESCE(
                                print.ret, _to_json.ret, read_input.ret,
                                str_concat.ret, pr_str2.ret, read_form.ret, read_form2.ret, tokenize2.ret, add_heap.ret, next_reader.ret,
                                eval2.ret, fn.ret, macro.ret,
                                get_env.ret, math_ops.ret, eq.ret, pop_env.ret, set_env.ret,
                                quote.ret, cons.ret, list.ret, _concat.ret, quasiquote.ret, catch.ret,
                                first.ret, rest.ret, checks.ret
                                ),
                        COALESCE(
                                print.calls, tokenize.calls, tokenize2.calls, pr_str.calls, pr_str2.calls, read_form.calls, read_form2.calls,
                                eval.calls, eval2.calls, fn_apply.calls, macro_apply.calls,
                                push_env.calls, let.calls, let2.calls, def.calls, defmacro.calls, if.calls, if2.calls, _do.calls,
                                quasiquote.calls, try.calls, catch.calls),
                        COALESCE(
                                tokenize.throws, get_env.throws, read_form.throws, read_form2.throws, fn.throws, math_ops.throws, let2.throws,
                                let.throws, def.throws, defmacro.throws, macro.throws, if.throws, cons.throws, _concat.throws, try.throws,
                                invalid_opcode.throws),
                        COALESCE(print.new_output)
                ) rets (new_heap, new_stack, new_env, ret, calls, throws, new_output)
        CROSS JOIN LATERAL
                (
                SELECT  rets.new_heap,
                        COALESCE(
                                rets.new_stack,
                                CASE
                                WHEN rets.throws IS NOT NULL THEN
                                        stack || JSONB_BUILD_ARRAY(JSONB_BUILD_ARRAY('throw', JSONB_BUILD_OBJECT('t', 'str', 'v', rets.throws)))
                                END,
                                JSONB_INSERT(stack - (-1), '{-1, -1}', rets.ret, TRUE),
                                (stack - (-1)) || COALESCE(rets.calls, '[]'::JSONB)
                        ) AS new_stack,
                        rets.new_env,
                        rets.new_output
                ) new
        WHERE   JSONB_ARRAY_LENGTH(stack) > 0
        )
SELECT  output, step
FROM    loop
WHERE   output IS NOT NULL

The program completes in 3685 cycles of our interpreter loop. And yes, 2026 is a happy number indeed!

I wish that your 2026 be as happy as this number!

You can find the queries in the GitHub repository: quassnoi/explain-extended-2026

Previous New Year posts:

• 2010: SQL graphics in Oracle, MySQL, SQL Server and PostgreSQL
• 2011: Drawing a clock in SQL
• 2012: Drawing snowflakes in SQL
• 2013: View of Earth from space in SQL
• 2014: Drawing fractals in SQL
• 2015: Composing music in SQL
• 2016: Conway’s Game of Life in SQL
• 2017: The Sultan’s Riddle in SQL
• 2018: Settlers of Catan in SQL
• 2019: GIF decoder in SQL
• 2020: A stereogram in SQL
• 2021: 3D picture of the coronavirus in SQL
• 2022: Quantum computer emulator in SQL
• 2023: Solving the Rubik’s Cube in SQL
• 2024: GPT in 500 lines of SQL
• 2025: Diffusion Model image generator in about 700 lines of pure SQL