Andrey Listopadov

Function that can be called a limited amount of times

Sat, 17 Sep 2022 22:39:00 +0300

Recently I’ve stumped upon a Reddit thread about defining a function that you can call a limited amount of times in Rust, with compile-time check, and I wondered if I can make the same thing in Clojure.

Here’s the code:

(defmacro def-n-times-fn
  [n name & fnspec]
  `(let [x# (atom ~n)            ; A compile-time counter.
         f# (fn ~name ~@fnspec)] ; The function object, that will be called at runtime.
     (defmacro ~name [& args#]   ; Generation of a new macro with the name of the function
                                 ; that will manage the counter.
       (when-not (pos? (deref x#)) ; And if the counter isn't greater than zero
         (throw                    ; an exception is thrown
          (ex-info ~(format "can't use `%s` more than %s times!" (str name) n) {})))
       (swap! x# dec)      ; otherwise, we decrement the counter
       (list* f# args#)))) ; and generate a call

So, this is a macro-generating macro! I’ll go into details in a bit, but let’s just appreciate the power of macros here. Not only we can run all kinds of code at compile time, but we can also use all features that we often rely on at runtime, like lexical scope and closures! And even though I wouldn’t really use a such macro in real code, I find the ability to do such things fascinating.

We can use the macro like this:

(def-n-times-fn 4
  vaiv [x]
  (println x))

It acts similarly to defn macro in Clojure, except instead of a function it generates a macro, named vaiv in this case, that will be later expanded to an actual function call. For example, we can wrap calls to it in a function, ensuring that the actual calls are delayed, and only compilation of these calls occurs. I’ve put all of this into a file foo.clj:

(ns foo)
;; ---8<---snip---8<---
;; (defmacro defn-n-times-fn ...)
;; (def-n-times-fn 4 ...)
;; ---8<---snap---8<---
(defn _ []
  (vaiv 1)
  (vaiv 2)
  (vaiv 3)
  (vaiv 4)
  (vaiv 5))

Now if we try to compile it, we’ll get an error:

$ clojure -M -e "(compile 'foo)"
Syntax error macroexpanding vaiv at (foo.clj:25:3).
can't use `vaiv` more than 4 times!

Nice! And if we comment out one of the calls to vaiv the compilation is successful:

$ clojure -M -e "(compile 'foo)"
foo

So what exactly happens here? If we macroexpand¹ the call to defn-n-times-fn we’ll see that it just generates a new vaiv macro and a function:

(let* [x__5686__auto__ (atom 4)
       f__5687__auto__ (fn vaiv [x] (println x))]
  (defmacro vaiv [& args__5688__auto__]
    (when-not (pos? @x__5686__auto__)
      (throw (ex-info "can't use `vaiv` more than 4 times!" {})))
    (swap! x__5686__auto__ dec)
    (list* f__5687__auto__ args__5688__auto__)))

So far nothing related to compile time usage checking happened just yet. This changes whenever later uses of vaiv itself expand to calls:

foo> (macroexpand '(vaiv 42))
(#function[foo/eval5694/vaiv--5695] 42)

There’s no check in the generated code either, because the check happened during the expansion of the macro, and is invisible to the user. Every expansion of the vaiv macro decrements the counter, and once we’ve expanded the code enough times it will fire an error.

Pretty simple! (If you can look past the meta-meta-programming, that is.)

Though, this comes with limitations, such that this function can’t be passed into other functions, like map or filter. Both because this is not actually a function, but a macro that expands to function call, and because it’s impossible to know at compile time how many times map will invoke this function.

There’s a way to outsmart the check by using any kind of loop:

(dotimes [i 5]
  (vaiv i))

This works, because from the macro-expansion standpoint there’s only one invocation:

foo> (clojure.walk/macroexpand-all '(dotimes [i 5] (vaiv i)))
(let* [n__6088__auto__ (long 5)]
  (loop* [i 0]
    (if (< i n__6088__auto__)
      (do (#function[foo/eval13775/vaiv--13776] i) ; (vaiv i)
          (recur (unchecked-inc i))))))

Nevertheless, this was an interesting exercise in writing macros.

I’ve slightly edited the output of macroexpand, mainly removing a lot of clojure.core/ prefixes for a more concise code. ↩︎

Comment via email

Wave Function Collapse Algorithm in ClojureScript

Tue, 10 May 2022 08:20:00 +0300

The last time I touched ClojureScript was almost two years ago. It was a really fun experience, and actually, it was a bit special to me personally. Prior to that post, I only learned lisp¹ via books and mostly used it only for configuring Emacs, and while I’ve liked the idea of code as data and other lisp aspects, I never did anything more with the language. So this was the first thing that I’ve done in lisp from start to finish, the first thing done in Clojure, the first interactive thing with some sort of visualizations. And this is pretty much the reason I fell in love with Clojure and not with another dialect - I’ve used it for something real, not just an exercise for the book, and I liked the syntax, the data structures, immutability, laziness, and other features. Since that post I’ve got a job in Clojure, so now it’s my primary programming language and I love it still. However, I have a lot less experience with ClojureScript, mainly because I mostly do backend development, and we have a separate team working on the frontend part.

I like games, but I’ve never actually done anything more than simple demos of various game algorithms and techniques². And I mostly did it in Fennel, because it’s also a very nice lisp-like language with a very similar syntax to Clojure. I wanted to do more, but I wanted these experiments to be a bit more reachable, and possibly viewed directly in my blog, as it was with the raycasting example. So I knew that I wanted to do something with ClojureScript instead of Fennel, which became my main language for this type of thing. Another reason is that I’m thinking about doing some frontend programming in ClojureScript in the upcoming years.

Luckily for me, not so long ago I found a really neat algorithm for generating worlds. The algorithm is called Wave Function Collapse, and it actually has nothing to do with quantum physics. In this post, I’ll try to walk you thru the algorithm, and explain how I’ve approached this problem.

The algorithm

What makes this algorithm different from most procedural generation algorithms I’ve read about is that it is extremely simple. It can generate images based on a small sample of data, as shown below:

Figure 1: Example Input

Figure 2: Generation result

However, just implementing the algorithm from some description isn’t fun. What I like to do, and this is a general approach I use for all my projects, is to get some assumptions about the thing I want to implement, and then do everything based on these assumptions only³. So instead of learning how the algorithm is implemented, I’ve just observed its behavior with simple input.

For example, let’s look again at the input sample, but let’s split it into tiles with a grid:

Figure 3: Sample

This sample specifies that for each tile on this image there are only so many possible neighbors. For example, this tile in the middle can only have one unique neighbor on each of its sides:

Other tiles may have two or more unique neighbors, and the job of the algorithm is to analyze each tile on the image, and track what neighboring cells it has, storing it into a ruleset. And an image is then generated based on these adjacency rules only.

This is basically what I knew about the algorithm when I started implementing it. Of course, it’s not that simple, but it’s still easy to grasp, and some nuances become apparent when you actually start working on it. I’ll give the algorithm a more comprehensive explanation a bit later, as we’ll encounter problems.

Text version of the algorithm

For this project, I once again picked shadow-cljs, so the project can be created with npx create-cljs-project wave-function-collapse. But before actually working with images we can begin with a bit simpler to debug version of it which deals with an ordinary text. This can be done in plain Clojure, but since we’ll later plug it into our page, let’s use .cljs file. We start by implementing our algorithm in the file wfc.cljs, wfc being short for wave function collapse.

As I’ve explained in the previous section, we start by transforming an input into a set of rules for the algorithm. Our input will be a two-dimensional matrix, in this case, an array of arrays of strings. Let’s start with a similar sample to that I’ve shown in the previous example:

(def coast
  [["🟫" "🟫" "🟫" "🟫"]
   ["🟩" "🟫" "🟫" "🟩"]
   ["🟦" "🟩" "🟩" "🟦"]
   ["🟦" "🟦" "🟦" "🟦"]])

It’s even simpler, as it doesn’t have tiles that represent corners. The first thing we need to do is to define a function, that gets all neighboring cells in all cardinal directions:

(defn get-neighbors [m x y]
  (->> {:up [(dec x) y]
        :down [(inc x) y]
        :left [x (dec y)]
        :right [x (inc y)]}
       (into {}
             (keep (fn [[dir pos]]
                     (when-some [cell (get-in m pos)]
                       [dir {:pos pos :cell cell}]))))))

This function gets only those cells inside our matrix and discards those that are outside of its boundaries. With this function we can write a function that builds a recipe from the input sample:

;; add [clojure.set :as set] to :require
(defn build-recipe [sample]
  (->> sample
       (map-indexed
        (fn [x r]
          (map-indexed
           (fn [y c]
             (let [neigbors (into {}
                                  (map (fn [[dir {:keys [cell]}]] [dir #{cell}]))
                                  (get-neighbors sample x y))]
               {c neigbors})) r)))
       flatten
       (apply merge-with #(merge-with set/union %1 %2))))

I’m using map-indexed because we need to get neighbors for each cell, and this is what our get-neighbors function accepts. Calling this function on the coast recipe yields the following map:

{"🟫" {:up #{"🟫"}
       :down #{"🟫" "🟩"}
       :left #{"🟩" "🟫"}
       :right #{"🟫" "🟩"}}
 "🟩" {:up #{"🟫"}
       :down #{"🟦"}
       :left #{"🟫" "🟦" "🟩"}
       :right #{"🟫" "🟦" "🟩"}}
 "🟦" {:up #{"🟩" "🟦"}
       :down #{"🟦"}
       :left #{"🟩" "🟦"}
       :right #{"🟦" "🟩"}}}

Now we have a proper illustration of the adjacency rules we’ve talked about before. With that, we can start implementing the algorithm itself.

Collapsing cells

In order to collapse anything, we need a world in which we’ll do our work. The beauty of this algorithm lies in the fact that it can work with a partially filled world, but generally, the world starts in a so-called superposition. To get this superposition, we need to analyze the input sample once again:

(defn get-superposition [sample]
  (into #{} (flatten sample)))

This gives us all possible variants for a single cell. To define a world we can just generate a new “empty” matrix that we’ll later populate with a cell superposition state.

(defn gen-world [max-x max-y]
  (mapv vec (for [_ (range max-x)]
              (for [_ (range max-y)] nil))))

(defn populate-world [world sample]
  (let [superpos (get-superposition sample)]
    (mapv (fn [r] (mapv (fn [c] (if (nil? c) superpos c)) r)) world)))

As the last preparation step, we need a way of checking if the world is fully built. This can be done by checking if any of the cells is still a hash-set and not a concrete value:

(defn done? [world]
  (not (some set? (flatten world))))

A more optimal way would be to track how many cells were fully collapsed and compare it with the world size to avoid walking the whole world repeatedly on each step, but for now, this will do. The last preparation step we need to do is to write a function that chooses which cell to collapse next. The first cell can be selected at random, but the following must be selected more carefully, or we’ll corner ourselves pretty quickly. To do that we need to measure world entropy and select a cell with the lowest one. Since every cell can only contain a set of unique elements, we can measure the entropy by counting the number of elements in a cell. Thus, a function that returns the lowest entropy cell can be defined as follows:

(defn lowest-entropy-cell [world]
  (let [enthropies (->> world
                        (map-indexed
                         (fn [x r]
                           (keep-indexed
                            (fn [y cell]
                              (when (set? cell)
                                [(count cell) [x y]])) r)))
                        (apply concat)
                        shuffle
                        (sort-by first))]
    (if-some [c (first enthropies)]
      (second c)
      [0 0])))

This will produce uniform distribution, so we might want to change it a bit later, but for now, it’ll do.

Now to the meat and bones of the algorithm. To actually collapse a cell we need a function that can choose a random element of a cell:

(defn collapse
  [world x y val]
  (if (and (coll? val)
           (= 1 (count val)))
    (assoc-in world [x y] (first val))
    (assoc-in world [x y] val)))

After the cell is collapsed, we need to constrain its neighbors, so their superposition only contained possible elements that can be connected to this cell. This is a bit harder part of the algorithm, as it involves waling a grid of cells recursively and constraining every cell that is a set and skipping others that are not. If a cell itself is a set, its content should be treated as a series of cells that also affect how the surrounding cells should be constrained:

(defn collapse-neighbors
  [world recipe x y]
  (let [cell (get-in world [x y])
        neighbors (get-neighbors world x y)
        neighboring-cells (shuffle (map :pos (vals neighbors))) ; ❶
        world' (reduce
                (fn [world [dir {[x' y' :as pos] :pos}]]
                  (let [c (get-in world pos) ; ❷
                        variants (set/intersection
                                  (if (coll? c) (set c) #{c})
                                  (if (set? cell)
                                    (apply set/union (map #(get-in recipe [% dir]) cell))
                                    (get-in recipe [cell dir])))] ; ❸
                    (if (and (set? c) (seq variants))
                      (collapse world x' y' variants) ; ❹
                      world)))
                world neighbors)]
    (if (= world' world)
      world
      (reduce (fn [world [x y]]
                (collapse-neighbors world recipe x y))
              world' neighboring-cells)))) ; ❺

This function is the heart of the algorithm, as it does all of the heavy liftings on constraining cells, so let’s break it down. First, we get all neighbors and extract a sequence of cells that we’re going to constrain (❶). We then iterate over these neighbors inside reduce, getting the current world state for this cell (❷). For this cell, we need to compute all remaining variants. This is done by intersecting this cell’s state with variants from a neighbor in a given direction. And if the cell itself is a set, this is done for each element in a set (❸). Finally, a cell is collapsed (❹), except when it was a set and the variant list wasn’t empty.

After that process is done for all four neighbors, we need to repeat it for each of the neighbors’ neighbors. So we check if our last run actually produced any change in the world, and if it is, we recursively walk through these neighbors (❺), otherwise, we return current world state. This may actually cause a stack overflow error if there are too many neighbors to collapse, which depends both on the world size and how general the recipe is. To avoid that, this function can be turned into iterative, but it still will maintain the stack of neighbors to collapse, which will grow in memory, instead of on a stack. I’ve decided to go with recursion, as it’s a bit easier to understand in the context of the post.

The last bit needed is a loop that will repeat this process until the whole world is collapsed. The process is:

pick a cell with the lowest entropy, first one is random
collapse it
constrain neighbors
check if not done
- repeat

Here’s the code:

(defn wfc [world sample]
  (let [recipe (build-recipe sample)]
    (loop [world (populate-world world sample)
           [x y] [(rand-int (count (first world)))
                  (rand-int (count world))]]
      (if-not (done? world)
        (let [cell (get-in world [x y])
              world (-> world
                        (collapse x y (rand-nth (vec cell)))
                     (collapse-neighbors recipe x y))]
          (recur world
                 (lowest-entropy-cell world)))
        world))))

Now, we can actually try it! Let’s create some helpers, that will print the resulting world, and the input recipe:

;; add [clojure.string :as str] to :require

(defn print-sample [sample]
  (->> sample (map str/join) (str/join "\n") (println)))

(defn print-world
  ([world] (print-world world ""))
  ([world sep]
   (->> world
        (map #(map (fn [c] (if (set? c) "?" c)) %))
        (map #(str/join sep %))
        (str/join "\n")
        (println))))

(defn print-result [sample world]
  (println "sample:")
  (print-sample sample)
  (println "gen:")
  (print-world world))

Now, if we use our coast recipe, we should see this in our REPL:

wfc.wfc> (print-result coast (wfc (gen-world 16 16) coast))
sample:
🟫🟫🟫🟫
🟫🟫🟫🟫
🟫🟫🟫🟫
🟫🟩🟩🟫
🟩🟦🟦🟩
🟦🟦🟦🟦
🟦🟦🟦🟦
gen:
🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫
🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫
🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫
🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫
🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫🟫
🟫🟫🟫🟫🟫🟫🟫🟩🟫🟫🟫🟫🟫🟫🟫🟫
🟫🟫🟫🟫🟫🟫🟩🟦🟩🟫🟫🟫🟫🟫🟫🟫
🟫🟫🟫🟫🟫🟩🟦🟦🟦🟩🟫🟫🟫🟫🟫🟫
🟫🟫🟫🟫🟩🟦🟦🟦🟦🟦🟩🟩🟫🟫🟫🟫
🟫🟫🟫🟩🟦🟦🟦🟦🟦🟦🟦🟦🟩🟫🟩🟩
🟫🟫🟩🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟩🟦🟦
🟩🟩🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦
🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦
🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦
🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦
🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦🟦

We can try with a bit more interesting examples, like these trees:

(def snowy-trees
  [["*" " " " " " " " " "*" " " " "]
   [" " " " " " " " " " " " " " "*"]
   [" " " " "*" "╱" "╲" " " "*" " "]
   ["*" " " "╱" "v" "v" "╲" " " " "]
   [" " "╱" "v" "v" "v" "v" "╲" " "]])

wfc.wfc> (print-result snowy-trees (wfc (gen-world 16 60) snowy-trees))
sample:
*    *
       *
  *╱╲ *
* ╱vv╲
 ╱vvvv╲
gen:
 *  *  *   *   *      *   *     *    *   *  * *    * *  *  *
   *  *  *    * * * *   *  * *    *    *     *  * * *  *
 *      *      *              *  *       * *   *   *  * * *
  * * *   *   * * *  * *  *     *    * *  *   * *      * *
 *   *   *   * *   *  *  *  * *  *  *   *  * * * *        *
   *    *  *      *       *  *  *  *  *  *    * * *
 *        * * *  *  *  * *     *  * *     * *      * * * * *
  *  *  *    *  * *  *     *  *  * *  *  * *    *   *   * *
         * *   * * *      *    *  *     * *  * *  ╱╲  *  *
   *  * * *   *       *  *    *      *        * *╱vv╲  *   *
*   *  *   * *     * * *   *     *  *  * *  *  *╱vvvv╲
  *   *   * *   * *     *   *   *  *    * *  * ╱vvvvvv╲
 *  *   *     *   ╱╲ *    *   *   *  ╱╲  *  * ╱vvvvvvvv╲ *
         *     * ╱vv╲ *  *  ╱╲ * * *╱vv╲   * ╱vvvvvvvvvv╲ *
 *   *     *    ╱vvvv╲  * *╱vv╲ * *╱vvvv╲ * ╱vvvvvvvvvvvv╲
*  ╱╲ *  ╱╲  * ╱vvvvvv╲   ╱vvvv╲ *╱vvvvvv╲ ╱vvvvvvvvvvvvvv╲

Noticeable, the spread is too uniform. This is because we pick a random choice, and the choices have equal distribution. Instead, it’d be nicer if we had a bit more control over what elements are more present and what is less present.

To do that, we need to replace our random choice picking with weighted random. First, we need to calculate the weights:

(defn sample-weights [sample]
  (frequencies (apply concat sample)))

This will do - the more times a certain tile appears in a recipe, the higher its weight is. Now we need a weighted random:

(defn weighted-random [elements weights]
  (let [variants (reduce (fn [m k] (assoc m k (weights k))) {} elements)
        weights (reductions #(+ % %2) (vals variants))
        rnd (rand-int (last weights))]
    (nth (keys variants) (count (take-while #(<= % rnd) weights)))))

And now, that we have weights, we can upgrade our lowest-entropy-cell function to take weights into account when calculating the entropy. We also use a better entropy calculation algorithm, based on Shannon entropy:

(defn cell-enthropy [cell weights]
  (let [weight-sum (reduce + (map #(get weights %) cell))
        log-weight-sum (reduce + (map #(let [weight (get weights %)]
                                         (* weight (Math/log (double weight)))) cell))]
    (Math/log (- weight-sum (/ log-weight-sum weight-sum)))))

(defn lowest-entropy-cell [world weights]
  (let [enthropies (->> world
                        (map-indexed
                         (fn [x r]
                           (keep-indexed
                            (fn [y cell]
                              (when (set? cell)
                                [(cell-enthropy cell weights) [x y]])) r)))
                        (reduce into (sorted-map)))]
    (if-some [[_ c] (first enthropies)]
      c
      [0 0])))

The last change needed is in the wfc function - we need to use weighted-random when we collapse a cell:

(defn wfc [world sample]
  (let [recipe (build-recipe sample)
        weights (sample-weights sample)]
    (loop [world (populate-world world sample)
           [x y] [(rand-int (count (first world)))
                  (rand-int (count world))]]
      (if-not (done? world)
        (let [cell (get-in world [x y])
              world (-> world
                     (collapse x y (weighted-random cell weights))
                     (collapse-neighbors recipe x y))]
          (recur world
                 (lowest-entropy-cell world weights)))
        world))))

Now the algorithm is done, and we can see that the snowy-trees example has a bit less snow now:

wfc.wfc> (print-result snowy-trees (wfc (gen-world 16 60) snowy-trees))
sample:
*    *
       *
  *╱╲ *
* ╱vv╲
 ╱vvvv╲
gen:
   *    *    *   *  *       *      *           * *         *
  *        *    *         *     *       *       * *   * *
       *      *        *   *         *    *   *    *   *
   *                *        *     *  *    *     *   *   *
*             *  * *      *          *       *
           *           *   *    *       * *             *  *
              *  *    *            *   *      *      *
    *     *  *     * *     *    *    *     *           * *
   * *     *          * *   *  *
          *    *       *  *       *   * *   *     *  * *
  * *       * *    * *   *     *   * * *            *   *
       *   *    *                 *      *        ╱╲ *     *
      *      *        * *            *      *  * ╱vv╲
     * ╱╲            *    * *          *  *     ╱vvvv╲
      ╱vv╲   ╱╲  *       *      *        *  *  ╱vvvvvv╲
  *  ╱vvvv╲ ╱vv╲   ╱╲  *  * *           * *  *╱vvvvvvvv╲  *╱

Working with images

At the beginning of this article, I’ve shown you an image of a coast. This image is generated by the code above, but right now it can’t handle images, only text. This isn’t a problem, really, because the text is just used in place of unique identifiers, so we can plug in anything, and then use the resulting world as a recipe to paint it on a canvas. Let’s do exactly that, but before we can do it, we need to be able to upload an image and splice it into tiles.

To do that, we’ll need an index.html file in our public/ directory, and a <canvas> tag in it with an appropriate id:

<canvas id="sample_view" width="512" height="512"></canvas>
<input type="file" id="sample_input" accept="image/*"></input>

<script type="text/javascript" src="/js/main.js"></script>
<script>
  window.onload = function() {
    wfc.core.init();
  }
</script>

I’m also adding an <input> tag, to open an image. Additionally to that, there should be the <script> tag that loads our core module and runs the init function. With this in place, we can add an event listener to the button, and load the image to canvas. In core.cljs add:

(ns wfc.core
  (:require [wfc.sample :as sample]))

(defn ^:export init []
  (when-let [sample-input (.getElementById js/document "sample_input")]
    (.addEventListener sample-input "change" sample/upload)))

And in sample.cljs create the upload function:

(defonce ^:dynamic *image* {:image nil
                            :width 0
                            :height 0})

(defn draw [event]
  (when-let [viewer (.getElementById js/document "sample_view")]
    (let [image (js/Image.)
          ctx (.getContext viewer "2d")
          handler (fn []
                    (let [width (.-width image)
                          height (.-height image)]
                      (set! *image* {:image image
                                     :width width
                                     :height height})
                      (set! (.-width viewer) width)
                      (set! (.-height viewer) height)
                      (.clearRect ctx 0 0 (.-width viewer) (.-height viewer))
                      (.drawImage ctx image 0 0)))]
      (.addEventListener image "load" handler)
      (set! (.-src image) (-> event .-target .-result)))))

(defn upload [event]
  (when-let [files (-> event .-target .-files)]
    (let [reader (js/FileReader.)]
      (.addEventListener reader "load" draw)
      (.readAsDataURL reader (aget files 0)))))

This should allow us to upload an image. Now we need to split it into tiles. To do that, let’s add another button to our index.html:

<button type="button" id="split_to_tiles">Split to tiles</button>

In core.cljs we add another event listener:

(ns wfc.core
  (:require [wfc.sample :as sample]))

(defn ^:export init []
  (when-let [sample-input (.getElementById js/document "sample_input")]
    (.addEventListener sample-input "change" sample/upload))
  (when-let [tile-size (.getElementById js/document "split_to_tiles")]
    (.addEventListener tile-size "click" sample/split-to-tiles))
  (when-let [render-button (.getElementById js/document "render")]
    (.addEventListener render-button "click" render/render)))

And define the function that does the work:

(defonce ^:dynamic *sample* [])
(defonce ^:dynamic *tiles* {})

(defn split-to-tiles [_]
  (if (:image *image*)
    (let [canvas (.createElement js/document "canvas")
          _ (set! (.-width canvas) (:width *image*))
          _ (set! (.-height canvas) (:height *image*))
          ctx (.getContext canvas "2d")
          _ (.drawImage ctx (:image *image*) 0 0)
          hashes-imgs (for [x (range 0 (:width *image*) 32)]
                        (for [y (range 0 (:height *image*) 32)]
                          (let [img (.getImageData ctx x y 32 32)]
                            [(hash (vec img.data)) img])))]
      (set! *sample* (mapv #(mapv first %) hashes-imgs))
      (set! *tiles* (into {} (apply concat hashes-imgs))))
    (js/alert "Please upload an image first")))

We do basic error checking, that an image was uploaded by checking *image* to have anything under the :image key. If there’s an image, we create a canvas, that we draw this image on, and then iterate thru it row by row, tile by tile, with a fixed tile size of 32. In this loop, we get an array of pixels, representing the given tile, and we calculate its hash, which we will use in our wave function collapse algorithm.

Now we can upload an image, and split it into tiles, the only thing left is to actually draw the result!

Drawing the result

We need yet another canvas for that. Actually, we need only one canvas for all of this, as we have the input button that takes care of image loading, and another button for splitting. But I still like to see what sample is loaded, as it gives a better understanding of what the resulting image was constructed from. So let’s add another canvas and a button:

<canvas id="render_view" width="512" height="512"></canvas>
<button type="button" id="render">Generate</button>

Once again, let’s add a handler to this button in core.cljs:

(ns wfc.core
  (:require [wfc.sample :as sample]
            [wfc.render :as render]))

(defn ^:export init []
  (when-let [sample-input (.getElementById js/document "sample_input")]
    (.addEventListener sample-input "change" sample/upload))
  (when-let [tile-size (.getElementById js/document "split_to_tiles")]
    (.addEventListener tile-size "click" sample/split-to-tiles))
  (when-let [render-button (.getElementById js/document "render")]
    (.addEventListener render-button "click" render/render)))

And in render.cljs we need to define the render function:

(ns wfc.render
  (:require [wfc.sample :as sample]
            [wfc.wfc :as wfc]))

(defn render [_]
  (if (:image sample/*image*)
    (when-let [renderer (.getElementById js/document "render_view")]
      (let [ctx (.getContext renderer "2d")
            width (.-width renderer)
            height (.-height renderer)]
        (.clearRect ctx 0 0 width height)
        (solve ctx width height)))
    (js/alert "Please upload an image")))

Nothing too complicated, just a handler that clears the canvas and calls solve. Now, solve is where the work is done:

(defn solve [ctx width height]
  (if (seq sample/*sample*)
    (let [tiles sample/*tiles*
          size 32]
      (loop [world (wfc/wfc (wfc/gen-world (/ width size) (/ height size)) sample/*sample*)
             x 0]
        (when-let [[row & rows] world]
          (loop [row row
                 y 0]
            (when-let [[cell & cells] row]
              (draw ctx (get tiles cell) x y size)
              (recur cells (+ y size))))
          (recur rows (+ x size)))))
    (js/alert "Please split image to tiles")))

First, we compute the result with wfc call, and then we iterate over it calling draw for each cell. The tile is retrieved from the *tiles* variable, we’ve set in sample.cljs when we split the image.

The draw function is simple - it accepts an image, coordinates where we need to draw it, the size, and the canvas’ context. Then it just draws the image:

(defn draw [ctx image x y size]
  (let [arr (js/Uint8ClampedArray. image.data)
        place (.getImageData ctx x y size size)]
    (.set (.-data place) arr)
    (.putImageData ctx place x y)))

The result will probably look a bit different, but the general idea is the same:

You can use this image to try the whole process:

Figure 4: coast

Alternatively, you can try other samples, just beware that the tile size is fixed to 32x32 pixels.

A proper demo

I’ve actually omitted some more things on the JS side, as the post already got a bit to long even after we’ve finished the algorithm. Things like configurable tile size, and custom world sizes, better error handling can be added, it’s just mostly the same stuff we already did for other buttons, and thus can get repetitive pretty quickly. So instead I’ve set up a separate page with a better visuals, tile picker, editor, some additional examples to try, and more robust error handling. You can try it here. And a bit more polished code can be found in the repo for that demo page.

I know that this isn’t how ClojureScript is used in production, but it’s still nice that you can build such pages pretty quickly, using your favorite language. In the future I’ll probably learn some proper frontend related stuff, like Lumen or re-frame, but this is a thing for another time. Hope this was an interesting read!

I’m saying lisp as in the language not as in concrete implementation. To be clear, I’ve worked my way thru SICP, and mostly used Racked or GNU Guile, not Common Lisp, so I’m not biased on what is lisp, and I accept Clojure as a valid dialect, even if some may disagree. ↩︎
This includes LÖVE Fabrik, raymarching, raycasting. ↩︎
This is the approach I’ve taken when I’ve implemented my first Scheme-like language, condition-system, a library for asynchronous programming, raymarching algorithm, and many other projects. I think I find this approach fascinating because when the thing finally works, and I go and look how it should be done, and see that I’ve got some things right, it gives me a lot of joy. This also trains to think outside of the box, and solve problems that you don’t exactly know how to solve. ↩︎

Comment via email

Lazy sequences and iterators

Sat, 09 Oct 2021 21:34:00 +0300

Today’s topic will be about lazy sequences and how these are different from iterators. I’ve wanted to make an article on this topic for some time, but unfortunately, there was no good way to show the differences using a single language (that I know), because usually, languages stick to one of those things. But since I’ve been into library writing lately, I wrote a lazy sequence library for the Fennel language, and because Fennel compiles to Lua, it makes Lua a great candidate for this article.

Lua has first-class support for iterators, as it is kind of a central paradigm very closely related to tables. And because iterators are so common in Lua, some libraries even treat them as sequences. However, iterators are not sequences, even though they can be used similarly. And proper sequences also can be created from tables much like iterators and would have similar use cases, without some problems that iterators have. So today we’ll look into Lua iterators, and lazy sequences, and will try to understand their differences.

Iterators in Lua

Let’s begin by understanding what iterators are, and what key features they provide.

In Lua, iterators are usually higher-order functions, produced by another function, based on its input. A standard way to get an iterator over a table is to call pairs function:

get_next, t, k = pairs({a = 1, b = 2, c = 3})

Lua supports multiple return values, so calling pairs returns us the iterator function as the first value, a table (our original table in this case), that we’re going to iterate as the second value, and the starting key, which in our case is nil.

Calling this get_next function, and passing it our table t, and the key k, we get back a pair of values, representing the key and a value associated with that key:

get_next(t, k) -- b	2

We then can use the returned key as an input to the next call to get_next and get the next key-value pair, repeating the process until get_next returns nil:

get_next(t, "b") -- c	3
get_next(t, "c") -- a	1
get_next(t, "a") -- nil

nil means our table is exhausted, and no more keys are present in it. The order may be different for you, as it depends on hashing.

This get_next is a stateless iterator - it doesn’t have any hidden state inside it, which means, that it can be reused. For example, we can pass a different table to the get_next function, and it will work on it without any problem:

get_next({f = 42, g = 27}, nil) -- g	27

This pattern is quite common, so Lua has such a function in its standard library, it is called next and is a basis for all table iterators created with pairs. In addition to pairs, Lua provides another iterator constructor called ipairs, which is used to iterate over sequential tables, and it works similarly to pairs except uses integers as input keys.

While stateless iterators are good, it’s not always efficient, and sometimes not even possible to create a stateless iterator. For example, opening a file in Lua and calling lines method on it creates an iterator over this file, which is a stateful iterator that can be exhausted, i.e. you can call it only so many times as there are lines in the file. Let’s create a file example.txt with the following contents, and create an iterator over it:

line 1
line 2
line 3

file = io.open("example.txt", "r")
get_next_line = file:lines()
get_next_line() -- line 1
get_next_line() -- line 2
get_next_line() -- line 3
get_next_line() -- nil

Note that even though we’re calling the get_next_line function without any arguments, like the file, or the line number, it always returns the next line of the file. This is an example of a stateful iterator, which we can only use once - even if we call the lines method on the file object again, the returned iterator will be exhausted:

new_get_next_line = file:lines()
new_get_next_line() -- nil

This happens because the state is held in the file handle itself, so we need to reopen the file to get a new iterator. Because of this you usually want to open the file, walk it, use or cache needed lines, and close the resource, ideally doing all of this in a protected call.

And lastly, let’s create our own stateful iterator, that keeps its state in the closure. For the purposes of this example, let’s create a range iterator, that can create various ranges based on initial input:

function range(lower, upper, step)
  local lower, upper, step = lower or 0, upper or math.huge, step or 1
  return function ()
    local tmp = lower
    lower = lower + step
    if tmp < upper then
      return tmp
    end
  end
end

To keep it simple I’ve left some corner cases out, but this is basically the idea for a range iterator. When we call range, local variables lower, upper, and step are created based on given arguments or their default values. Then an anonymous function is returned, which refers to these local variables as closures, and sets the lower variable to a new value each time it is called:

r = range(1, 4)
r() -- 1
r() -- 2
r() -- 3
r() -- nil

As you can see, when we exhaust our iterator it returns nil, similarly to iterators created with pairs or file iterators. Thanks to this, we can use it in Lua’s for statement:

for x in range(1, 10, 3) do
  print(x)
end
-- 1
-- 4
-- 7

So now, when we more or less know what iterators are, and how they’re defined, let’s discuss their key properties:

Iterators are lazy,
Stateless iterators accept some kind of state (usually an object and a key) as arguments to produce the next key-value pair, and hence can be reused,
Stateful iterators are like cursors, and can’t be reused unless created anew.

Laziness is a very good property of iterators - it allows us to create actual infinite streams of data, computed on demand. For example, we can open really huge, or even infinite files, and read those line by line without consuming more memory than is actually needed to hold a single line. Alternatively, as was shown with the range iterator above, we can create an infinite range, by not supplying an upper border for it, and it will use the math.huge value, which is inf in Lua. So if Lua had arbitrary precision math, the range would grow to infinity, but in the case of this function, it will just overflow again and again.

However, while laziness is an extremely handy and important part of iterators, their benefits pretty much end on it. Iterator is basically a one-shot thing - you create it, use it until it is exhausted, or you’ve accomplished what you wanted to do with them, and then you never use the same iterator again. This is due to the fact, that iterators were not meant to be shared - you can’t tell if an iterator is stateless or stateful, and if it is a stateful iterator, there’s no safe way to share it. Someone can exhaust it, and later users will not get any values. Stateless iterators are less dangerous to share, but the usefulness of this is also significantly lower, as you need to pass the context along with an iterator.

All of this can be summarized to one point - iterators are not a data structure. And while this is not a bad thing, the usefulness of the iterator is limited because of this. So what if we wanted to share an iterator, and also make sure, that it doesn’t have problems with stateful iterators, and can be used as a data structure? That’s where lazy sequences come in handy!

Lazy Sequences

What are sequences? Think of a lazy sequence as a singly-linked list, with the difference that the tail may not be an actual cell, but a special kind of lazily evaluated cell. In order to create a sequence, we need to implement a so-called cons cell:

function cons (head, tail)
  return function (ht)
    if ht then
      return head
    else
      return tail
    end
  end
end

Conses are an old term that comes from the LISP language and basically represents a pair. It’s a data structure that holds two elements - a value and a pointer to the next value or a cons cell. This is usually illustrated with these boxes:

These stacked boxes represent a single cons cell - a pair of boxes, each referring to a value. The first box refers to 1, and the second box refers to another cons cell, which in turn refers to 2, and finally to nothing, indicating the end of the list. This data structure suits our task quite well, but you may notice that our implementation isn’t exactly a data structure, but a function. So how do we work with it then?

We need two primitive operations. In LISP these are historically called car and cdr, but it’s not meaningful to use these names in the context of Lua, so let’s call them first and rest:

function first (cell)
  return cell(true)
end

function rest (cell)
  return cell(false)
end

Since our cons cell is a function of one argument with if statement in it, first will pass true to it, to get the first element, and rest will pass false to get the other element of a cons cell. Here’s a quick demonstration:

list = cons(1, cons(2, cons(3, nil))) -- 1 -> 2 -> 3 -> nil
first(list) -- 1
first(rest(rest(list))) -- 3

We’ve created a list variable, that holds a single-linked list with values 1, 2, 3. And the final value is nil, which is needed to indicate the end of the list since the last cons cell must refer to nothing. However, this list is not lazy just yet.

Let’s recap how iterators achieve laziness. Iterators produce the next value only when you call them, which makes them very similar to generators by nature. However, the key difference from lazy sequences is that all previous results are thrown away and not kept with the iterator.

So how we can achieve laziness in our sequences? We can try a naive approach of wrapping arguments into functions, and realizing them when a value is requested:

function lazy_cons (headf, tailf)
  return function (ht)
    if ht then
      return headf()
    else
      return tailf()
    end
  end
end

Now, when constructing a list, instead of passing the elements directly, we need to pass some functions that will return the list’s elements:

lazy_list = lazy_cons(
  function () print "realize head" return 1 end,
  function () print "realize tail" return 2 end
)

Because the interface is the same, we can use first and rest to get values:

first(lazy_list)
-- realize head
-- 1
rest(lazy_list)
-- realize tail
-- 2

You can see, that when we’re calling first on our lazy_list it realizes the value, and then returns it. This is very close to our goal, but we’re not there yet. The problem is, that if we call first on lazy_list again, it will call the realization function again and again without caching the result, which is not right:

first(lazy_list)
-- realize head
-- 1
first(lazy_list)
-- realize head
-- 1

To solve this issue, we’ll need to rewrite lazy_cons in a such way, that it will realize our cell only once, and cache the result somehow. This can be done by creating mutable closures, but I think there’s a better way, that will also allow us to do more interesting stuff later. And it is also kinda hard to differentiate if the closure is uninitialized or the realization set it to nil. So instead we can use a clever metatable trick to realize cons cell contents upon access:

function lazy_cons (headf, tailf)
  local cell = {}
  local function realize ()
    local head, tail = headf(), tailf()
    local function realized (_, ht)
      if ht then
        return head
      else
        return tail
      end
    end
    return setmetatable(cell, {__call = realized})
  end
  return setmetatable(cell, {__call = function (_, ht) return realize()(ht) end})
end

Basically, we create a table cell, to which we set a metamethod __call that works similarly to the function that is returned by cons, except not quite. Note the realize()(ht) call in this metamethod - it calls the realize function first, then invokes the resulting function. The realize function is defined above, and this function resets the __call metamethod to another function, that uses cached values. Now using first on a such cell will work as expected:

lazy_list = lazy_cons(
  function () print "realize head" return 1 end,
  function () print "realize tail" return 2 end
)

first(lazy_list)
-- realize head
-- realize tail
-- 1
first(lazy_list)
-- 1
rest(lazy_list)
-- 2

It realizes the cell and then caches the results in a closure, so when we call first on this cell later, we get the same values every time. Now we can create and manipulate lazy sequences with only these three basic functions! Here’s our list example from above, but now lazy:

lazy_list = lazy_cons(
  function () print "first" return 1 end,
  function ()
    return lazy_cons(
      function () print "second" return 2 end,
      function ()
        return lazy_cons (
          function () print "third" return 3 end,
          function () return nil end
        )
      end
    )
  end
)

And we can inspect it with the same first and rest functions:

first(lazy_list)
-- first
-- 1
first(rest(rest(lazy_list)))
-- second
-- third
-- 3
first(lazy_list)
-- 1

That’s pretty much it! We have a way of constructing lazy sequences via a very primitive lazy_cons function, and anonymous functions as arguments. The usefulness of this may not be obvious, so let’s see some more examples of how this can be utilized before we move on.

More examples

Let’s create a lazy sequence that works similarly to the range iterator we did earlier:

function range_seq(lower, upper, step)
  local lower, upper, step = lower or 0, upper or math.huge, step or 1
  return lazy_cons(
    function () return lower end,
    function ()
      local tmp = lower + step
      if tmp < upper then
        return range_seq(tmp, upper, step)
      else
        return cons(nil, nil)
      end
    end
  )
end

A bit more verbose, but notice that this is no longer a stateful thing! Instead, it is a recursive function, which returns a self-referencing cons cell, which calls itself with changed arguments.

A recursion? How’s it lazy then?

The thing is, that it’s not even a recursion! The next recursion step will only happen when a cell is realized, and it will simply produce another lazy cell, which will not go to the next recursion step immediately. And even if Lua had no tail call optimization it would still work just fine, as it acts more like a trampoline, and the call stack never actually grows. Here’s how we can see that our range_seq is working:

r = range_seq(1, 4)
first(rest(rest(r)))
-- 3
first(rest(rest(rest(r))))
-- nil

And for infinite ranges we can drop as many values before working with the range:

r = range_seq()
for i=1,1000000 do
  -- let's drop some elements
  r = rest(r)
end
first(r) -- 1000000
first(rest(r)) -- 1000001

It’s a quite common pattern when working with infinite sequences to drop some values before working with them. So if we want to create an infinite range, that starts from a given value, we can write a drop function, which will produce a new lazy sequence without first n elements in it.

Another thing to note is that it is a bit tedious to write nested rest calls every time, so let’s iterate over this range instead, with the power of recursion:

function loop (seq, f)
  local head, tail = first(seq), rest(seq)
  f(head)
  if tail then
    loop(tail, f)
  end
end

loop(range_seq(0, 10, 2), print)
-- 0
-- 2
-- 4
-- 6
-- 8

This loop function accepts a sequence and calls a supplied f function on each element for side effects. A very similar concept exists in most functional languages, and it is called mapping, so let’s create a lazy map function:

function map (seq, f)
  if first(seq) then
    return lazy_cons(
      function () return f(first(seq)) end,
      function () return map(rest(seq), f) end
    )
  else
    return cons(nil, nil)
  end
end

Now with this map function, we can not only apply a function to every element of the sequence, but we can also collect the results into another sequence. Let’s write a function that prints every element of the given sequence, and pass the result of the map call to it:

function print_seq (seq)
  io.stdout:write("[")
  local function print_seq (seq)
    if first(seq) then
      io.stdout:write(first(seq), ", ")
      print_seq(rest(seq))
    end
  end
  print_seq(seq)
  io.stdout:write("\b\b]\n")
end

function square (x) return x * x end

print_seq(map(range_seq(0, 10), square))
-- [0, 1, 4, 9, 16, 25, 36, 49, 64, 81]

Now, to demonstrate that this is really a lazy map, let’s add a print call to square, and store the resulting sequence to a variable:

function square (x)
  print("square of "..x.." is "..x * x)
  return x * x
end

squares = map(range_seq(0, 10), square)

Nothing is printed until we realize some elements of our sequence:

first(squares)
-- prints: square of 0 is 0
first(rest(rest(squares)))
-- prints: square of 2 is 4
first(rest(rest(squares)))
-- prints nothing, as the result was already realized

Note that while this is still just a (kinda special) function, it behaves just like a real linked list, and thus represents a proper data structure. Although it’s a bit clumsy to use directly, as shown with the map example, we can build a library around this concept, that will abstract the construction of a lazy sequence away from the user. And that’s exactly what I did.

Lazy-seq library

It should be pointed out that the code above is a very rough example of a lazy sequence implementation. I think it’s fine for explaining the idea, but there are some edge cases that are not handled properly. For example, the map function we’ve written is not fully lazy, as it actually realizes its first element, and the range_seq will not properly work for negative ranges. And the lazy_cons is not really the most useful abstraction - instead of using it directly, a much more handy lazy_seq function should be created, that would accept another function, which in turn would return any kind of sequence. To address these shortcomings I’ve created a lazy-seq library, which has a lot of functions to create and manipulate lazy sequences.

Now, it’s a Fennel library, written in Fennel, and aimed toward it first. That is, mainly due to the fact that this library mimics Clojure’s vision of lazy sequences and ports a lot of functions from its core namespace. But the core principles are exactly the same as described above, and you still can use the library from Lua, just like we did earlier!

Except the semantics are expanded a bit - there are handy constructors for creating lazy sequences from tables or strings, supporting both sequential and associative tables. And, as you may remember from the previous section since our cons cells are secretly tables underneath, sequences defined by this library also implement various metamethods, like __len, __index, and so on, for more convenient usage.

Proper versions of map and range already exist in this library, along with other functions, which can be used as building blocks for creating all kinds of sequences. For example, here’s how one would create an infinite Fibonacci sequence using the lazy variant of the map function in Lua:

lazy = require "lazy-seq"
first, rest, map = lazy.first, lazy.rest, lazy.map
concat, drop, lazy_seq = lazy.concat, lazy.drop, lazy["lazy-seq"]
bc = require "bc"
function add (a, b) return a + b end
fib = concat(
  {bc.new(0), bc.new(1)},
  lazy_seq(function () return map(add, rest(fib), fib) end)
)
first(drop(400, fib))
-- 176023680645013966468226945392411250770384383304492191886725992896575345044216019675

In the example above I’m also using the lbc library which provides arbitrary precision math for Lua to illustrate that you can compute as many Fibonacci numbers as you want (try dropping the first 100000 elements for example) That’s a bit verbose still, but not as verbose as the manually created lazy linked list from previous sections. And note that the concat function, which is used to concatenate sequences, also works with tables, as shown in the example above. All sequence manipulating functions in the lazy-seq library work with tables, as tables are implicitly converted to sequences.

In Fennel, the same code is even more compact because we can use the lazy-cat macro instead of using concat and lazy-seq, and thanks to anonymous function shorthand:

(local {: first : rest : map : drop} (require "lazy-seq"))
(import-macros {: lazy-cat} "lazy-seq")
(local bc (require "bc"))
(global fib (lazy-cat [(bc.new 0) (bc.new 1)] (map #(+ $1 $2) (rest fib) fib)))
(first (drop 400 fib))
;; 176023680645013966468226945392411250770384383304492191886725992896575345044216019675

Note however that macros are a Fennel-only feature, not available in Lua, so where in Fennel you would write:

(import-macros {: lazy-cat : lazy-seq} "lazy-seq")

(lazy-cat [1 2 3] [4 5 6])
(lazy-seq (do (print "I'm lazy") [1 2 3]))

In Lua it would be:

lazy = require "lazy-seq"
concat, lazy_seq = lazy.concat, lazy["lazy-seq"]

concat(lazy_seq(function () return {1, 2, 3} end), lazy_seq(function () return {4, 5, 6} end))
lazy_seq(function () print "I'm lazy" {1, 2, 3} end)

This code is fully equivalent to fennel code, except that macros write all these anonymous functions for you.

But macros are not the only unique feature in Fennel, the other one is destructuring. I’ll not go into details here, but destructuring is kinda similar to pattern matching, and it allows specifying data structure shape and binding values of the data structure to variables defined by that shape. So similarly to how you would destructure a table, thanks to __len and __index metamethods, destructuring works on lazy sequences:

(local {: range} (require "lazy-seq"))
(let [[a b c & rest] (range 10)] (print a b c) rest)
;; 0 1 2
;; [3 4 5 6 7 8 9]

Just make sure you don’t use & destructuring with infinite sequences¹. And more than that, sequences define the __pairs metamethod, and thus support creating stateless iterators created with pairs!

fennel = require "fennel" -- for pretty printer
lazy = require "lazy-seq"
squares = lazy.map(function (x) return x * x end, {1, 2, 3, 4, 5})
for k,v in pairs(squares) do
  print(fennel.view(k), v)
end
-- @seq(4 9 16 25) 1
-- @seq(9 16 25)   4
-- @seq(16 25)     9
-- @seq(25)        16
-- @seq()          25

We’ve come a full circle.

I’ve required the fennel library, to provide the pretty-printed representation of a sequence for a better illustration. You can see that on each step of iteration we see the shorter and shorter sequence. Sequence automatically pretty-printed in the REPL like this, but that’s one of Fennel’s features, that I’ve previously written about, and implemented a very similar linked list there, so if you’re interested in that, you can find some more info there. And viewing such a sequence in this way really shows us that it is nothing else but a data structure!

Unlike tables, a stateless iterator over a sequence uses the tail of the sequence as the key to getting the next element, because the iterator is simply built on top of first and rest. It ends when it reaches the empty cons cell, which is at the end of each sequence. The only exceptions are infinite sequences, which don’t have empty cons at the end as, well, they’re infinite. So calling pairs and iterating over infinite sequences should have another guard for terminating iteration. Or, you can limit the size of the sequence with take, take-while, and other filtering functions.

There are also various functions like line-seq which accepts a file handle, so here’s what happens when we call it on a file:

(local {: line-seq : doall} (require "lazy-seq"))
(with-open [f (io.open "example.txt" :r)] (doall (line-seq f)))
;; @seq("line 1" "line 2" "line 3")

We have to realize the whole sequence before with-open automatically closes the file handle, but you can lazily work with this sequence while you’re inside of the with-open block without any issues. In contrary to the iterator, we can re-use this sequence of lines, as no results have been thrown away.

Finally, as I’ve mentioned, lazy sequences can be generated from tables with the seq function:

(local {: seq} (require "lazy-seq"))
(seq [1 2 3])
;; @seq(1 2 3)
(seq "abc")
;; @seq("a" "b" "c")

If we pass in an associative table we get a bit different representation:

(seq {:a 1 :b 2 :c 3})
;; @seq(["a" 1] ["c" 3] ["b" 2])

These sequences are all lazy because seq creates a wrapper around an iterator over the table. This means, that if you change the table before the sequence is fully realized, your resulting sequence will have updated elements much like an iterator would produce them. This is not recommended, and instead immutable tables a better be used to produce sequences, and in general. And since sequences themselves are immutable and persistent this is a win-win.

The lazy-seq library also provides a lot of other functions, like filtering, restructuring, modifying, and combining infinite sequences. It’ll take a lot of time to list all of them here, so I’d recommend you to read the documentation if you’re interested. But as an example of what you can do, here we create an infinite sequence of random numbers, filter out only those which are perfect squares, and group those by 2:

(local {: take : filter : repeatedly : partition} (require "lazy-seq"))
(local rands (repeatedly math.random 0 64))
(local perfect-squares (filter #(= 0 (% (math.sqrt $) 2)) rands))
(local rand-square-pairs (partition 2 perfect-squares))
(take 10 rand-square-pairs)
;; @seq(@seq(64 16)
;;      @seq(4 0)
;;      @seq(64 4)
;;      @seq(4 0)
;;      @seq(0 4)
;;      @seq(4 64)
;;      @seq(16 0)
;;      @seq(0 64)
;;      @seq(16 4)
;;      @seq(16 36))

Note that we did all operations on an infinite sequence, and then only used take to get the first 10 elements of it. This is a common pattern when working with infinite sequences - create something infinite, filter or modify it, and take the needed amount of elements.

Conclusion

That’s all I wanted to say about lazy sequences and their relationship with iterators. But of course, there’s much more to it, as there are a lot more functions for sequence manipulation I’ve left uncovered because it would simply be too long for an article. The main point I’ve wanted to share is that sequences are similar to iterators, but don’t have some downsides that iterators have. Someone can argue that these downsides are features, but I think sequences still have their uses.

So let’s recap what we have learned about sequences:

Sequences are a data structure, with very important properties of persistence and immutability.
Sequences are lazy, much like iterators, but they cache their values for later re-use.
Things that required stateful iterators, can be done with stateless sequences by using laziness and recursion.
Sequences, implemented by lazy-seq library, support common table operations, making it easy to integrate lazy computation into existing Lua code.
Operations on infinite sequences can be easily composed.

I hope you got a good understanding of lazy sequences, and I got you interested in at least trying them out! Despite being a Fennel library, lazy-seq can be used from Lua just fine, you only need to compile it to Lua first, which is not hard to do, given that Fennel itself is also just a library. But I suggest using this library with Fennel, as it adds a bit more facilities, like pretty-printing of your data structures, and provides macros for a more concise code.

: As of Fennel v1.0.0 the __fennelrest metamethod was added, and & destructuring works on infinite sequences. ↩︎

Comment via email

Condition system for Fennel language and Lua runtime

Sun, 08 Aug 2021 18:47:00 +0300

Not long ago I posted a small article on a Condition System in Clojure language. In that article, I was mostly trying to understand what a condition system is, and how it can enhance error handling in the code I write. Since that time, I’ve understood this system a lot better, by actually trying it in the Common Lisp language, the place where it came from, as far as I know. And you know what it means (because you’ve read the title) - it’s time to implement such a system for Fennel!

I like Fennel a lot, it’s a really cool language to tinker with - it’s small, slick, Lua runtime is actually really versatile, and can be bent to your needs without a lot of extra work. But the reason I’ve decided to implement this library for Fennel, and not for Lua itself, is because of a feature that is not available in Lua but is available in Fennel - lisp macros. The library is already available for everyone to use: fennel-conditions, and in this article, I’ll do a deep dive into the details behind the implementation.

Condition system?

First, let’s actually explain what the condition system is.

Condition system is a feature of the Common Lisp language, that can be very roughly described as resumable exceptions. Though, while this isn’t the only way you can use the condition system, it is the main reason I’ve decided to port this system into Fennel, as Lua error handling is not the best, and we can do better. You still can use a condition system for basic control flow to some extent, though not as versatile as in Common Lisp, I don’t think that Fennel really needs these features.

In Common Lisp, a condition is an object, which represents a certain event. You can bind handlers for particular events, and trigger these handlers by raising a condition. This may sound similar to the classic exception model found in languages like Java, but it has one major difference. Exceptions are a two-part system, while the condition system is three-part.

It’s really hard to come up with a small example to show what condition the system has to offer that exceptions don’t, and I don’t really know Common Lisp well enough to write it. So I encourage you to read Chapter 19 from the Practical Common Lisp book which covers this topic in detail before continuing reading. There’s also a good article on the wiki.c2.com. If you’ve read that before or just now, and didn’t understand what the condition system is, hopefully, you’ll get the idea in this post, but I can’t guarantee that.

If I were to describe the main difference between this system from classic exceptions, I would say that when you write a code that throws an exception, you have to deal with this exception somewhere else. And the place where you handle that exception is the place where the program would continue running after the handling is done.

In the condition system, the place where you’ve thrown such an exception can be the place where the program continues running if you use some special constructs, that allow you to return to that place.

An example

In the spirit of the Practical Common Lisp book example mentioned above, here’s a rather naive Clojure code that parses a log file, and uses exceptions to indicate that parsing failed:

(ns log-parser
  (:require [clojure.java.io :as io])
  (:import [clojure.lang ExceptionInfo]))

(defn well-formed?
  "Checks if the line contains basic date-time, a service name, and a message
separated by colons."
  [line]
  (let [date-re #"([12]\d\d\d-[01]\d-[0-3]\d)"
        time-re #"([01]\d:[0-5]\d:[0-5]\d\.\d+)"
        service-re #"([^:]+)"
        message-re #"(.*)"]
    (re-matches (re-pattern (str date-re "T" time-re ":" service-re ":" message-re))
                line)))

(defn parse-line
  "Extract `date`, `time`, `service` name, and a `message` from a `line`."
  [line]
  (if-let [[_ date time service message] (well-formed? line)]
    {:date date
     :time time
     :service service
     :message message}
    (throw (ex-info "malformed log entry" {:line line}))))

(defn parse
  "Return a vector of parsed lines, each element being a map with the
  following keys: `:date`, `:time`, `:service`, `:message`."
  [lines]
  (try
    (mapv parse-line lines)
    (catch ExceptionInfo e
      (binding [*out* *err*]
        (prn (format "%s:%s" (ex-message e) (:line (ex-data e))))))))

(defn parse-log [file]
  (with-open [f (io/reader file)]
    (parse (line-seq f))))

Note: Yes, there are more idiomatic ways of doing this task in Clojure, but for the purposes of demonstrating the difference between exceptions and conditions this will do.

So this code checks if the line has a valid format, and if not it will throw an exception. And here’s a problem - if a single line is invalid, we will get no results at all. We can avoid that by moving try into our iteration:

(defn parse
  "Return a vector of parsed lines, each element being a map with the
  following keys: `:date`, `:time`, `:service`, `:message`."
  [lines]
  (mapv #(try
           (parse-line %)
           (catch ExceptionInfo e
             (binding [*out* *err*]
               (prn (format "%s: %s" (ex-message e) (:line (ex-data e)))))))
        lines))

This will correctly parse our log, but we will have nil in place of each malformed line. This can once again be fixed by using keep instead of mapv, but what if we can’t afford to lose any lines? Maybe we can fix the line and parse it one more time? This again can be done by modifying our anonymous function, so it would catch the exception, try to fix the line, and then call parse-line again. And if we can’t fix the line, we will log it as before, and don’t add it to the resulting vector:

(defn fix-line
  "We don't care when this happened, just want to know what happened."
  [line]
  (when-let [[_ service message] (re-matches #".*:([^:]+):([^:]+)$" line)]
    (str "1970-01-01T00:00:00.000:" service ":" message)))

(defn parse
  "Return a vector of parsed lines, each element being a map with the
  following keys: `:date`, `:time`, `:service`, `:message`."
  [lines]
  (into []
        (keep #(try
                 (parse-line %)
                 (catch ExceptionInfo e
                   (if-let [fixed-line (fix-line (:line (ex-data e)))]
                     (parse-line fixed-line)
                     (binding [*out* *err*]
                       (prn (format "%s: %s" (ex-message e) (:line (ex-data e)))))))))
        lines))

But then again, when we will use parse-line in some other part of the program we will need to do all this stuff over and over. The main problem here is that we’re building concrete ways to recover from error as a part of the calling function that is meaningful only in the context of the parse-line and the responsibility for recovering should really be on it. Condition system can help us write more generic code, that knows how it can recover from the error, but let the recovery happen on the calling side. Consider the following Fennel code that uses fennel-conditions library:

(local {: error : make-condition : invoke-restart} (require :fennel-conditions))
(import-macros {: handler-bind : restart-case : define-condition} :fennel-conditions)

(define-condition MalformedLogEntry)

(fn well-formed? [line]
  "Checks if the line starts with basic date-time followed by a colon and a word."
  (let [date-pat "([12]%d%d%d%-[01]%d%-[0-3]%d)"
        time-pat "([01]%d:[0-5]%d:[0-5]%d%.%d%d%d)"
        service-pat "([^:]+)"
        message-pat "(.*)"]
    (string.match line (.. date-pat "T" time-pat ":" service-pat ":" message-pat))))

(fn parse-line [line]
  "Extract `date`, `time`, `service` name, and a `message` from a `line`."
  (restart-case
      (match (well-formed? line)
        (date time service message) {:date date
                                     :time time
                                     :service service
                                     :message message}
        _ (do (print line) (error (make-condition MalformedLogEntry {:line line}))))
    (:use-value [x] x)
    (:reparse-line [fixed-line] (parse-line fixed-line))
    (:ignore [ignore-val] ignore-val)))

(fn fix-line [line]
  "We don't care when this happens, just want to know what happened."
  (match (string.match line ":([^:]+):([^:]+)$")
    (service message) (.. "1970-01-01T00:00:00.000:" service ":" message)))

(fn parse [lines]
  "Return a vector of parsed lines, each element being a map with the
following keys: `:date`, `:time`, `:service`, `:message`."
  (handler-bind [MalformedLogEntry
                 (fn [e {: line}]
                   (match (fix-line line)
                     fixed-line (invoke-restart :reparse-line fixed-line)))
                 MalformedLogEntry
                 (fn [e {: line}]
                   (io.stderr:write (.. "malformed log entry: " line "\n"))
                   (invoke-restart :ignore nil))]
    (icollect [_ line (ipairs lines)]
      (parse-line line))))

(fn parse-log [file]
  (with-open [f (io.open file :r)]
    (when f
      (parse (icollect [line (f:lines)] line)))))

For those unfamiliar with condition system special forms or Fennel itself, handler-bind is something similar to try with the difference that the only way to recover from the error is by calling invoke-restart ¹. with-open is the same thing as in Clojure or Common Lisp, and icollect is something similar to mapv in Clojure, but it’s a macro, that accepts body form instead of function.

So what’s different about this code from the code in Clojure’s example? Let’s look at parse-line functions in Clojure and in Fennel:

;; Clojure
(defn parse-line
  "Extract `date`, `time`, `service` name, and a `message` from a `line`."
  [line]
  (if-let [[_ date time service message] (well-formed? line)]
    {:date date
     :time time
     :service service
     :message message}
    (throw (ex-info "malformed log entry" {:line line}))))

;; Fennel
(fn parse-line [line]
  "Extract `date`, `time`, `service` name, and a `message` from a `line`."
  (restart-case
      (match (well-formed? line)
        (date time service message) {:date date
                                     :time time
                                     :service service
                                     :message message}
        _ (error (make-condition MalformedLogEntry {:line line})))
    (:use-value [x] x)
    (:reparse-line [fixed-line] (parse-line fixed-line))
    (:ignore [ignore-val] ignore-val)))

Apart from some syntactic differences, you can see that both functions are throwing an error - by using throw in Clojure, and error in Fennel. However, while the Clojure version only throws the error, the Fennel version does some additional things. What we’re interested in here is the restart-case macro, which is a special macro from the condition system, that allows us to return to its location when we want to handle the error.

So when parse-line throws an error in Clojure, JWM unwinds the stack, and we basically leave this function completely. We then catch the exception in the parse-log function, which can’t do anything about it but handle it right there or let it fall through.

However, when parse-line throws an error in Fennel, we don’t actually unwind the stack at all. Instead, we travel up the dynamic scope, in search of a handler bound to this error by the handler-bind macro in the parse function:

;; ---- 8< ----
(handler-bind [MalformedLogEntry
               (fn [e {: line}]
                 (match (fix-line line)
                   fixed-line (invoke-restart :reparse-line fixed-line)))]
  ;; ---- 8< ----
  )

This handler tries to fix the line, and calls (invoke-restart :reparse-line fixed-line). invoke-restart is another special function in condition system - it once again travels through the second dynamic scope, and finds that there’s a restart named :reparse-line bound by restart-case in the parse-line function. This restart is executed right there, despite the fact that we’ve “left” the lexical scope of that function to find a handler, and its value is used in the original parse-line call.

So the order in which all functions are called looks something like that:

In other words, when we wrote parse-line in Clojure, we only defined how to detect malformed lines and how to signal an error. When we wrote parse-line in Fennel, we not only specified what to do if the line is malformed but also provided concrete ways to recover, that are meaningful in the context of this function.

When we caught the exception in Clojure, we had no choice but to handle it right there. In Fennel, when we caught the exception we could decide whether we can handle the error, and how we can handle it without leaving the original call.

I hope this illustration is clear enough to demonstrate the main difference between exception and condition. Again, yes, there are better ways of dealing with this particular error in Clojure, but what I wanted to illustrate is that there’s no way of achieving the same flexibility of the condition system with just exceptions. I’ve covered possible ways of implementing a rather basic condition system in pure Clojure in my previous post Condition System in Clojure language, so it’s not entirely impossible, but has its own shortcomings. With that in mind let’s talk about the implementation of this system.

The implementation

As I’ve mentioned previously, the dynamic scope is what allows us to travel through our code without transferring the control. However, Lua doesn’t have a dynamic scope builtin into the language. So how is this possible?

Well, as you might know, Lua has tables, and these tables are dynamic and mutable. So theoretically, we could create a table, that is available globally, properly encapsulate it, and use it as our dynamic scope. And that’s exactly what the fennel-conditions library does.

However, implementing dynamic scope via tables is not enough. First of all, we need to manage the dynamic scope in a sensible way. Second, we need some way of actually traveling through the lexical scope to the point where the dynamic scope was created, once we know where we need to move after all handling has been done. And finally, the scope should be thread-local, and even though Lua doesn’t have threads, it has coroutines, which can act as threads, so we should maintain dynamic scope with respect to this aspect of the language.

Let’s begin by listing things that will be implemented in the condition system:

condition objects - conditions are objects, that can have inheritance, and can embed additional information inside to convey more info about a conditional situation when needed. Condition objects are defined with define-condition macro, and a particular instance is created from a base condition object with make-condition function.
handler-case, handler-bind, restart-case - macros for creating new frame of the dynamic scope, in which the handlers, and restarts are bound to condition objects.

As well as:

cerror - a macro for raising a condition that can be ignored by invoking special continue restart.
ignore-errors - a macro for suppressing all errors, similarly to try with a catchall clause that does nothing.
unwind-protect - a macro for catching all errors, similar to try with just a finally clause.

All these macros share the very common part about setting up and cleaning the dynamic scope, as well as some pcall trickery to make it all work, which makes it a good entry point to understand what’s happening under the hood.

The dynamic scope

Beware, this is going to get really messy. Dynamic scoping is a foreign concept for Lua, so we have to deal with it ourselves, and ensure that it is correct. But before we begin, I should illustrate the structure of the library:

fennel-conditions/
├─ impl/
│  ├─ condition-system.fnl
│  ├─ debugger.fnl
│  └─ utils.fnl
├─ init.fnl
└─ init-macros.fnl

The init.fnl, and init-macros.fnl at the top level are the main entry points for runtime functions, and macros. These modules depend on the impl/condition-system.fnl module - the library’s private API. Which in turn uses impl/debugger.fnl that holds implementation of the interactive debugger, and impl/utils.fnl which stores common functions, used by condition system and debugger. The main things we’re interested in are init.fnl, init-macros.fnl, and impl/condition-system.fnl - the meat and bones of the library.

The dynamic scope is stored in the impl.condition-system module and this module is required every time we need to access the dynamic scope. Lua has a system for caching required modules, so this is a rather cheap operation and this way we don’t need to expose dynamic scope in the global scope.

This is how the dynamic scope table is defined in impl.utils:

(local {: metadata : view} (require :fennel))

(local dynamic-scope
  (metadata:set
   {}
   :fnl/docstring
   "Dynamic scope for the condition system.

Dynamic scope is a maintained table where handlers and restarts are
stored thread-locally.  Thread name is obtained with
`coroutine.running` call and each thread holds a table with the
following keys `:handlers`, `:restarts`, and `:current-context`.
Handlers and restarts itselves are tables."))

It’s nothing special really, just an ordinary table, but the documentation string mentions several interesting points. First, that this is a maintained table, meaning that it should not be modified manually. Second, that it stores scopes in thread-local contexts, meaning that each thread will have its own dynamic scope table. Each such table in turn has a table for handlers, a separate table for restarts, and some current-context field, which we will cover a bit later.

So, to illustrate how the dynamic scope may look at some point of the program running:

{"thread: 0x564cab9a12a8"
 {:handlers {:handler {#<condition MalformedLogEntry: 0x564caba2c6e0>
                       #<function: 0x564cabb01500>}
             :handler-type "handler-bind"
             :parent {:handler {#<condition MalformedLogEntry: 0x564caba2c6e0>
                                #<function: 0x564caba5ccf0>}
                      :handler-type "handler-bind"
                      :parent {}
                      :target {}}
             :target {}}
  :restarts {:parent {:parent {:parent {}
                               :restart {:args ["ignore-val"]
                                         :name "ignore"
                                         :restart #<function: 0x564cabb01580>}
                               :target {}}
                      :restart {:args ["fixed-line"]
                                :name "reparse-line"
                                :restart #<function: 0x564cabaa7a10>}
                      :target {}}
             :restart {:args ["x"]
                       :name "use-value"
                       :restart #<function: 0x564caba5cd30>}
             :target {}}}}

This is the state of the dynamic scope when we enter the restart-case macro and do all setups, in the fennel code from the example section. There’s quite a lot happening here - lots of nested tables with similar internal structures, and even some empty tables.

First thing you can spot is that the outermost table has a key "thread: 0x564cab9a12a8" which holds the table with handlers and restarts. This is the thread-local dynamic scope, representing the main thread. Inside of it in the table under the handlers key, we see a table with a handler key holding a table with a condition, (which is actually just another table²), and a function:

{:handler {#<condition MalformedLogEntry: 0x564caba2c6e0>
           #<function: 0x564cabb01500>}
 :handler-type "handler-bind"
 :parent {:handler {#<condition MalformedLogEntry: 0x564caba2c6e0>
                    #<function: 0x564caba5ccf0>}
          :handler-type "handler-bind"
          :parent {}
          :target {}}
 :target {}}

This table corresponds to all dynamic scopes set up with handler-bind macros. But as you can see here, it has a parent key, that holds another very similar table, but as you might remember, there was only one handler-bind instance in the example code - why there are two tables? Here’s a quick refresher of how handler-bind was used:

(handler-bind [MalformedLogEntry
               (fn [e {: line}]
                 (match (fix-line line)
                   fixed-line (invoke-restart :reparse-line fixed-line)))
               MalformedLogEntry
               (fn [e {: line}]
                 (io.stderr:write (.. "malformed log entry: " line "\n"))
                 (invoke-restart :ignore nil))]
  ;; ---- 8< ----
  )

Note that there are two separate entries for MalformedLogEntry condition. Each such entry creates a separate frame in the dynamic scope, which results in two nested tables as shown above. This is done this way because the handlers are bound sequentially, and their order in the handler bind determines the order of how they will be called. We directly use this property, by writing the first handler in such a way, that if the line can’t be fixed with fix-line function, we are not calling invoke-restart and the condition falls through to the next handler. This handler in turn calls :ignore restart, and successfully recovers from the error. Now let’s look at the dynamic scope stored under :restarts:

{:parent {:parent {:parent {}
                   :restart {:args ["ignore-val"]
                             :name "ignore"
                             :restart #<function: 0x564cabb01580>}
                   :target {}}
          :restart {:args ["fixed-line"]
                    :name "reparse-line"
                    :restart #<function: 0x564cabaa7a10>}
          :target {}}
 :restart {:args ["x"]
           :name "use-value"
           :restart #<function: 0x564caba5cd30>}
 :target {}}

Very similarly, each level stores a :restart table, with an argument list, name, and the function itself. Under the :parent key, the very similar table is stored, holding the next restart. Since our code defined three restarts, we get a table of the depth of three. One might wonder, why this is necessary, restarts are selected and not tried in order. While this is true, nothing prevents you from creating two restarts with the same name:

(restart-case
    (/ 1 nil)
  (:use-value [x] x)
  (:use-value [x] x))

This will create the following table:

{:parent {:parent {}
          :restart {:args ["x"]
                    :name "use-value"
                    :restart #<function: 0x564cabb01380>}
          :target {}}
 :restart {:args ["x"]
           :name "use-value"
           :restart #<function: 0x564cabaa5b40>}
 :target {}}

You then will be able to choose which restart to call via the interactive debugger interface. But more about that later.

Now that we have a rough understanding of how dynamic scopes are composed inside, let’s look at how those are really constructed.

Constructing dynamic scope for handlers

Let’s look at the handler-bind macro invocation once again:

(handler-bind [MalformedLogEntry
               (fn [e {: line}]
                 (match (fix-line line)
                   fixed-line (invoke-restart :reparse-line fixed-line)))
               MalformedLogEntry
               (fn [e {: line}]
                 (io.stderr:write (.. "malformed log entry: " line "\n"))
                 (invoke-restart :ignore nil))]
  ;; ---- 8< ----
  )

Much like let, it accepts a vector of bindings - a condition object, and a function that will be called. Similarly to let it binds sequentially, but doesn’t override bindings, but creates a set of nested scope frames to store each binding. Then it executes the body in the context of this dynamic scope.

Let’s look at the actual implementation and break it down:

(fn handler-bind [binding-vec ...]
  (let [target (gensym :target)
        scope (gensym :scope)
        binding-len (length binding-vec)
        setup '(do)]
    (assert-compile (= (% binding-len 2) 0)
                    "expected even number of signal/handler bindings"
                    binding-vec)
    (for [i binding-len 1 -2]
      (let [condition-object (. binding-vec (- i 1))
            handler (. binding-vec i)]
        (assert-compile (or (sym? handler) (function-form? handler))
                        "handler must be a function"
                        handler)
        (table.insert setup `(assert (not= nil ,condition-object)
                                     "condition object must not be nil"))
        (table.insert
         setup
         `(tset ,scope :handlers {:parent (. ,scope :handlers)
                                  :target ,target
                                  :handler-type :handler-bind
                                  :handler {,condition-object
                                            ,handler}}))))
    `(let [,target {}
           {:pack pack#} (require ,utils)
           {:pcall-handler-bind pcall-handler-bind#} (require ,condition-system)
           ,scope ,(current-scope)
           orig-handlers# (. ,scope :handlers)]
       ,setup
       (pcall-handler-bind#
        #(pack# (do ,...)) ,scope ,target orig-handlers#))))

This is the entirety of handler-bind macro, minus the docstring and some comments, and while the actual body that gets spliced into the program’s source code is not very big, the setup looks somewhat complicated. So let’s break it down.

(fn handler-bind [binding-vec ...]
  (let [target (gensym :target)
        scope (gensym :scope)
        binding-len (length binding-vec)
        setup '(do)]
    (assert-compile (= (% binding-len 2) 0)
                    "expected even number of signal/handler bindings"
                    binding-vec)
    ;; ---- 8< ----
    ))

First, we create some unique names that we will use both at compile-time, and then at runtime. You might remember the :target key in tables, that represented the dynamic scope. This key is holding this target symbol, which we define at run time, but we need a way of putting it into the dynamic scope at compile-time, that’s why it’s defined here. I’ll explain why it’s an important key soon.

Next up is the scope, this is an instance of dynamic scope we’re going to construct at compile time. binding-len is just to avoid small pieces of code duplication, and the last one - setup is the code that will fill the missing bits of our dynamic scope at runtime.

After let, we’re doing a check, that the binding-vec, a vector that holds condition objects and their handlers, has an even amount of values. We can’t properly construct the dynamic scope if a handler is missing, so it’s a compile-time error.

Now for the main part - the for loop, which creates a set of instructions that will construct the dynamic scope:

;; ---- 8< ----
(for [i binding-len 1 -2]
  (let [condition-object (. binding-vec (- i 1))
        handler (. binding-vec i)]
    (assert-compile (or (sym? handler) (function-form? handler))
                    "handler must be a function"
                    handler)
    (table.insert setup `(assert (not= nil ,condition-object)
                                 "condition object must not be nil"))
    (table.insert
     setup
     `(tset ,scope :handlers {:parent (. ,scope :handlers)
                              :target ,target
                              :handler-type :handler-bind
                              :handler {,condition-object
                                        ,handler}}))))
;; ---- 8< ----

It does several things - first, it checks that the handler is either a symbol or a function form, i.e. a list that will evaluate a function definition. Next it inserts the runtime assertion, that verifies that the condition-object is not nil. And finally, the tset call is inserted, that will populate current scope’s :handlers table with a new table, that refers to the original table via the :parent key.

You’ve might notice that the loop actually goes backward. This is done to preserve the correct order when constructing nested tables. As the dynamic scope is constructed as a set of nested tables, the order of construction has to be reversed, so the travel order gets preserved. But this code doesn’t actually construct the scope, it just describes how to construct it. The last portion of the macro is what gets spliced into the user’s code, so let’s look at it:

;; ---- 8< ----
`(let [,target {}
       {:pack pack#} (require ,utils)
       {:pcall-handler-bind pcall-handler-bind#} (require ,condition-system)
       ,scope ,(current-scope)
       orig-handlers# (. ,scope :handlers)]
   ,setup
   (pcall-handler-bind#
    #(pack# (do ,...)) ,scope ,target orig-handlers#))

We’re finally setting some of those symbols, we’ve defined before! The ,target {} thing, is a way to make sure we get a unique object address that we can later compare, to determine if we’ve reached the correct destination when “unwinding”. Next, we import some helper functions, like pack# and pcall-handler-bind# - the first one is a portable table.pack implementation, and the last one is a runtime part of handler-bind.

After that, we’re calling something like current-scope. It is a commonly used part of all macros, so I’ve put it into another macro. In short, it just returns the current thread’s dynamic scope or creates it if it doesn’t exist yet. And right after that, you can see that we’re caching original handlers right before ,setup. This ,setup will splice in all that setup we’ve been constructing at compile, that will populate the current scope with new tables. And then we’re calling pcall-handler-bind# function with all necessary info.

So this code from the example:

(handler-bind [MalformedLogEntry
               (fn [e {: line}]
                 (match (fix-line line)
                   fixed-line (invoke-restart :reparse-line fixed-line)))
               MalformedLogEntry
               (fn [e {: line}]
                 (io.stderr:write (.. "malformed log entry: " line "\n"))
                 (invoke-restart :ignore nil))]
  (icollect [line (f:lines)]
    (parse-line line)))

uses handler-bind macro we’ve just examined. Let’s look at what this code expands to:

(let [target_1_ {}
      {:pack pack_10_auto} (require "fennel-conditions.impl.utils")
      {:pcall-handler-bind pcall-handler-bind_11_auto} (require "fennel-conditions.impl.condition-system")
      scope_2_ (let [cs_3_auto (require "fennel-conditions.impl.condition-system")
                     thread_4_auto (or (and coroutine
                                            coroutine.running
                                            (tostring (coroutine.running)))
                                       "main")]
                 (match (. cs_3_auto "dynamic-scope" thread_4_auto)
                   scope_5_auto scope_5_auto
                   _ (let [scope_5_auto {:handlers {} :restarts {}}]
                       (tset cs_3_auto "dynamic-scope" thread_4_auto scope_5_auto)
                       scope_5_auto)))
      orig-handlers_12_auto (. scope_2_ "handlers")]
  (do (assert (not= nil MalformedLogEntry) "condition object must not be nil")
      (tset scope_2_ "handlers"
            {:handler {MalformedLogEntry
                       (fn [e {:line line}]
                         (io.stderr:write (.. "malformed log entry: " line "\n"))
                         (invoke-restart "ignore" nil))}
             :handler-type "handler-bind"
             :parent (. scope_2_ "handlers")
             :target target_1_})
      (assert (not= nil MalformedLogEntry) "condition object must not be nil")
      (tset scope_2_ "handlers"
            {:handler {MalformedLogEntry
                       (fn [e {:line line}]
                         (match (fix-line line)
                           fixed-line (invoke-restart "reparse-line" fixed-line)))}
             :handler-type "handler-bind"
             :parent (. scope_2_ "handlers")
             :target target_1_}))
  (pcall-handler-bind_11_auto
   (hashfn (pack_10_auto (do (icollect [line (f:lines)]
                               (parse-line line)))))
   scope_2_ target_1_ orig-handlers_12_auto))

Quite a lot of code, and there are even more things going on when we’re calling the pcall-handler-bind function! But you can see that it does exactly what I’ve described above - requires some API functions, creates a thread-local scope, sets it up, and wraps our code with the pack function, for later execution. Let’s now look at what pcall-handler-bind does.

Implementing control transfer via protected calls

The pcall-handler-bind function is defined in the library’s private API:

(fn pcall-handler-bind [f scope target orig-handlers]
  "Call `f` in given `scope` and pass result up to `target`.
Restore dynamic scope handlers to `orig-handlers`."
  (let [(ok res) (pcall f)]
    (doto scope
      (tset :current-context nil)
      (tset :handlers orig-handlers))
    (if ok (unpack res)
        (match res
          {:state :handled : target}
          (raise res.type res.condition-object)
          {:state :error :message msg}
          (if (or scope.handlers.parent
                  scope.restarts.parent)
              (error res)
              (error msg 2))
          _ (error res)))))

Looks pretty simple, but this is because we delegate most of the work to other functions.

It starts with calling f in a protected call and immediately removes current-context from the scope, and sets handlers to the original handlers, which we’ve stored back at the macro side. Then, if the function exited successfully, we just return the results by unpacking those (for keeping nils in multiple value returns). But when the function didn’t succeed, we expect a set of certain things as a return.

For those unfamiliar with match - it’s a pattern-matching macro from Fennel standard library. It accepts an expression, and a pair of patterns and their respective bodies to run, if the result of an expression matches this pattern. The first pattern here is {:state :handled :target target}, meaning that the function f returned a table with a key :state holding a :handled value, and a non-nil :target key that is equal to the value of target, passed as function argument. The table returned in this case usually looks like this:

{:state :handled
 :target {}
 :type :error
 :condition-object #<condition MalformedLogEntry: 0x564caba2c6e0>}

In this case, we raise the condition object stored in the result from calling f, with a correct type, meaning that the type is :error, we raise it as an error, or if it’s a :warning, as a warning and so on. We’ll look at raise in a moment, but for now, all you need to know is that it will throw the condition object further up.

If the pattern contained :state :error we check if we have more handlers up the dynamic scope, and if we do, we throw the result as is, so it could be handled. If not, that means that we’re already at a top level, so we convert this to Lua error with a message.

In all other cases this is an error that we want to throw up, as we can’t do anything about it because it is either not a conditional situation or target doesn’t match the expected one.

So the basic idea here is that we’re ensuring that the function will either succeed or fail as we expect, and if it fails in an unexpected way, we just rethrow the error. Lua doesn’t have a way to rethrow the stack traces, but it’s a small price to pay here.

Let’s look at raise now:

(fn raise [condition-type condition-object]
  "Raises `condition-object' as a condition of `condition-type'.
`condition-object' must not be `nil'."
  (assert (not= nil condition-object)
          "condition must not be nil")
  (let [thread (current-thread)
        thread-scope (do (when (not (. dynamic-scope thread))
                           (tset dynamic-scope thread {:handlers {} :restarts {}}))
                         (. dynamic-scope thread))]
    (when (= thread-scope.handlers.handler-type :handler-bind)
      (match thread-scope.current-context
             scope (let [target scope.target]
                     (var scope scope.parent)
                     (while (and scope (= target scope.target))
                       (set scope scope.parent))
                     (tset thread-scope :handlers scope))))
    (match condition-type
           :condition (raise-condition condition-object)
           :warning (raise-warning condition-object)
           :error (raise-error condition-object))))

This function does something interesting with current-context. As you saw in pcall-handler-bind, we’ve set the current-context to nil, but raise actually check it. Why?

This is because the condition can be raided inside the handler. In such a case, we need to unwind the stack to the point where we were in the handler. So each invocation of the handle function sets the current-context field, and this field is cleared when we exit the handler. This stack unwinding needs to be done in order to avoid infinite recursion, which will result in a stack overflow error.

After that is done, we branch on the condition type and raise the condition accordingly. For the purposes of this article let’s look at conditions of error type only, by looking at the raise-error function:

(fn raise-error [condition-object]
  (match (raise-condition condition-object :error)
    nil (if _G.condition-system-use-debugger?
            (invoke-debugger condition-object)
            (error (compose-error-message condition-object) 2))))

In case the condition is not handled it’s raised as a Lua error unless the debugger feature was enabled. The condition itself is raised with the raise-condition function:

(fn raise-condition [condition-object type*]
  (match (handle condition-object (or type* :condition))
    (where (or {:state :handled &as res}
               {:state :restarted &as res}))
    (error res 2)
    _ nil))

Here’s the handle innovation, mentioned above. The result can be either a table with :handled or :restarted states, each of which tells the condition system what to do next. Even though the condition is handled this result gets thrown up as an error because we actually need to tell the condition system that the condition was handled, and differentiate it from a successful return from the function.

So let’s look at how conditions are handled.

Handling conditions

The handle function looks like this:

(fn handle [condition-object type* ?scope]
  "Handle the `condition-object' of `type*' and optional `?scope`.

Finds the `condition-object' handler in the dynamic scope.  If found,
calls the handler, and returns a table with `:state` set to
`:handled`, and `:handler` bound to an anonymous function that calls
the restart."
  (let [thread (current-thread)
        thread-scope (. dynamic-scope thread)]
    (match (find-handler
            condition-object
            type*
            (or ?scope thread-scope.handlers))
      {: handler : scope}
      (do (tset thread-scope :current-context scope)
          (match scope.handler-type
            :handler-case {:state :handled
                           :handler #(handler condition-object (unpack (get-data condition-object)))
                           :target scope.target
                           :condition-object condition-object
                           :type type*}
            :handler-bind (do (handler condition-object (unpack (get-data condition-object)))
                              (handle condition-object type* scope.parent))
            _ {:state :error
               :message (.. "wrong handler-type: " (view _))
               :condition condition-object}))
      _ {:state :error
         :message (.. "no handler bound for condition: "
                      (get-name condition-object))
         :condition condition-object})))

Let’s dive into it.

After getting the current thread and the scope, we call find-handler. For now, it’s enough to know, that it takes a condition object, and walks the dynamic scope comparing this object to handlers. Next up, if the handler were found, we set the current-context to the handler’s scope. This will ensure that we know where we last were before actually executing a handler, so we could unwind the stack to this point in case an error happens inside the handler. This was a very painful thing to figure out when I worked on the implementation.

After that, we branch on the handler type. The handler-case macro allows handling without calling invoke-restart, so we just return a table with :state set to :handled, and a handler that actually does the handling.

The handler-bind is different - it requires handling with invoke-restart, which, as you might remember throws an error to transfer control flow. So if the handler function exited normally, we go to the next handle invocation, which will propagate the condition object to another handler up the stack. This ensures that we can decline to handle a condition.

If no handler is found the error is returned.

A similar pattern occurs for other condition types, with the difference being that some may not return an actual error when unhandled.

So how handlers are found? The find-handler function, which accepts a condition object and a handler type, will walk the scope comparing the given condition object to bound handlers. However, condition objects actually support inheritance, so this gets a bit more complicated. We need to look for a handler in the current scope, and if no handler is found, we need to get the parent from the condition object and search its handler in the same scope. If no handler and no parent handler are to be found, we go to the next scope frame.

Additionally, conditions may not be of the condition-object type, but be an arbitrary Lua value:

(handler-case (signal (math.random 5))
  (0 [] :zero)
  (1 [] :one)
  (2 [] :two)
  (Condition [] :else))

;; an unnecessarily complicated equivalent of

(match (math.random 5)
  0 :zero
  1 :one
  2 :two
  _ :else)

Notice, that while I’m handling conditions as numbers, the catch-all condition object is specified as Condition. Let’s talk more about condition inheritance.

Condition inheritance

As was already mentioned, condition objects can have parent condition objects. A parent can be explicitly set by using the :parent key when defining a condition:

(define-condition MathError)
(define-condition DivideByZero :parent MathError)
(define-condition NegSquareRoot :parent MathError)

(fn sqrt [x]
  (if (< x 0)
      (error (make-condition NegSquareRoot x))
      (math.sqrt x)))

(fn div [a b]
  (if (= b 0)
      (error (make-condition DivideByZero))
      (/ a b)))

(fn main []
  (handler-case (sqrt -1)
    (MathError [_ x] (io.stderr:write "Can't take square root of " x "\n")))
  (handler-case (div 2 0)
    (MathError [_ x] (io.stderr:write "Can't divide by zero\n"))))

Here’s an example of handling different errors through their common parent. You can create hierarchical errors, which then can be handled with more granularity, or as a whole class of errors.

But there are a bit more rules regarding inheritance. All conditions raised with error function will by default inherit from the Error condition. All conditions raised with warn will inherit from a Warning condition. Both Warning and Error are inherited from the Condition condition.

This also applies to any arbitrary data you can throw with error, warn, or signal:

(fn raise-random-condition []
  (match (math.random 2)
    0 (error "an error")
    1 (signal "a signal")
    2 (warn "a warning")))

(handler-case
    (raise-random-condition)
  (Error [msg] (print "caught an error" msg))
  (Warning [msg] (print "caught a warning" msg))
  (Condition [msg] (print "caught a condition" msg)))

Here all conditions are just Lua strings, but we still have some hierarchy. Note that the order of handlers here is very important - placing the (Condition [msg] (print "caught a condition" msg)) as the first handler will prevent Error and Warning handlers from ever running. It is very similar to match in that regard - placing _ as the first pattern will make all other patterns unreachable.

Another thing to point out is that Lua errors also inherit from Error condition:

(handler-case (/ 1 nil)
  (Error [] 0))

This is done for seamless integration with libraries that don’t use the condition system, or if your code did something wrong by mistake.

However, the integration is not as seamless as it could be. The point where it get’s not as good as it could be is when interfacing with the interactive debugger, provided by the library.

The debugger

Speaking of which, the debugger is not as featureful as in Common Lisp, but still provides a way to recover from an error, when the current scope allows for it. Consider this:

(restart-case (cs.error 10)
  (:use-value [x] x))

Executing this code will raise a condition, which is not handled, so it gets propagated to a Lua error:

runtime error: condition 10 was raised

However, if we set _G.condition-system-use-debugger? to true, we’ll get this instead:

Debugger was invoked on unhandled condition: 10
restarts (invokable by number or by name):
  1: [use-value] use-value
  2: [throw    ] Throw condition as a Lua error
debugger>>

Now every unhandled condition will invoke the debugger, which will provide you with available recovery options. In the case of this example, there are two restarts bound - use-value, bound by the restart-case macro, and the other one is an automatically bound throw restart, that will exit the debugger.

By typing 1 or use-value in the prompt, we’ll enter the next prompt, that asks for a value to use for a selected restart:

debugger>> 1
Provide inputs for use-value (args: [x]) (^D to cancel)
debugger:use-value>> 5
5

Thus making the result of the expression to be 5, accordingly to the restart’s body.

This debugger has no runtime penalty unless the condition was not handled. So only When an unhandled condition pops to the top of the dynamic scope stack, the debugger begins its work.

Debugger again traverses the scope, gathering all available restarts, and forms this interactive prompt, with each restart in order of their definition:

(restart-case
    (restart-case
        (restart-case (/ 1 nil)
          (:use-value [x] x)
          (:use-value [x] "use-value (impostor)" (- x)))
      (:do-something [] (+ 1 2 3)))
  (:do-something-else [] (- 3 2 1)))

Note that the use-value restart was specified twice. I’ve mentioned that this is possible, but it is meaningless unless we use a debugger. Here’s what will be prompted to the user, if this code is executed:

Debugger was invoked on unhandled condition: attempt to perform arithmetic on a nil value"
restarts (invokable by number or by name):
  1: [use-value        ] use-value
  2:                     use-value (impostor)
  3: [do-something     ] do-something
  4: [do-something-else] do-something-else
  5: [throw            ] Throw condition as a Lua error
debugger>>

Note that the first restart is indeed named use-value, but the second one has no name, only its docstring is displayed. This restart can be manually called by typing 2 in the prompt - it will ask for the argument similarly to use-value restart, but will negate it. Other restarts are self-explanatory.

Ending thoughts

This should provide some information about this library’s internals.

Seeing how many pcall calls it does to transfer control flow around, and how it manages the dynamic stack, can make you think that it has not a very good performance. And in fact, I would agree, the performance could be better. But it’s not that bad. For example, here’s a 10000000 invocations of Lua’s error function inside a pcall:

(macro time [expr times]
  `(let [c# os.clock
         s# (c#)
         r# ,expr
         e# (c#)]
     (print (.. "Average time elapsed " (/ (* 1000 (- e# s#)) ,(or times 1)) " ms"))
     r#))

(time (for [i 1 10000000]
        (pcall error 10))
      10000000)

;; Average time elapsed 0.0002025262 ms

And here’s an equivalent using condition system’s error and ignore-errors macro:

(local {: error} (require :condition-system))
(time (for [i 1 10000000]
        (ignore-errors (error 10)))
      10000000)
;; Average time elapsed 0.0051841138 ms

There’s one order of magnitude difference in performance here, meaning that ignore-errors is ~10 times slower than pure pcall. But the benefits, that the condition system provides, out-weight this cost, in my opinion.

Also, a note on why I didn’t port the rest of Common Lisp’s condition system. While this library is not a full port, I think it has all the necessary parts in the context of the Fennel language. What I mean by that is, that since Fennel, for example, deliberately chose to avoid Lua’s return special, I don’t think a condition system should provide block and return, or go specials. I don’t have strong reasoning behind it, but I feel that the error handling part in Lua is what’s needed to be improved, thus this library is only aimed at fixing this part of the runtime.

In Common Lisp there are more ways to recover from an error from the handler bound with handler-bind, but fennel-conditions library doesn’t implement all those ways. ↩︎
Tables, tables, tables, tables, tables… tables, and tables - that’s Lua at its best. ↩︎

Comment via email

Condition system in Clojure

Sat, 17 Apr 2021 20:40:00 +0300

A while ago I’ve watched this amazing talk: Condition Systems in an Exceptional Language by Chris Houser. And more recently I’ve found one interesting library called farolero, which provides a set of functions and macros that mimic Common Lisp’s condition system. So I was generally interested in the topic and decided to give it a shot and try both approaches. But before we can appreciate the condition system and its error handling capabilities, we need to look at how errors are generally handled in Clojure. So let’s start with the classic Clojure/Java approach of throwing and catching exceptions.

Exception-based error handling

The examples in the talk are based on the examples from the book called “Practical Common Lisp”, and while these are great examples, I still find it a bit overburdened with details. I think the main reason for this is that we have four functions to think about, each of which tries to take its part, and demonstrate how we could design such error handling in our application. Sure this can provide a great way to show how we can handle errors on different levels, but it can also confuse a lot of people who don’t know about the condition system. It was definitively confusing for me at first read at the very least, so let’s use a more simple example with one or two functions instead. We can always add more complexity later if we want to expand.

Let’s say we want to parse a date string, and we want to check if the date is a correct leap date as well. We can do this with this regular expression:

(def ^:const date-re
  (re-pattern (str #"(?:(?:(?:0[1-9]|1[0-9]|2[0-8])-(?:0[1-9]|1[012]))|(?:29|30|31)-(?:0[13578]|1[02])|(?:29|30)-(?:0[4,6,9]|11))-(?:19|[2-9][0-9])\d\d"
                   #"|(?:29-02-(?:19|[2-9][0-9])(?:00|04|08|12|16|20|24|28|32|36|40|44|48|52|56|60|64|68|72|76|80|84|88|92|96))")))

You don’t really need to dig into this regexp, all you need to know is that it handles dates formatted as dd-MM-yyyy, and correctly detects leap dates. Now we can write a function that parses the date string:

(import '[java.time LocalDate])
(import '[java.time.format DateTimeFormatter])

(defn parse-date
  "Parse `date` string into Java `LocalDate`"
  [date]
  (if-let [date (and (string? date) (re-find date-re date))]
    (LocalDate/parse date (DateTimeFormatter/ofPattern "dd-MM-yyyy"))
    (throw (ex-info "invalid date" {:data date}))))

So, if our date is a valid one, we parse it to LocalDate. If date is not valid, we throw an exception, because we don’t know how to deal with invalid dates at this level, so hopefully, the higher scope will catch the exception and deal with it.

Now, we can use this function to convert all valid dates and filter out invalid ones like this:

(keep #(try
         (parse-date %)
         (catch Exception e
           ;; simple error logging
           (println (ex-message e) (:data (ex-data e)))))
      ["29-02-2020" "29-02-2021" "12-34-5678"])
;; invalid date 29-02-2021
;; invalid date 12-34-5678
;; => (#object[java.time.LocalDate 0x194a4280 "2020-02-29"])

When we call this keep we successfully parse the first date, but fail to parse other ones, because there’s no February 29th in 2021, and the last one is plain wrong, so we log it with println and move on. But let’s assume that we’re OK with this wrong leap date, we just want to transform it into March 1st of 2021. Let’s write a function that checks if the given date is indeed February 29th, and transforms it. If the date is not a leap one, we again throw an exception:

(defn reparse-leap-date [date]
  (if-let [[_ year] (and (string? date)
                         (re-find #"29-02-((?::19|[2-9][0-9])\d\d)" date))]
    (let [next-day (str "01-03-" year)]
      (println (format "Wrong leap date: %s, using %s instead" date next-day))
      (parse-date next-day))
    (throw (ex-info "Not a leap date" {:data date}))))

Now we can try to re-parse the date of the initial parse has failed, but we also now have another exception to deal with, so we wrap everything in another try:

(keep #(try
         (parse-date %)
         (catch Exception e
           (try (reparse-leap-date (:data (ex-data e)))
                (catch Exception e
                  (println (ex-message e) (:data (ex-data e)))))))
      ["29-02-2020" "29-02-2021" "12-34-5678"])
;; Wrong leap date: 29-02-2021, using 01-03-2021 instead
;; Not a leap date 12-34-5678
;; => (#object[java.time.LocalDate 0x102d92c4 "2020-02-29"]
;;     #object[java.time.LocalDate 0x2b97cc1f "2021-03-01"])

Now one can say, that we’ve written the code, that successfully recovers from errors while parsing dates. However, the problem here, is that we had to incorporate our error handling into the function we’re passing to keep (in our case an anonymous function). We may want to promote this to a named function and share it with some other places in our program, but such places may not be OK with converting wrong leap dates. Or, the caller of this promoted function will not be OK with it returning nil, when the date is invalid, and instead will have to do extra work around the function checking its return value.

So we may find ourselves with functions like parse-date-or-convert-leap, parse-date-or-log-invalid, e.t.c., or with a lot of anonymous functions, all of which will share the parse-date at it’s core. And throwing exceptions may be a bit costly, as exceptions are expensive, so this may not be the optimal strategy in the first place. So right now our options are either to write a lot of try catch mess, duplicate code, or handle errors somehow differently.

And actually, let’s think a bit more about this example. We’re detecting and signaling the error inside the parse-date function, but handling the actual error outside of this function. This means that we’re not really recovering from the error in the function which signaled it, but rather in the caller scope of that function. So outer function must know how to deal with the error in the inner function, and perhaps have some code that does what was supposedly needed from the function which threw an error.

Ideally, we would want to return to the exact place in the function where the error happened and do something about it instead. And this is what the condition system in Common Lisp allows us to do.

Conditions in pure Clojure

We can implement the condition system in Clojure using only inbuilt features of the language - mainly the dynamic scope. But first, let’s understand what the condition system actually is.

Common Lisp condition system is a very useful feature of the language, often used for error handling, and to do other interesting stuff as well. The main difference between conditions and exceptions is that exceptions are a two-part system, where one side signals the error, and another side decides how to handle it and actually handles it. In Common Lisp, conditions are a three-part system, with an additional thing, called restarts. This can be seen as that our catch block is separated into two parts - one will only decide how to recover from the error, and another will actually do the recovery part. In conventional exception systems, by the time you get an exception, you should already decide how to handle it. Furthermore, you have to deal with the exception outside of the place where it has actually happened, while in the condition system you can return to that place and restart the process.

So, the condition system consists of three main parts: signals, handlers, and restarts. We can think of signals as exceptions in Clojure, but a bit more general. Which means that we already have signals, however, we actually can’t use Java’s exceptions in the condition system to signal errors. An exception will still be used for stack unwinding, and the topmost error handling, where an unhandled signal will pop up as an exception, but ideally this will not happen. And handlers and restarts don’t really exist yet so we’ll have to define those manually.

So how we can do this in Clojure? First, we need to create the signal:

(defn ^:dynamic *invalid-date* [date]
  (throw (ex-info "invalid date" {:data date})))

That’s it. We’ve just moved the throw call into a separate dynamic function, which gave us the facility to replace this function’s behavior later with a custom handler. Now we can introduce some restarts:

(def ^:dynamic *use-value*)
(def ^:dynamic *log-invalid-date*)

This may not make much sense right now, as we’ve just created two more dynamic vars without any behavior, but we will assign some behavior in the function where we would use these restarts. Which we will do in the parse-date function:

(defn parse-date [date]
  (binding [*use-value* identity
            *log-invalid-date* (fn [date]
                                 (println "unable to parse" date))]
    (if-let [date (and (string? date) (re-find date-re date))]
      (LocalDate/parse date (DateTimeFormatter/ofPattern "dd-MM-yyyy"))
      (*invalid-date* date))))

In this binding form we’re assigning default behaviors to our restarts - you can think of it as restart-case in Common Lisp. The *use-value* restart is a pretty common restart, which means we will do the error recovery outside of the function, and pass the correct value for this function to use. The *log-invalid-date* restart is a simple logger that can be also used instead. We could add more restarts here if there were more ways to recover from the error, but let’s just stay with these two for now.

And in the if-let we’re checking if the date is a string and matches our regexp, and if not we’re using our *invalid-date* signal. Right now this signal will throw an exception, so if we will use this function in our keep, we’ll get an unhandled exception:

(keep parse-date ["29-02-2020" "29-02-2021" "12-34-5678"])

But now, we can register a handler to our signal, that will log our errors. We do this by using another binding:

(binding [*invalid-date* (fn [date] (*log-invalid-date* date))]
  (keep (bound-fn [date] (parse-date date))
        ["29-02-2020" "29-02-2021" "12-34-5678"]))
;; unable to parse 29-02-2021
;; unable to parse 12-34-5678
;; => (#object[java.time.LocalDate 0x102d92c4 "2020-02-29"])

Note: we have to use either doall or bound-fn in our keep call, as we’re in dynamic scope, and keep is lazy.

So, here we’re binding our *invalid-date* signal to use a *log-invalid-date* restart and continue. If we run this code, we’ll see two dates being logged and only one date lands on the resulting list of parsed dates. Now, let’s add a recovery, that will try to re-parse our date, and recover from the error.

To do so, we need to change our reparse-leap-date function like this:

(defn reparse-leap-date [date]
  (binding [*use-value* identity
            *log-invalid-date* #(println "unable to parse as leap date" %)]
    (if-let [[_ year] (and (string? date)
                           (re-find #"29-02-((?::19|[2-9][0-9])\d\d)" date))]
      (let [next-day (str "01-03-" year)]
        (println (format "Wrong leap date: %s, using %s instead" date next-day))
        (parse-date next-day))
      (*invalid-date* date))))

Again, we’re imitating the restart-case from Common Lisp with binding, in which we provide two restarts. And as in the previous version, if the date is not February 29th, we signal the error with *invalid-date* signal. So how we would use this function to recover?

One may think that we will just need to rebind *invalid-date* to a function that calls *use-value* restart, and provide the result of reparse-leap-date to this restart as an input. This is mostly true, but actually, there’s a bit of a problem. We need to remember that if our function can’t parse a date as a leap date, we’re signaling the error using the same signal we’ve just rebound. This is a recipe for stack overflow exception because we will call reparse-leap-date over and over again from *invalid-date* signal handler. So, generally speaking, once we’ve entered the handler, we need to bind the original signal’s value back, because we can’t be sure that by handling this signal, we will not receive it again:

(let [decline-invalid-date *invalid-date*]
  (binding [*invalid-date* (fn [date]
                             (binding [*invalid-date* decline-invalid-date]
                               (*use-value* (reparse-leap-date date))))]
    (keep (bound-fn [date] (parse-date date))
          ["29-02-2020" "29-02-2021" "12-34-5678"])))

This is how we invoke our *use-value* restart. It may seem a bit tricky at first glance, and we’re rebinding things in dynamic scope in a kinda special way, so let me explain what happens here.

The first thing we do is store our original signal value in the let binding as decline-invalid-date. We then bind our *invalid-date* signal to an anonymous function that, when called, binds *invalid-date* back to its original value stored in the closure, and executes the *use-value* restart. This restart receives the value from the reparse-leap-date function, which may use *invalid-date* signal, but it won’t be handled with this particular handler anymore, as we’ve just unbound it. This means, that if an error happens in reparse-leap-date, an exception will be thrown, as our *invalid-date* signal is bound to its original function which throws an exception. So to handle the error from the reparse-leap-date function we need another handler around the let block, which will use the logging restart for example:

(binding [*invalid-date* (fn [date] (*log-invalid-date* date))]
  (let [decline-invalid-date *invalid-date*]
    (binding [*invalid-date*
              (fn [date]
                (binding [*invalid-date* decline-invalid-date]
                  (*use-value* (reparse-leap-date date))))]
      (keep (bound-fn [date] (parse-date date))
            ["29-02-2020" "29-02-2021" "12-34-5678"]))))
;; Wrong leap date: 29-02-2021, using 01-03-2021 instead
;; unable to parse as leap date 12-34-5678
;; => (#object[java.time.LocalDate 0x551de37d "2020-02-29"]
;;     #object[java.time.LocalDate 0x6ef81f31 "2021-03-01"])

If we run this code we will get a list of two dates and a message in the log. The first date will be parsed correctly, the second one will be handled with the inner *invalid-date* handler, and the third date will be logged with the outer *invalid-date* handler. And, as a matter of fact, since the *log-invalid-date* restart will be called only from the decline-invalid-date function we just as well could register the handler in the inner binding, like this:

(binding [*invalid-date*
          (fn [date]
            (binding [*invalid-date* (fn [date] (*log-invalid-date* date))]
              (*use-value* (reparse-leap-date date))))]
  (keep (bound-fn [date] (parse-date date))
        ["29-02-2020" "29-02-2021" "12-34-5678"]))

So this is a flexible system.

But another great property of storing the original signal’s value in the let is that we can decline to handle the signal completely. This means, that we can add some logic into our handler, that analyzes its input value, decides whether it can handle or it should decline to handle this, and just propagate the error up the dynamic scope. This is why I’ve called original value decline-invalid-date because by calling it we will decline to handle the *invalid-date* error. And Common Lisp condition system also can do the same thing, except it’s a bit easier there. We do so by not calling the invoke-restart function in the handler, but since in our system there’s no invoke-restart at all, we have to save the signal value manually.

However, even though this system is pretty flexible it is also a bit too boilerplate. We have to do many things, that can be actually wrapped into macros, and the farolero library, I’ve mentioned earlier, provides that. Let’s see how our code above can look with more Common Lisp-like macros.

Farolero conditions and restarts

Farolero is a library, that provides a set of functions and macros that provide a condition system very similar to the one from Common Lisp. This is a fairly new library, but I’ve found it the most interesting one among the others, which provides condition systems for Clojure. First, let’s add it as a dependency. Create deps.edn file with the following contents:

{:deps {org.suskalo/farolero {:mvn/version "1.0.0-RC2"}}}

Alternatively you can use clj -Sdeps '{:deps {org.suskalo/farolero {:mvn/version "1.0.0-RC2"}}}' to start the REPL with this library available for require.

Now let’s require needed stuff, and rewrite our parse-date function:

(require '[farolero.core :refer [restart-case error handler-bind invoke-restart]])

(defn parse-date [date]
  (restart-case (if-let [date (and (string? date) (re-find date-re date))]
                  (LocalDate/parse date (DateTimeFormatter/ofPattern "dd-MM-yyyy"))
                  (error ::invalid-date date))
    (::use-value [value] value)
    (::log-invalid-date [date] (println "unable to parse" date))))

Here we’re using proper restart-case macro, which accepts the expression as the first argument, and restarts we desire to implement for this expression. In the expression we check date with our regular expression and if it doesn’t match, we’re calling error, which signals the ::invalid-date error with one argument date. Similarly to our previous example, we can handle this error by using the ::log-invalid-date restart:

(handler-bind [::invalid-date (fn [_condition date]
                                (invoke-restart ::log-invalid-date date))]
  (keep (bound-fn [date] (parse-date date)) ["29-02-2020" "29-02-2021" "12-34-5678"]))

Executing this code we will, as before, receive a list with one parsed date, and two messages in the log. To actually recover from the first error, we can bind this handler to a ::use-value restart, which we pass the value provided with reparse-leap-date function, but first we need to update it to use restarts as well:

(defn reparse-leap-date [date]
  (restart-case
      (if-let [[_ year] (and (string? date)
                             (re-find #"29-02-((?::19|[2-9][0-9])\d\d)" date))]
        (let [next-day (str "01-03-" year)]
          (println (format "Wrong leap date: %s, using %s instead" date next-day))
          (parse-date next-day))
        (error ::invalid-date date))
    (::use-value [value] value)
    (::log-invalid-date [date] (println "unable to parse as leap date" date))))

Note, that we’re signaling the same ::invalid-date with error function, and we had to deal with this in the dynamic scope solution previously, but this will not be problematic in the case of this library. We now can use this function to provide a value for the ::use-value restart as follows:

(handler-bind [::invalid-date
               (fn [_condition date]
                 (invoke-restart ::log-invalid-date date))]
  (handler-bind [::invalid-date
                 (fn [_condition date]
                   (invoke-restart ::use-value (reparse-leap-date date)))]
    (keep (bound-fn [date] (parse-date date))
          ["29-02-2020" "29-02-2021" "12-34-5678"])))
;; Wrong leap date: 29-02-2021, using 01-03-2021 instead
;; unable to parse as leap date 12-34-5678
;; => (#object[java.time.LocalDate 0x13741d5a "2020-02-29"]
;;     #object[java.time.LocalDate 0x6b69761b "2021-03-01"])

And I’ve already included the outer handler, that logs every unhandled date. This outer handler could have been defined as the inner handler around reparse-leap-date call, but I’ve used it outside just to show that we don’t have to deal with signal rebinding.

Compare this code to our no-libraries-required solution:

(binding [*invalid-date* (fn [date] (*log-invalid-date* date))]
  (let [decline-invalid-date *invalid-date*]
    (binding [*invalid-date*
              (fn [date]
                (binding [*invalid-date* decline-invalid-date]
                  (*use-value* (reparse-leap-date date))))]
      (keep (bound-fn [date] (parse-date date))
            ["29-02-2020" "29-02-2021" "12-34-5678"]))))

The difference is not that big and the structure is mostly the same. However, the code which uses farolero library is still much clearer, because there are no let and nested binding in handlers, which needed to provide ways to decline error handling and unwind the stack. And as a matter of fact, if we’re exiting the handler normally, e.g. not by using invoke-restart, we will decline error handling, and our signal will unwind the stack if there’s no other handler to catch it.

An additional feature, provided by the farolero library, is an interactive debugger, which is mostly the same as in Common Lisp (to my knowledge). This debugger allows us to handle unhandled signals by using provided restarts interactively. For example, if we remove the outermost handler-bind and execute the code as follows:

(handler-bind [::invalid-date
               (fn [_condition date]
                 (invoke-restart ::use-value (reparse-leap-date date)))]
  (keep (bound-fn [date] (parse-date date))
        ["29-02-2020" "29-02-2021" "12-34-5678"]))

We will see an interactive prompt that provides us with some information about the signal, and our restart options:

Debugger level 1 entered on :user/invalid-date
:user/invalid-date was signaled with arguments ("12-34-5678")
0 [:user/use-value] :user/use-value
1 [:user/log-invalid-date] :user/log-invalid-date
2 [:user/use-value] :user/use-value
3 [:user/log-invalid-date] :user/log-invalid-date
4 [:farolero.core/throw] Throw the condition as an exception
user>

Why this might not work for you (but still is an option)

One glaring problem with both of these approaches is that both are somewhat foreign to the language, even though both use just the features provided by the language. The advantage of the condition system in Common Lisp is that it is deeply integrated into the language, and conditions, signals, and restarts are widely used across all code, and not just to handle errors. In Java, and therefore in Clojure exceptions are the primary way of error handling. And actually, in Clojure we’re trying to avoid exceptions as much as possible, mostly using nil to tell that function has failed and then branching on return values.

If you think about it, if-some and try catch are two of the most common error handling patterns in Clojure - the first one is mainly used in plain Clojure, and the second one is when interacting with Java. This is a bit of a shame because both can’t provide all these features that the condition system has, and we can’t really run away from exceptions, given that so many java libraries use them.

Libraries like farolero, or the dynamic scope approach can close this gap a bit, however, as I’ve mentioned, the key advantage of the condition system in Common Lisp is that it is used everywhere. Whereas conditions in Clojure will only be an additional way of error handling, thus one more thing to think of and remember. Hence, some parts of the project will use exceptions, because of some libraries that throw them around, some parts will use nil-punning, and some will use conditions, which only may make it harder to maintain the project. Or you will have to wrap a lot of stuff to use your condition system of choice, which will add a lot of implementation details to the code.

Another point is that there are several ways of using the condition system in Clojure - either via some library or by using a dynamic scope. This is not a problem for a project that is more like an application rather than a library, but libraries should not expose their dependencies unless it’s absolutely necessary. Although by using dynamic vars to provide signals and restarts you’re not taking away traditional exception handling, you only provide an additional way to recover, and there’s no extra dependency at all.

This may seem that I’m mostly against the use of the condition system, but in fact, I think that you should at least try this approach, and understand where it would be the preferred way. Condition system really can make your application very robust, and provide very versatile ways to recover from errors. For example, with farolero you can even fix your application at runtime when an unhandled signal pops up by using the interactive debugger it provides. And since farolero also has some ways of handling exceptions as conditions, this may be a good choice even if you use exceptions in your codebase. But this needs more experimenting, and I’m definitively going to keep an eye on this library, as well as the others.

PF4J and Clojure

Sat, 10 Apr 2021 10:59:00 +0300

Today we’ll take a look at an interesting Java library, called PF4J, which describes itself as a Plugin Framework for Java. The main purpose of this library is to provide a way of detecting, initializing, and using plugins to extend your Java application with new features without the need to modify the code. The official repository has examples of how to use this library with Java, and Kotlin, but there is no Clojure example.

Recently I had to find a way how to use this library with Clojure, and it has turned a bit hard to achieve, because this library is very Javaish, if you know what I mean :). Classes, interfaces, and Java annotations are not the most common thing to see in Clojure, as we usually have no classes, interfaces, or annotations, but functions, data abstractions, and metadata. I’m not very experienced in Java bytecode inspection, and Clojure class generation, and I was unable to find any information on how to integrate PF4J and Clojure, so this post will explain what I’ve found so far. You know, so I would be able to refresh this if I ever again will need to use this library, or will find myself in a similar situation where I need to work with annotations or class generation. And hopefully, this information will be useful for others as well.

So here we will write an example plugin, in the same way how Java example plugins are written in the pf4j demo application. But first, let’s look at how the Java plugin is structured.

Anatomy of a plugin

The complete plugin consists of two main components - the plugin itself, and the extension point. We will take the .jar approach for storing and distributing plugins, as it is the easiest one to reach, and we can directly compare the bytecode of the Java plugin, and Clojure plugin. So let’s first create an extension point in Java.

Create project Greeting in your Java IDE of choice. I’m creating a maven project, so the first thing we’ll need is to add pf4j dependency to our pom.xml:

<!-- snip -->
<dependencies>
  <dependency>
    <groupId>org.pf4j</groupId>
    <artifactId>pf4j</artifactId>
    <version>3.6.0</version>
  </dependency>
</dependencies>
<!-- snap -->

Now we can create extension point class org.example.Greeting, and add this code into it:

package org.example;

import org.pf4j.ExtensionPoint;

public interface Greeting extends ExtensionPoint {
    String getGreeting();
}

This is all we need for our small extension point, and we can install it in our local repo with mvn install. AFAIU, extension point’s main purpose is to help PF4J detect particular plugins, and not all plugins.

Now we need the plugin itself. This plugin depends on both pf4j and this extension point we’ve just created and installed. Create a new project JavaWelcomePlugin, and add there pf4j dependency as explained above, and the org.example.Greeting dependency:

<!-- snip -->
<dependency>
  <groupId>org.example</groupId>
  <artifactId>Greeting</artifactId>
  <version>1.0-SNAPSHOT</version>
</dependency>
<!-- snap -->

Again, create a new class GreetingsPlugin:

package org.example;

import org.pf4j.Extension;
import org.pf4j.Plugin;
import org.pf4j.PluginWrapper;
import org.example.Greeting;

public class GreetingsPlugin extends Plugin {
    public GreetingsPlugin(PluginWrapper wrapper) {
        super(wrapper);
    }

    @Override
    public void start() { System.out.println("Java plugin start"); }

    @Override
    public void stop() { System.out.println("Java plugin stop"); }

    @Extension
    public static class Welcome implements Greeting {
        public String getGreeting() {
            return "Hi from Java!";
        }
    }
}

This plugin has start and stop methods that pf4j will call during initialization, and deinitialization of the plugin, and the main part here is the nested Welcome class. This class implements our Greeting extension point, and is annotated with @Extension, which helps pf4j discover this class during the build process.

One more thing we need to add to our pom.xml are new manifest entries. Pf4j expects each plugin to have at least two entries in MANIFEST.mf file in the .jar archive: Plugin-Version, and Plugin-ID. In our case, we will also need to add Plugin-Class entry, as we’ve created a wrapper class GreetingsPlugin. Add this to the pom.xml:

<!-- snip -->
<build>
  <plugins>
    <plugin>
      <groupId>org.apache.maven.plugins</groupId>
      <artifactId>maven-jar-plugin</artifactId>
      <configuration>
        <archive>
          <manifestEntries>
            <Plugin-ID>java-welcome-plugin</Plugin-ID>
            <Plugin-Class>org.example.GreetingsPlugin</Plugin-Class>
            <Plugin-Version>1.0</Plugin-Version>
          </manifestEntries>
        </archive>
      </configuration>
    </plugin>
  </plugins>
</build>
<!-- snap -->

It’s a bit too verbose (well, it is XML after all), but here we’re just adding these three entries to our manifest file during the build process. Now let’s package this plugin with the mvn package command.

This makes the complete example plugin in Java - much like the one in the demo application from PF4J examples. Both the interface and the plugin are written, and we can plug this code into any application, that looks for our Greeting interface. Now let’s test this plugin in a small Clojure program.

Writing Clojure program that uses plugins

Let’s create a small project based on the app template, that uses pf4j library, and loads this plugin we’ve just written in Java. I’m using Leiningen for project automation, but you may use deps or other tools if you prefer. But we will later need to edit project.clj and do some tweaks other than adding dependencies, so if you’re using deps you’re on your own here. For me, the command is:

$ lein new app pf4j-clj-app

A new project is created and we need to add org.pf4j/pf4j and org.example.Greeting dependencies to the :dependencies section in project.clj:

:dependencies [[org.clojure/clojure "1.10.1"]
               [org.pf4j/pf4j "3.6.0"]
               [org.example/Greeting "1.0-SNAPSHOT"]]

Rest of the project.clj can be left as is. Now, let’s write our -main function in the core.clj:

(ns pf4j-clj-app.core
  (:import [org.pf4j JarPluginManager]
           [org.example Greeting])
  (:gen-class))

(defn -main
  [& _]
  (let [plugin-manager (JarPluginManager.)]
    (doto plugin-manager
      (.loadPlugins)
      (.startPlugins))
    (let [greets (.getExtensions plugin-manager Greeting)]
      (println "Found" (count greets) "extensions for extension point" (.getName Greeting))
      (doseq [greet greets]
        (println (.getGreeting greet))))
    (doto plugin-manager
      (.stopPlugins)
      (.unloadPlugins))))

I’ll keep this brief - we’re importing our Greeting extension point, and the pf4j library, creating plugin-manager, loading and starting plugins. Then we print how many plugins we’ve found for the Greeting extension point, and execute the .getGreeting method for each plugin. And after that, we’re stopping and unloading plugins to keep things clean.

By default pf4j searches for jar plugins in the plugin directory at the root of the project. Let’s create this directory, copy our Java plugin there, and start our application with lein run:

$ mkdir plugins
$ cp path/to/JavaWelcomePlugin/target/JavaWelcomePlugin-1.0-SNAPSHOT.jar ./plugins/
$ lein run
SLF4J: Failed to load class "org.slf4j.impl.StaticLoggerBinder".
SLF4J: Defaulting to no-operation (NOP) logger implementation
SLF4J: See http://www.slf4j.org/codes.html#StaticLoggerBinder for further details.
Java plugin start
Found 1 extensions for extension point 'org.example.Greeting'
Hi from Java!
Java plugin stop

It works! We’ve seen the message from the start method, the getGreeting call result, and then the stop method message. Now let’s do everything in Clojure!

Clojure `ExtensionPoint` implementation

To make an extension point in Clojure, let’s create a new library project with lein new clj-greeting, and add needed changes to our project.clj:

(defproject org.example/Greeting "1.0-SNAPSHOT"
  :description "pf4j extension poin example in Clojure"
  :license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
            :url "https://www.eclipse.org/legal/epl-2.0/"}
  :dependencies [[org.clojure/clojure "1.10.1"]
                 [org.pf4j/pf4j "3.6.0"]]
  :aot :all)

I’ve mainly changed the project name from clj-greeting to org.example/Greeting so we could hot-swap our Java extension point to the Clojure one with simple lein install. Similarly, the version was changed to 1.0-SNAPSHOT to match the version of our Java extension point. The pf4j dependency was added to the :dependencies key. Lastly, :aot :all entry was added to make sure we AOT compile every file.

Now we can create our interface. To do so, first we need to create needed directories with src/org/example directories, and move core.clj to src/org/example/greeting.clj:

$ mkdir -p src/org/example
$ mv src/clj_greeting/core.clj src/org/example/greeting.clj
$ rmdir src/clj_greeting

Next, we add this code to greeting.clj:

(ns org.example.greeting
  (:import org.pf4j.ExtensionPoint))

(gen-interface
 :name org.example.Greeting
 :extends [org.pf4j.ExtensionPoint]
 :methods [[getGreeting [] String]])

Here, we’re creating an interface with gen-inteface and naming it to org.example.Greeting. This interface extends the org.pf4j.ExtensionPoint class, and exposes one method getGreeting which takes zero arguments, and returns a String.

Let’s package this as a jar archive with lein jar command, and see its contents with zipinfo. If you don’t have zipinfo you can use any other way to view archives. Here are the contents:

lein jar && zipinfo -1 target/Greeting-1.0-SNAPSHOT.jar
Compiling clj-greetings.core
Created /home/alistopadov/Git/clj-greetings/target/Greeting-1.0-SNAPSHOT.jar
META-INF/MANIFEST.MF
META-INF/maven/org.example/Greeting/pom.xml
META-INF/leiningen/org.example/Greeting/project.clj
META-INF/leiningen/org.example/Greeting/README.md
META-INF/leiningen/org.example/Greeting/LICENSE
META-INF/
META-INF/maven/
META-INF/maven/org.example/
META-INF/maven/org.example/Greeting/
META-INF/maven/org.example/Greeting/pom.properties
org/
org/example/
org/example/Greeting.class
clj_greetings/
clj_greetings/core__init.class
clj_greetings/core$loading__6721__auto____171.class
clj_greetings/core$fn__173.class
clj_greetings/core.clj

We’re mainly interested in the org/example/Greeting.class entry. Let’s decompile it. This can be either done with Intellij Idea or by using fernflower directly. The decompiled bytecode looks like this:

package org.example;

import org.pf4j.ExtensionPoint;

public interface Greeting extends ExtensionPoint {
   String getGreeting();
}

And this looks exactly like the Java example we’ve written before. Great, let’s test it!

We do this by installing this extension point in place of our Java one, by using the lein install command (you can remove the old extension from the .m2 directory for extra safety). Then we need to repackage our Java plugin and copy it again to our Clojure application. When we run it, we should see the same output:

Java plugin start
Found 1 extension for extension point org. example.Greeting
Hi from Java!
Java plugin stop

So, our extension point is now implemented in Clojure. Now we can write the plugin itself!

PF4J plugin in Clojure

To write a plugin let’s create another project with lein new clj-welcome-plugin. Again, we need to alter project.clj a bit:

(defproject clj-welcome-plugin "0.1.0-SNAPSHOT"
  :description "pf4j plugin example in Clojure"
  :license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
            :url "https://www.eclipse.org/legal/epl-2.0/"}
  :dependencies [[org.clojure/clojure "1.10.1"]
                 [org.pf4j/pf4j "3.6.0"]
                 [org.example/Greeting "1.0-SNAPSHOT"]]
  :manifest {"Plugin-Id" "clojure-welcome-plugin"
             "Plugin-Version" "0.1.0"
             "Plugin-Class" "clj_welcome_plugin.GreetingsPlugin"}
  :aot :all)

Again, we’re adding :aot :all entry and the :manifest key with a map of keys and values of manifest entries we need to add. Thankfully, Leiningen makes it really easy to deal with this, compared to pom.xml we’ve had to modify previously.

Now, we need to create a wrapper class, and the @Extension class, and here’s a problem. To my knowledge, there’s no way to write nested classes in Clojure. And annotations are also a bit finicky. So let’s approach this step by step.

The first thing we’ve done in Java code was import all needed libraries, and create a class that extended Plugin class:

package org.example;

import org.pf4j.Extension;
import org.pf4j.Plugin;
import org.pf4j.PluginWrapper;
import org.example.Greeting;

public class GreetingsPlugin extends Plugin {
    public GreetingsPlugin(PluginWrapper wrapper) {
        super(wrapper);
    }
    /* ... */
}

Let’s do the same in Clojure. We start by renaming the core.clj to greetings_plugin.clj, and importing all needed libraries, also saying that our :gen-class has no main and :extends org.pf4j.Plugin:

(ns clj-welcome-plugin.greetings-plugin
  (:import [org.pf4j Plugin PluginWrapper Extension]
           [org.example Greeting])
  (:gen-class
   :name clj_welcome_plugin.GreetingsPlugin
   :main false
   :extends org.pf4j.Plugin))

So far so good. Now we need a constructor, but in our case, Clojure has already generated one, which we can see by compiling our code into the jar file, and looking through the bytecode:

package clj_welcome_plugin;

/* Clojure imports */
import org.pf4j.Plugin;
import org.pf4j.PluginWrapper;

public class GreetingsPlugin extends Plugin {
   /* some initialization Clojure stuff */

   public GreetingsPlugin(PluginWrapper var1) {
      super(var1);
   }

   /* rest of the Clojure stuff */
}

A custom constructor can be provided by using the :init key in :gen-class, but I’ll leave it out to the reader.

Now we can add start and stop methods:

(defn -start [_]
  (println "Clojure plugin start"))

(defn -stop [_]
  (println "Clojure plugin stop"))

And this basically completes our wrapper class, so how do we add a nested class? Well, actually, from a bytecode standpoint this is not a nested class, and the outer class simply acts as a namespace. We can actually see that in the contents of the jar file which contains compiled code of our Java plugin:

org/example/GreetingsPlugin.class
org/example/GreetingsPlugin$Welcome.class

So the inner public static Welcome class is actually a separate .class file, and we can replicate this in Clojure pretty easily. Let’s add another call to gen-class in the same file:

(gen-class
 :name ^{org.pf4j.Extension {}} clj_welcome_plugin.GreetingsPlugin$Welcome
 :prefix "impl-"
 :implements [org.example.Greeting])

(defn impl-getGreeting [_] "Hi from Clojure!")

Or we can create another file, and use :gen-class there, but to match Java plugin source code layout, I’m using the single file.

The most important thing here is the :name key. You can see that we’re providing a metadata entry ^{org.pf4j.Extension {}} which is a way to add Java annotation to a class. And we’re naming our class as clj_welcome_plugin.GreetingsPlugin$Welcome. Lastly, the :implements key is used to tell, that our class implements our extension point. And because we’re using the same file, we change :prefix to "impl-", and the getGreeting method is defined as impl-getGreeting.

Let’s compile our code with lein jar again, and see if we’ve managed to replicate the .class layout in the jar archive:

$ lein jar && zipinfo -1 target/clj-welcome-plugin-0.1.0-SNAPSHOT.jar
...
META-INF/MANIFEST.MF
META-INF/leiningen/...
META-INF/maven/...
clj_welcome_plugin/GreetingsPlugin.class
clj_welcome_plugin/GreetingsPlugin$Welcome.class
...

Great! Let’s see if our GreetingsPlugin$Welcome.class actually decompiles to correct class:

package clj_welcome_plugin;

/* Clojure imports */
import org.example.Greeting;
import org.pf4j.Extension;

@Extension
public class GreetingsPlugin$Welcome implements Greeting {
   /* Clojure stuff */
   public String getGreeting() {
      Var var10000 = getGreeting__var;
      Object var1 = getGreeting__var.isBound() ? var10000.get() : null;
      if (var1 != null) {
         return (String)((IFn)var1).invoke(this);
      } else {
         throw new UnsupportedOperationException("getGreeting (clj-welcome-plugin.greetings-plugin/impl-getGreeting not defined?)");
      }
   }
}

And it is! We can see the @Extension annotation, and public class GreetingsPlugin$Welcome that implements Greeting extension point. Later, after some Clojure internal code, we can see our getGreeting method definition.

However, if we try to use this plugin, it will not work just yet:

$ cp path/to/clj-welcome-plugin/target/clj-welcome-plugin-0.1.0-SNAPSHOT.jar ./plugins/
$ lein run
SLF4J: Failed to load class "org.slf4j.impl.StaticLoggerBinder".
SLF4J: Defaulting to no-operation (NOP) logger implementation
SLF4J: See http://www.slf4j.org/codes.html#StaticLoggerBinder for further details.
Java plugin start
Found 1 extensions for extension point 'org.example.Greeting'
Hi from Java!
Java plugin stop

Still, only the Java plugin runs. This took me some time to figure out why it doesn’t work - the .class files layout of the resulting .jar archives are the same. Decompiled classes, except for the Clojure stuff, look the same as Java classes.

The catch is, that when we’re building our Java plugin with mvn package, the extra file extensions.idx is created in the META-INF directory of the archive. Let’s look at this file:

# Generated by PF4J
org.example.GreetingsPlugin$Welcome

Aha! This file contains the necessary info to detect the @Extension annotated class in the jar archive and is generated by processing Java annotation during compilation. Unfortunately, the Clojure compiler doesn’t try to process our metadata as Java annotation, and hence no file is created. But we can add this file by hand, by creating META-INF/extensions.idx in the resources directory with the following contents:

clj_welcome_plugin.GreetingsPlugin$Welcome

Here, we’re indicating that our @Extension class is clj_welcome_plugin.GreetingsPlugin$Welcome. Let’s re-package our plugin with lein jar, and re-run our app:

$ cp path/to/clj-welcome-plugin/target/clj-welcome-plugin-0.1.0-SNAPSHOT.jar ./plugins/
$ lein run
SLF4J: Failed to load class "org.slf4j.impl.StaticLoggerBinder".
SLF4J: Defaulting to no-operation (NOP) logger implementation
SLF4J: See http://www.slf4j.org/codes.html#StaticLoggerBinder for further details.
Clojure plugin start
Java plugin start
Found 2 extensions for extension point 'org.example.Greeting'
Hi from Clojure!
Hi from Java!
Java plugin stop
Clojure plugin stop

It works! Now we can make a more complex app, and extend it with plugins written both in Java and Clojure. Of course, more complex plugins will be bigger and have more code, but the general idea will be the same.

Some ending notes

You don’t have to put both the wrapper class and the Extension class in the same file. I mainly did this because it is in line with the Java code, so sources could be compared mostly directly. But a separate file, that sets the class name in a similar way is a more clean approach and should be preferred.

There’s also no need to rename most of the classes, except for the @Extension one, as we have to explicitly make it into a nested class via $ notation. Again, I’ve mainly done this to keep more or less the same code structure with the Java examples, for easier direct comparison.

Lastly, some automation may be needed to generate extensions.idx file based on source code. Unfortunately, I’ve not found any info on how to make Java annotation processing work with Clojure metadata annotations. So I’ve done this manually, but I’ve also written this script, that analyzes Clojure source code as EDN, and searches for given extension point class, printing class name from gen-class form if present:

#!/usr/bin/env bb

(require '[clojure.edn :as edn])
(require '[clojure.string :as str])

(defn analyze-gen-class
  "Tests if `form` is a `gen-class` and gets the `:name` or uses the
  `default` if `:name` is not set, but `:implements` matches the
  `query`.  Replaces all dashes with underscores in case the `default`
  name came from the `ns` form."
  ([form query]
   (analyze-gen-class form query nil))
  ([form query default]
   (when (and (list? form)
              (#{:gen-class 'gen-class} (first form))
              (some #{:implements} form))
     (let [gencl (->> form
                      (drop 1)
                      (partition 2)
                      (into {} (map vec)))]
       (when-let [name (and (= (:implements gencl) query)
                            (get gencl :name default))]
         (str/replace name #"-" "_"))))))

(defn analyze-ns
  "The `ns` form already contains class name as a namespace name,
  but we check inner `:gen-class` for a `:name` override."
  [form query]
  (let [name (second form)]
    (some #(analyze-gen-class % query name) form)))

(defn analyze-form
  "Check whether current `form` is a `gen-class` or `:gen-class` expression.
  If it is, check if gen-class has `:implements` key that is equal to
  `query` and gets the value of the `:name` key.  If `form` is an `ns`
  form finds `:gen-class` in it and checks it as above.  Recursively
  analyzes nested lists.  Terminates at first successful analysis."
  [query form]
  (when (list? form)
    (cond (= 'ns (first form)) (analyze-ns form query)
          (some list? form) (some #(analyze-form query %) form)
          :else (analyze-gen-class form query))))

(let [[query] *command-line-args*]
  (doseq [form *input*]
    (when-let [name (analyze-form
                     (edn/read-string query)
                     form)]
      (println name))))

This is a Babashka script, which analyzes S-expressions, and can be used together with another tool for parsing EDN - Jet (huge thanks to Michiel Borkent for awesome Clojure tooling!):

$ jet -c < src/clj_welcome_plugin/greetings_plugin.clj | ~/script.clj "[org.example.Greeting]"
clj_welcome_plugin.GreetingsPlugin$Welcome

Or, similarly for every .clj file in the project:

$ find -name '*.clj' -exec sh -c 'jet -c < "{}" | ~/script.clj "[org.example.Greeting]"' \;
clj_welcome_plugin.GreetingsPlugin$Welcome

For this project, the script finds the extension class name correctly from the source code we’ve given to it, but it is more a proof of concept, and by far is not a well-tested solution.

One particular point to improve is the fact that we have to pass "[org.example.Greeting]" to the script, to help it find gen-class entries that implement the interface we’re interested in. A much better solution would be to parse metadata, but unfortunately, I was not able to make Jet keep metadata in the resulting EDN, and I’m not sure how to properly read Clojure source code files otherwise. Although, it’s not really hard to check if all classes are present, as I highly doubt that there will be more than 5 extension classes presented in a single plugin, so this solution is good enough for now.

Other than that, the process of using the PF4J library is pretty straightforward, and we can fully utilize this library from Clojure projects with some hand tweaking. Thanks for reading!

Comment via email

Pretty-printing for Fennel Language

Sat, 09 Jan 2021 23:07:00 +0300

Update:

All the patches^{1, 2} has been merged into the main branch of Fennel language, so expect to see improved fennelview in next stable release! Some semantics have been altered, so I’ve updated the post a bit to reflect the changes.

Pretty-printing in Lisp is a way to represent data structures that we operate in our program in a human-readable way. This technique is quite old and was part of many Lisp languages for a very long time. Because Lisps usually are homoiconic, defining a pretty printer for Lisp’s main data structure in terms of the syntax expected by the reader, we get a way to pretty-print Lisp’s code, thus making pretty-printer act as a formatter. And as far as I know, this was originally the main purpose for pretty printer - code was written in a “compressed” form, e.g. no line breaks to save space, and then pretty-printed on some kind of display. This was also handy to review outputs of programs that generate programs, another common property of Lisp languages.

Fennel is a relatively young Lisp-like language, that compiles to Lua. It uses Lua’s main data structure - a table, as its main data structure, and has its own pretty printer, called fennelview. It’s a pretty simple pretty printer, that is mostly based on another pretty printer for Lua, called inspect.lua.

Since inspect.lua is oriented at producing Lua-style tables, fennelview.fnl was altered to make it output tables in a Fennel’s syntax, so printed tables could be read back by the reader. It is important to note, that inspect.lua is not oriented at table serialization, hence this is not well suited for a Lisp-like language.

fennelview.lua also shared some problems, most of which were inherited from inspect.lua, and one of which is indentation handling. In Fennel v0.7.0, tables were printed like this in the REPL:

>> {:a 1 :b 2 :c 3}
{
  :a 1
  :b 2
  :c 3
}

Indentation seems to be correct from a C-like language standpoint, but Lisp hackers usually expect the following notation:

{:a 1
 :b 2
 :c 3}

This is more concise and takes less horizontal space. It may seem like not a big deal, however, the main issue is that fennelview can’t properly deal with nested tables. For example, if we put the table from above into a sequential table with some elements, and possibly other tables, we’ll get an unpleasant result:

>> [1 {:a 1 :b 2} 2 3 {:c 4 :d 5 :e 6 :f 7 :g 8} 9]
[1 {
    :a 1
    :b 2
  } 2 3 {
    :c 4
    :d 5
    :e 6
    :f 7
    :g 8
  } 6]

Indentation no longer makes any sense, and while this is not an issue for Fennel’s reader, it is hard to read such data structure from a human perspective. There are two other Lisps languages with quite a similar syntax - Janet and Clojure, each of which formats the table from above like this:

[1 {:a 1, :b 2} 2 3 {:c 4, :d 5, :e 6, :f 7, :g 8} 9]

(Except in Janet parentheses are used in place of square brackets, and there are no commas in the table literal.)

This is much better than the current behavior of fennelview, however, I still find this kind of representation a bit hard to read, as we need to keep an eye on the inner object’s boundaries. So I’ve decided to re-implement fennelview from scratch, to make it smarter about indentation, and when to produce multi-line representations of the data structure it was passed.

Lua tables, and Fennel reader

Tables in Lua are implemented as a combination of associative tables, and sequential array-like parts. Lua actually has a single syntax for defining both kinds of tables, which uses curly braces:

-- sequential table or array
local t1 = {1, 2, 3}
-- associative table
local t2 = {a = 1, b = 2}
-- sequential table with nested tables
local t3 = {1, t2, 2, 3, {c = 4, d = 5}, 6}
-- a combination of associative and sequential tables
local t4 = {1, 1, 2, 3, 5, kind = "Fibonacci"}

Fennel defines different syntaxes for different table kinds - sequential tables are defined with [], and associative tables are defined with {}:

(local t1 [1 2 3])
(local t2 {:a 1 :b 2})
(local t3 [1 t2 2 3 {:c 4 :d 5} 6])

However, combined tables are created as associative tables, by providing indexes as keys:

(local t4 {1 1 2 1 3 2 4 3 5 5 :kind "Fibonacci"})
;; you can do the same in Lua, but it's more verbose:
;; local t4 = {[1] = 1, [2] = 1, [3] = 2, [4] = 3, [5] = 5, kind = "Fibonacci"}

Another way of defining such a table is by using set and mutating the existing sequential table:

>> (local t4 [1 1 2 3 5])
>> t4
[1 1 2 3 5]
>> (set t4.kind "Fibonacci")
>> t4
{
    1 1
    2 1
    3 2
    4 3
    5 5
    :kind "Fibonacci"
}

Note that until we’ve specified the non-sequential key in our table it was printed as a sequence. However, when a table has non-sequential keys, it is printed as an associative table. This has deep implications since the ipairs function will only traverse the sequential part of the table, so by printing a table this way we also indicate that it has more to it than just the sequential part.

But the indentation is not right. I’ve thought about a small set of rules, which could be used to decide how to print tables. This is what I got, and I’m pretty much pleased with the results:

Associative tables are printed within {}
1. Opened and closed curly braces must stay at the same lines as the first and last key-value pair in the table respectively.
2. Associative tables printed as multi-line if a certain amount of key-value pairs are present. Currently the limit is 4.
3. If any key or value itself is a table, multi-line output is produced.
4. Strings in key position printed as colon-strings if possible.
Sequential tables are printed within
1. Opened and closed square brackets must stay at the same lines as the first and last values in the table respectively.
2. Sequential tables printed as multi-line if a certain amount of key-value pairs is present. Optimal limit is 10.
3. If any value itself is a table, multi-line output is produced.
If the single-line representation of the current data structure and its indentation is greater than a certain amount, a multi-line representation is printed. Optimal width is 80 characters.
Nested tables share parent's indentation level.

Note:

The scratched rules above were considered initially but changed in the process of integrating the new fennelview into the language. Therefore, the next part of this post is now irrelevant, because most of these tables were examples of that scratched rule, but the current implementation only checks for the outermost third rule, e.g. for the resulting line width. Most of these examples would be single-line ones now, the comparison section has a more up-to-date variant of the formatting. I’ve highlighted irrelevant code with cursive.

Let’s manually apply these rules to the table that I’ve used before to visualize fennelview’s problems:

[1
 {:a 1 :b 2}
 2
 3
 {:c 4
  :d 5
  :e 6
  :f 7
  :g 8}
 9]

We can see that the sequential table contains less than 10 elements, but since the second associative table has more than 4 key-value pairs, we use multi-line output. On the other hand, the first associative table has only two key-value pairs in each, therefore is printed as a single line. And if the second associative table were to have fewer elements, the result would be printed as a one-liner:

[1 {:a 1 :b 2} 2 3 {:c 4 :d 5 :e 6 :f 7} 9]

Because neither of the inner tables is multiline, and the total line length is less than 80.

In my opinion, this is a very readable form for such kind of data structure - we can immediately see all sequential parts, and associative parts still stand out. I’ve re-implemented fenneview with these rules applied to sequential and associative tables, and with these changes whenever we pretty-print anything in the REPL we get a correctly indented result. For example, here’s how the configuration file for Fenneldoc is now printed:

>> (fennel.dofile ".fenneldoc")
{:fennel-path ["cljlib/?.fnl" "src/?.fnl"]
 :function-signatures true
 :insert-comment true
 :insert-copyright true
 :insert-license true
 :insert-version true
 :keys {:copyright "_COPYRIGHT"
        :description "_DESCRIPTION"
        :doc-order "_DOC_ORDER"
        :license "_LICENSE"
        :module-name "_MODULE_NAME"
        :version "_VERSION"}
 :order "aplhabetic"
 :out-dir "./doc"
 :silent false
 :toc true}

This is the exact way I would write it by hand (and I actually did), and I think this way it looks and reads much better than with default fennelview implementation.

However there are some quirks in Lua VM related to tables, and we also need a way to produce correctly indented user-defined data structures, that can be nested in other data structures.

Cyclic tables

In Lua, it is possible to define a table that contains itself, and Fennel is no exception here. Current implementation of fennelview has an option named detect-cycles, which is set to true by default. This means that when we try to print a table that contains itself, we will not go into infinity recursion:

>> (local t1 [])
>> (table.insert t1 t1)
>> t1
@1[#<table @1>]

I’m not a big fan of this #<table @1> thing, It mimics Lua’s internal string representation for a table for no reason. More than that, if the table is associative, we’ll see exact same #<table @id> notation, which is not ideal too. I’ve re-implemented parts of the cycle detection algorithm, and now it can differentiate what table type the cycle appears in:

>> (local t1 [])
>> (table.insert t1 t1)
>> t1
@1[@1[...]]

Cycles are printed either as @id[...] for sequential tables, or as @id{...} for associative tables:

>> (local t {})
>> (local v [t])
>> (set t.v v)
>> t
@1{:v [@1{...}]}
>> v
@1[{:v @1[...]}]

We can disable this behavior by setting :detect-cycles? option to false, and if we encounter a cycle, we will go in until the depth limit is reached. The depth limit is set to 128 by default.

This can also be done for user-defined data structures based on tables. For example, I’ve implemented this for hash-set from Cljlib, and now sets with cycles are printed as @set1{...}, or with other IDs, depending on context. This is done by specifying the custom implementation of __fennelview metamethod in the table’s metatable.

`__fennelview` metamethod

Set implementation from Cljlib is a bit overwhelming to explain here, so let’s instead define another non-existing data structure. For example, Lua does not have linked lists, so we can implement cons cells in terms of tables:

(fn recur-print-list [[head tail] options view indent elements]
  (when head
    (table.insert elements (view head options indent)))
  (match (type tail)
    (:table ? (= :cons (-?> tail getmetatable (. :__type))))
    (recur-print-list tail options view indent elements)
    :nil nil
    _ (table.insert elements (.. ". " (view tail options (+ indent 2)))))
  elements)

(fn pp-list [list view options indent]
  (let [elements (recur-print-list list options view (+ indent 1) [])
        lines (icollect [i line (ipairs elements)]
                (if (= i 1) line (.. " " line)))]
    (doto lines
      (tset 1 (.. "(" (or (. lines 1) "")))
      (tset (length lines) (.. (. lines (length lines)) ")")))))

(local cons-mt {:__fennelview pp-list :__type :cons})
(fn cons [h t] (setmetatable [h t] cons-mt))

This is a rather basic implementation for cons list pretty printer, but it already allows us to print lists with a traditional notation:

>> (cons 1 2)
(1 . 2)
>> (cons 1 (cons 2 3))
(1 2 . 3)
>> (cons 1 (cons 2 (cons 3)))
(1 2 3)

When we encounter multiline tables we force multi-line output for the whole list. And we can actually see, that the rules of the indentation that we’ve defined for tables still apply:

>> (cons 1 (cons 2 (cons {:some-long-key 1 :some-other-key 2
                          :another-long-key 3 :and-yet-another-one 4})))
(1
 2
 {:and-yet-another-one 4
  :another-long-key 3
  :some-long-key 1
  :some-other-key 2})

The associative table is correctly indented, because we manipulate the indent argument inside recur-print-list, and this even works correctly when our list itself is inside of another table:

>> {:list (cons 1 (cons 2 (cons 3 {:some-long-key 1 :some-other-key 2
                                   :another-long-key 3 :and-yet-another-one 4})))}
{:list (1
        2
        3
        . {:and-yet-another-one 4
           :another-long-key 3
           :some-long-key 1
           :some-other-key 2})}

More complex data structures may require additional logic put in the pretty-printer function, but this example illustrates the idea of control you can have.

Comparison to other Lisp pretty-printers

This implementation may not be as general as the one available in, say, Clojure. For example, I’ve mentioned a rule, that if any nested element of a table is multiline, fennelview will output multi-line representation. This rule makes it a lot easier to reason about indentation. Consider:

user=> (clojure.pprint/pprint {:seq [1 2 3 {:some-long-key 1 :some-other-key 2
                                            :another-long-key 3}]})
{:seq
 [1 2 3 {:some-long-key 1, :some-other-key 2, :another-long-key 3}]}
user=> (clojure.pprint/pprint {:seq [1 2 3 {:some-long-key 1 :some-other-key 2
                                            :another-long-key 3}]})
{:seq
 [1
  2
  3
  {:some-long-key 1,
   :some-other-key 2,
   :another-long-key 3,
   :and-yet-another-one 4}]}

Clojure’s pprint is smart enough to see that it can just put the second table on the second line, and not trigger the multi-line output of a vector. My implementation of fennelview will print everything on a new line, because the length of single-line representation is big enough, and we can benefit from vertical alignment:

>> {:seq [1 2 3 {:some-long-key 1 :some-other-key 2 :another-long-key 3}]}
{:seq [1 2 3 {:another-long-key 3 :some-long-key 1 :some-other-key 2}]}
>> {:seq [1 2 3 {:some-long-key 1 :some-other-key 2
                 :another-long-key 3 :and-yet-another-one 4}]}
{:seq [1
       2
       3
       {:and-yet-another-one 4
        :another-long-key 3
        :some-long-key 1
        :some-other-key 2}]}

In practice, I find this easier to read, but this actually may make it a bit harder to implement code formatter on top of pretty-printer. Also, I think that separating keys and values in associative data structure with newlines is a bad decision to make. Clojure can use commas in printed representation, since they are completely ignored, which I think is a great way to indicate pairs, but does not justify newlines in this particular case at least for me.

The source code of the formatter is available here, and I’ve submitted a patch to the Fennel language, so hopefully, we’ll see this implementation by default. Thanks for reading!

Comment via email

We need to talk about parentheses

Thu, 03 Dec 2020 22:51:00 +0300

Programming languages come in all shapes and sizes. There are pretty simple languages and really complex ones. But what unites most of these languages is the syntax. There are many languages so-called C-like, as they share many syntax ideas with C language, which includes consistent indentation, grouping, scoping, and infix notation. And many other syntax aspects usually are common in a majority of languages.

But there’s one language, that is different from the others. It has a long story and research behind it. This language, developed in the late 1950s, and evolved since, still being alive up to our days. I’m talking about Lisp, of course.

And one of the most well-known things about Lisp is:

P A R E N T H E S E S.

That’s gonna be today’s topic - why parentheses, how to deal with those, what features we can gain from those, and what tools we’ve come up with over the years of Lisp hacking.

The thing is, Lisp is notoriously known for its parentheses, as for many this is its main feature they will defend at all costs. However, for some reason, novice computer scientists fear these parentheses. This produces a lot of various memes, like this one¹:

How To Save The Princess in 8 Programming Languages

I guess this pretty much illustrates how most programmers, who are unfamiliar with Lisp, see the idea of parentheses. I often hear pretty common rants, that usually come down to one thing - there are too many parentheses even for the simplest things! And I agree, sometimes Lisp can be overwhelmed with parentheses for seemingly no reason.

To explain why parentheses are important let’s look at this small part of Rust code from some imaginary program:

let foo = 10;
let bar = foo + 32;

foo * bar

Code Snippet 1: Rust example

In this code we declare two immutable variables: foo, and bar, and assign values 10, and 42 to them respectively. Then we compute their product and return it?.. Now let’s look at the same code but in Scheme, which is a dialect of Lisp:

(let* ((foo 10)
       (bar (+ foo 32)))
  (* foo bar))

Code Snippet 2: Scheme example

This code does exactly the same thing as Rust code but has whopping twelve parentheses. And for most programmers, this may seem ridiculous. Why on earth someone would want to insert this amount of parentheses for a such simple task, as defining two variables and computing their product? Yes, Lisp is old, and this may seem like some legacy that was carried by language since the 60s. But there’s a good reason for parentheses to be part of the language, and once you understand their value, you’ll likely never be able to program without them. Likely. Because parentheses are that good. But why exactly?

Why parentheses?

In this section, I will try to convince you that parentheses are good. However, I must warn you that this is a conclusion most programmers begin to agree with only after writing in Lisp for some time. So while many things may seem silly, keep in mind that sometimes silly things only seem silly.

Scope

As we saw, both Scheme and Rust examples do the same things:

declare the variable foo, and assign a value of 10 to it,
declare the variable bar, and assign a sum of foo and 32 to it,
multiply foo and bar, and return result to outer scope.

But here’s the catch - what scope? In the Rust example, all we see are two definitions and expressions, and there’s the question: do we need foo and bar after we produce their product?

In Scheme example we can directly see where variables are available, since Scheme uses lexical scope, the end of life of foo and bar will be at the last parenthesis of the let* block:

(let* ((foo 10)
       (bar (+ foo 32)))
  (* foo bar))

In Rust, we can’t really see the whole picture here and now, because Rust does not require explicit scoping for a definition to be part of the expression. Although syntax implies that there’s nothing after the product is computed, thus foo and bar will go out of scope right after their product is computed (there’s no semicolon). We can assume that the surroundings are as follows:

let result = {
    let foo = 10;
    let bar = foo + 32;

    foo * bar
};

Code Snippet 3: Explicitly scoping foo and bar and returning result of expression

Thus explicitly defining the scope for foo and bar as the part of result computation process, just as in Scheme. Which will then be used, but we will not be able to access foo or bar later in the program. However, I see the following code much more often instead:

let foo = 10;
let bar = foo + 32;

let result = foo * bar;

Code Snippet 4: Using some outer scope

We let foo and bar live til the end of the outer scope, even though we might not use it at all. And another question to ask is how long result has to live? Does it need to live til the end of the function? These are questions that can be asked for both examples. Usually, we don’t think about this much and don’t wrap each and every variable into explicit scope in such languages. And Rust itself does a good job of keeping everything clean and dropping objects when those go out of scope.

On the other hand, the Scheme example explicitly states that both foo and bar are local to the scope of the let* and no one will expect to use those variables outside. And this pattern is applied to all other places in the program because we must define scope, as some Schemes forbid inline definitions with define.

This might seem like a small advantage, if any, for most developers, and a made-up example. And this is, in fact, a made-up example but the thing is, I was a C programmer for the past 5 years, and I was working with low-level code (bare metal actually). And I have never seen the use of explicit scoping of variables. Yes, there’s no standard way of doing what Rust does here unless we use compiler extension, but this is not an option sometimes, and the syntax is kinda cumbersome. I find this a major problem when dealing with C because I always see about 10 uninitialized variables at the start of each function, where half of those are used only once. Somewhere. And thank god, if there are no global variables. In Lisp, I can directly see where the scope for a variable begins and ends, and this pleases me enough to bear with parentheses.

But, well, even if we’re not talking about statement expressions, still in C or Rust we can define the scope with two curly braces, and in Scheme, we need twelve in total. Why?

Up to this point, you already may think that Rust or even C is actually better in this regard, but Lisp has a secret sauce hidden in these parentheses, which a lot of languages strive to achieve. And the reason for this is related to how Lisp was implemented in the first place.

LISP itself is an abbreviation, that stands for LISt Processor. And everything that is enclosed by parentheses is a list in Lisp. This enables one interesting property, which allows us to define an interpreter in a small set of recursive rules, which describe how to deal with lists.

I’m not going into details on how Lisp works, but roughly, all the code is transformed into real linked lists, like the one we have in other languages, except that such a linked list can hold anything in it. So in the case of the expression above, the list holds an let* name, and then it holds a list of lists, which in turn hold identifiers that the interpreter will later use to bind values. This may not sound clear enough, so here’s an explanation of each and every parenthesis in the Scheme example:

( ;; start of the top level list
 let* ;; the let* special form
 ( ;; list of binding lists
  ( ;; first binding list
   foo ;; which binds the name foo
   10  ;; to value 10
  ) ;; end of first inner list
  ( ;; beginning of a second binding list
   bar ;; that binds the name bar to
   ( ;; another list, which is an expression
    + ;; that computes the sum of
    foo ;; a value of binding foo, and
    32 ;; literal value 32
   ) ;; end of the expression
  ) ;; end of the second binding list
 ) ;; end of the list of bindings
 ( ;; body expression that uses those definitions, which is also a list
  * ;; that holds multiply function
  foo ;; the name that is bound to 10
  bar ;; and the name that is bound to 42 - a sum of `foo' and 32
 ) ;; end of body expression
) ;; end of the top-level list

So each parenthesis has its purpose in this small code block, but still, there are too many of those. And this is the problem because when reading the code, it is easy to make a mistake. Can you immediately see where’s the error in this snippet?

(let* ((foo 10)
       (bar (+ foo 32))
  (* foo bar))

I know where it is, but even with this knowledge, it is kinda hard to spot it while going through the code. This particular example will not work at all – compiler/interpreter will probably indicate the error. Experienced Lisp programmers also will notice this mistake, but this example indicates one glaring problem:

humans can’t immediately parse structure with a glance, and sometimes we have to count parentheses by hand.

And sometimes it is possible for parenthesis to be in the wrong place, and the code will still work, but the results will be not the expected ones.

It is fair to say that scoping is not a unique feature of Lisp, and is easily available in other languages, with fewer parentheses. So why even bother with all these extra parentheses? Sure, in this particular example the benefit is that we have to explicitly scope our code, in order to make it work. And although the example above is not real code, explicit scoping saves me a lot of time every day, by making the code easier to reason about.

But, remember, I’ve said that there’s a secret sauce hidden here, which is much more important, and this is why parentheses, are in fact kept to this day. Its macro system is one of the most powerful Lisp features, if not the most.

Macros

Let’s quickly recap what we know about Lisp syntax and its relationship with macros.

I’ve mentioned that everything that is enclosed within parentheses is a list. And not just any list, but exactly singly linked list. Yes, this is a pretty common data structure that is widely available in many languages and has certain uses and benefits. Most languages are stored as text, and there is a special tool, bundled with the language, that analyzes this text, and produces an abstract syntax tree, or AST for short. But Lisp is a bit different since all Lisp code is actually stored inside linked lists. And linked lists are our AST. That’s why Lisp is a list processor - it operates lists as it’s main data structure for code. This is called homoiconicity. And I hope, we all know the common properties of a single linked list:

Recursive nature, and persistence;
ϴ(n) lookup time;
ϴ(n+1) insertion, deletion, or splicing at arbitrary element;
And ϴ(1) for insertion and removal at the front of the list.

Most notably, since we’re able to split and concatenate lists, and our code is stored within lists, we’re able to manipulate AST how we want because it’s just data. Lisp, being a list processor, comes with a lot of functions for manipulating this data structure, which allows programs to modify other parts of the program, or write new programs. This property is often called Metaprogramming, and in Lisp programs writing or manipulating code is a very common thing. And thanks to the ability of code to manipulate code, Lisp core is very small, and the rest of the language is defined in terms of macros.

For example, think of how one could add an and operator to their language if there is no and built in. First, let’s remember what and does:

If a predicate is true, we check the next predicate;
If a predicate is false, we stop the process and return false;
If all predicates are true, we return the last term.

We can implement these rules as a recursive macro:

(defmacro and [pred & preds]
  (if (empty? preds)
    `(do ~pred)
    `(let [p# ~pred]
       (if p# (and ~@preds) p#))))

Here’s what happens. We declare and macro that takes pred as its first parameter, and rest predicates as preds. We check if preds is empty, and if it is, this means that we need to check only one pred. If there are preds, we check the pred, and if it is true, we call and again with the rest preds. It pred is false, we return it.

This is a simple recursive process, that checks its arguments one by one until there is nothing left. And keep in mind that this can’t be really done with the function, as we evaluate one argument at a time, while the function will first compute all predicates, and then iterate results.

Another example is Clojure’s threading macro:

(-> 1
    (+ 2)
    (* 9)
    (/ 5))

Its definition is more complex, compared to and macro, but the purpose of -> is to remove a lot of nesting from our expressions and present them as computation steps. What it does, is it takes 1, adds 2, multiplies the result by 9, and then divides the end result by 5. Macros are evaluated at compile-time, so after compilation, there will be this expression instead:

(/ (* (+ 1 2) 9) 5)

This is exactly the same thing, but you can see that it is kind of backward, e.g. division goes first. But since this is a tree, we know that reduction is going from the leafs up to the root. And while the -> variant has two more parentheses, there is actually only one depth level, whereas in expanded form the nest level is 3. So macros can help us with that at the cost of some additional parentheses, there will be one more example later involving a custom macro.

Macros are a very complex topic, that I’m not going to cover in this post, so if you’re interested you can start at Racket’s guide section for macros. Macros in Racket are hygienic and have their advantages and limitations, but there are also plain AST macros, as in Clojure, or Common Lisp. It’s fair to say that it is possible to implement a macro system that does not require parentheses, as done in Elixir, or Rust. However, Rust, for example, has hygienic macros, which are less powerful than the unhygienic ones, and uses a kinda different syntax from the main language. Elixir has both hygienic and unhygienic macros, and macros overall look pretty similar because language is defined in terms of lists, like Lisp, although with a different syntax.

Operator precedence

Most languages with infix operators have these complex operator precedence tables that you have to keep in mind every time you do something that involves multiple operators. And we all know that parentheses enforce precedence. So, what are the precedence rules for operators in Lisp? The answer is… there’s none!

As we saw in the previous section, the silly math example with addition, multiplication, and division had parentheses around each operator:

(/ (* (+ 1 2) 9) 5)

You could write this in C like this:

float res = (1 + 2) * 9.0 / 5.0;

But what if we look at this example?

float res = 6 / 2 * (1 + 2);

What’s the answer? 9 or 1? It depends… on operator precedence:

If someone will write this as a generic expression, like a / b * (c + d), what would the intention be? In Lisp we would not have such a problem:

(/ 6 (* 2 (+ 1 2))) ;; 1
(* (/ 6 2) (+ 1 2)) ;; 9

When I was working on raycasting there was plenty of math with a lot of computations often going on in a single formula. And I’ve actually was so glad that the formula I’ve translated this from was written with all parentheses in place, so the precedence was pretty clear.

The other benefit of both parentheses and prefix notation is that we do not have to repeat the same operators more than once.

int res = 1 + 2 + 3 + 4 + 5 + … + N;

Lisp:

(+ 1 2 3 4 5 … N)

This seems like another minor advantage but actually lies deep inside Lisp’s core. In Lisp, if we take the first element of such a list it will be a function +, and if we take the rest of the list, we’ll have (1 2 3 4 5 … N) list. And in lisp we apply a function to a list of arguments, literally, so we can instead write (apply + '(1 2 3 4 5 … N)), and this will be the same as writing (+ 1 2 3 … N) directly. This is how most Lisp interpreters work under the hood, except apply is a core primitive, which is available for us as a function too.

Now, still, there are a lot of parentheses if the examples I’ve shown above, so let’s think about how we can improve the situation. One possible solution would be to change language in such a way that parentheses are not required, or required less often.

Fixing the problem inside the language

The problem of too many parentheses in Lisp is real, and for a long time, people tried to solve it in different dialects. So there are several ways to improve the situation, but if you ask me, the solution is to learn to stop worrying and love the parentheses.

Using different parentheses

One solution is to use different parenthesis types, which are actually mean same thing, e.g. ( = [ = {. Some Scheme dialects, such as Racket, allow usage of other kinds of parentheses to make a structure more apparent as long as parentheses are matching depth level:

{let* [(foo 10)
       (bar (+ foo 32))]
  (* foo bar)}

Code Snippet 5: Using different parentheses in Racket

While not as pretty as the single parenthesis type version, it is easier to see the structure because different expression boundaries are marked explicitly. Also, curly braces will probably offend some die-hard Lisp hackers.

Using fewer parentheses and changing parenthesis semantics

Some dialects of Lisp use fewer parentheses for such expressions. For example in Clojure, this code would look like this:

(let [foo 10
      bar (+ foo 32)]
  (* foo bar))

Code Snippet 6: Using fewer parentheses, and different kinds for different expression types

Clojure uses both the reduction of unnecessary parentheses and different parenthesis kinds, but it is not just a stylistic change as in Racket. In Clojure square brackets represent different data types, a vector to be precise, so you can’t write let with ordinary parentheses around bindings. While not as generic as in Scheme, this actually makes sense and provides nice semantics allowing humans to parse code easier. And as we saw in Racket, it is common to wrap non-callable forms into square brackets, except in Clojure this is explicitly required for many forms.

Removing parentheses

There also were countless attempts of removing parentheses completely and using indentation with minimal syntax to represent structure. The most recent attempt is Project Rhombus, formerly known as Racket 2. Here’s how the code above could look, accordingly to this RFC:

let (foo = 10,
     bar = (foo + 32)):
  foo * bar

Code Snippet 1: Project Rhombus possible syntax

I, personally, do not like this, though this is just a proposal and not the final syntax. But I think that the strength of Lisp in its parentheses is for one simple reason - Lisp syntax is based on data structures, not plain text. And the simpler the syntax for these data structures the better. Representing lists via some syntax like colons, commas, and so on makes it harder to associate this with a simple list of things. So whether we’re talking about macros, the reliability of the expression boundaries, and the generality of the syntax, this is all possible because of parentheses.

And, since we’re not programming on punch cards anymore, instead of changing the syntax, we can use helper tools to deal with this parenthesis problem.

Editor support

The most well-known editor for Lisp is Emacs. Mainly because it is kind of a Lisp machine by itself, that implements its own Lisp dialect, called Emacs Lisp. No wonder, Emacs has pretty good support for Lisp editing and a lot of packages that help with this task.

Though I will use Emacs to show ways to interact with Lisp code, most of these features are available in other editors as well. And the first thing I want to talk about is color.

Coloring and dimming

Some code editors have a so-called rainbow mode, to color parentheses in different colors, to make the structure more apparent. This functionality is not unique to Lisps and can be used with any language that uses parentheses to declare scope, but I think it is most useful with Lisps, due to how many parentheses are usually stacked together on one line. Here’s our let snippet with colored parentheses:

(let* ((foo 10)
       (bar (+ foo 32)))
  (* foo bar))

This is close to using different parentheses as here, except works in any dialect of Lisp and does not require matching parentheses manually.

After a certain period, this may not actually be needed, since many Lisp hackers indent their code with a set of well-established rules, so indentation represents structure. Because of that, it is possible to dim parentheses away since they are not really needed to read properly formatted code:

(let* ((foo 10)
       (bar (+ foo 32)))
  (* foo bar))

This is similar to the approach of ditching parentheses, but does not require re-implementing parsers, and rewriting all the code to use the new syntax. Although, it does require proper formatting.

Formatting

Another one is also about indentation and formatting. In Lisp, parentheses are usually stacked at the end of the expression, while in C-like languages, vertical alignment is preferred. We can reformat that Racket code, and use only curly braces, to make it look more traditional:

This may seem ridiculous, but this is still a valid Racket code. I would recommend against doing this, but this is up to you to decide if you really want these C-like indentations in your code for some reason.

Some other formatting rules are around as well, for example, here’s another one with C-like formatting, but less hideous:

(define f
  (lambda (x)
    (lambda (y)
      (* (+ x y)
         (- x y)
      )
    )
  )
)

Or another one that suggests aligning parentheses on the separate line, but vertically aligning those with their opening scope:

(define f (lambda (x)
            (lambda (y)
              (* (+ x y)
                 (- x y)
)         ) ) )

Which is an interesting approach, and makes it easy to see the structure, but makes it a bit harder to modify such code. The main downside is that this will not work if different parentheses are used, because we’ll need to reverse their order:

{define f (lambda (x)
            [lambda (y)
              (* (+ x y)
                 (- x y)
)         ] ) }

This is valid but looks wrong because the parentheses are seemingly in a reverse order. This will not happen with a C-like approach though:

{define f
  (lambda (x)
    [lambda (y)
      (* (+ x y)
         (- x y)
      )
    ]
  )
}

This brings us to the point of making it easier not only to read but also to write Lisp code, with editing tools.

Structural editing

Paredit, Smartparens, and Lispy are three most popular (AFAIK) packages for Lisp editing in Emacs.

Their main on-the-surface difference is in that Lispy adheres to shorter commands, while Paredit sticks to Emacs-style keybindings², and Smartparens has both its own set and Paredit-like set:

Paredit command	Paredit binding	Lispy binding	Lispy command
`paredit-forward`	`C-M-f`	`j`	`lispy-down`
`paredit-backward`	`C-M-b`	`k`	`lispy-up`
`paredit-backward-up`	`C-M-u`	`h`	`lispy-left`
`paredit-forward-up`	`C-M-n`	`l`	`lispy-right`
`paredit-raise-sexp`	`M-r`	`r`	`lispy-raise`
`paredit-convolute-sexp`	`M-?`	`C`	`lispy-convolute`
`paredit-forward-slurp-sexp`	`C-)`	`>`	`lispy-slurp`
`paredit-forward-barf-sexp`	`C-}`	`«/kbd>`	`lispy-barf`
`paredit-backward-slurp-sexp`	`C-(`	`>`	`lispy-slurp`
`paredit-backward-barf-sexp`	`C-{`	`«/kbd>`	`lispy-barf`

These tools prove that Lisp code is actually its AST. And just like parentheses allow us to write macros, with tools like Paredit, we are able to manipulate AST in our editor mostly the same way.

Automatic parenthesis insertion

But the number of key bindings you need to know by heart with Paredit or Lispy may scare some programmers. I’m one of those, and I didn’t really want to learn Paredit. For people like us, there are modes that automatically insert matching closing parentheses when we insert opening one.

There are many of these in Emacs, here are a few:

smartparens - great package, that has a lot of commands and Paredit-style commands for editing and navigation,
electric-pair-mode - builtin mode, that works fairly well for non-Lisp languages, but is still usable with Lisps,
auto-pair - another good package for automatic insertion of pair symbols.

These packages are fewer friction alternatives for Paredit and Lispy, but are more general and will work for most languages. But what if we combine the idea of removing parentheses from Lisp and using indentation to represent the structure, without actually removing parentheses?

Parinfer

Created by Shaun Lebron, Parinfer was what brought me into Lisp. Since my first line of Lisp code, I was using Parinfer, and therefore it’s fair to say that I am

B I A S E D.

But even though, Parinfer is a great tool, that allows me to focus on editing code without thinking about trees all the time, as in structural editing. And still allows me to reason about trees with simple indentation editing.

Someone said that Parinfer turns Lisp into Python. Well, this is half true. Parinfer is more like this SRFI:49:

define (fac x)
  if (<= x 0) 1
      * x
        fac (- x 1)

Here’s the same code, but with all parentheses in place:

(define (fac x)
  (if (<= x 0) 1
      (* x
         fac (- x 1))))

If we dim all parentheses completely, we’ll have problems with inline expression boundaries, so this is not an option. For example, if in Scheme accepts any amount of arguments, so here (human) interpreter would think that we compare x against 0 and 1:

define  fac x
  if  <= x 0  1
      * x
        fac  - x 1

Python has syntax that provides a way to express inline boundaries without parentheses:

def fac(x):
    if x <= 0: return 1
    else: return x * fac(x - 1)

So no, Parinfer won’t turn your Lisp code into Python but will allow thinking less about parentheses most of the time, because it uses indentation to infer those for you.

But what exactly Parinfer does? It’s a bit complicated to explain, but it infers closing parentheses based on indentation, by enforcing a line invariant. So, whenever you insert spaces, in smart mode Parinfer preserves the structure, while also moving parentheses around if needed. This section of Parinfer’s site explains it by using gears. And you can try Parinfer demo editor. Here’s a recording of me messing around:

From my point of view, this is the nicest way to write Lisp code*, because it is both transparent and highly predictable. It does not require learning complex commands, and you still have a lot of automation, while being in full control of your code and indentation style. The only thing Parinfer enforces is line invariant, which can be simplified down to these examples:

Correct	Incorrect	Line invariant notes
( [])	( [])	Indentation specifies that `[]` is inner part of `()` form<br>Structure doesn’t match indentation in incorrect example.
() []	() []	Absence of indentation means that `[]` and `()` are separate forms<br>Indentation doesn’t match structure in incorrect example.

Remembering this, you can understand what will happen when you insert or delete indentation, which makes it quite easy to make predictable edits without shortcuts.

Although Shaun Lebron has archived the Parinfer library repository, there’s an excellent Rust port of Parinfer, with support for Vim and Kakoune. There’s also great Emacs package that uses this library, which has fully fledged Smart mode and works great.

However, I’ve put an asterisk here for a reason:

From my point of view, this is the nicest way to write Lisp code*, because it is both transparent and highly predictable.

As transparent and predictable as it is, Parinfer has one huge downside. The code must be formatted properly. This is not a problem when you’re the only one working on the project, and you format your code properly. But when working on a real-world application with a team, where everyone has their own view on how code should be formatted, there will be a lot of commits that just fix the indentation. Because Lisp is a free-form language, which is another property we get for free by using parentheses.

Being a good programmer

The last thing, that we can probably address is the programmers themselves. That is, we are also responsible for /too many parentheses/problems. For example, I’ve seen some inexperienced Scheme programmers, who do not know about let*, and write this code:

(let ((var1 10))
  (let ((var2 (* var1 10)))
    (let ((var3 (+ (/ var2 3) var1)))
      (* var3 var3))))

Which uses 26 parentheses. Instead of:

(let* ((var1 10)
       (var2 (* var1 10))
       (var3 (+ (/ var2 3) var1)))
  (* var3 var3))

Which uses 18 parentheses.

Or not using cond instead of nested if forms:

;; good
(cond (= 1 2) "what?"
      (not (= 2 2)) "WHAT?"
      (= (- (+ 1 "1") 1) 10) "THIS IS NOT JAVASCRIPT!!!"
      :else "all good")

;; Why?
(if (= 1 2)
  "what?"
  (if (not (= 2 2))
    "WHAT?"
    (if (= (- (+ 1 "1") 1) 10)
      "THIS IS NOT JAVASCRIPT!!!"
      "all good")))

Actually, cond and let* are just a macro, that transforms to nested if and let forms respectively, so why would you write this by hand? Macros can save us a lot of parentheses. Here’s an example from Clojure for the Brave and True book chapter 9:

(let [saying3 (promise)]
  (future (deliver saying3 (wait 100 "Cheerio!")))
  @(let [saying2 (promise)]
     (future (deliver saying2 (wait 400 "Pip pip!")))
     @(let [saying1 (promise)]
        (future (deliver saying1 (wait 200 "'Ello, gov'na!")))
        (println @saying1)
        saying1)
     (println @saying2)
     saying2)
  (println @saying3)
  saying3)

By defining enquene macro we can transform this code into:

@(-> (enqueue saying (wait 200 "'Ello, gov'na!") (println @saying))
     (enqueue saying (wait 400 "Pip pip!") (println @saying))
     (enqueue saying (wait 100 "Cheerio!") (println @saying)))

Which is both more generic, less entangled, uses fewer parentheses, and in fact, produces the very same code in the end.

There are a lot of helpful macros in Lisps, which expand language and allow you to do the same. However, we need to remember that macros are complex beasts, and often reading macro is really hard, so it’s better to document its complex transformations. So as a rule of thumb it’s not often feasible to write one when a function will do. But being able to do this is still a huge deal, as we are able to shape the language into our application instead of just using it as a tool.

While I do not find jokes in this comic funny (except maybe C one), the Lisp part is pretty representative of how non-Lispers see Lisps in general, which is unfortunate. ↩︎
https://github.com/abo-abo/lispy#introduction ↩︎

Comment via email

Raymarching with Fennel and LÖVE

Thu, 15 Oct 2020 20:33:00 +0300

Previously I decided to implement a rather basic raycasting engine in ClojureScript. It was a lot of fun, an interesting experience, and ClojureScript was awesome. I’ve implemented a small labyrinth game and thought about adding more features to the engine, such as camera shake, and wall height change. But when I started working on these, I quickly understood, that I’d like to move on to something more interesting, like a real 3D rendering engine, that also uses rays. <!–more–> Obviously, my first thought was about writing a ray-tracer¹. This technique is widely known and gained a lot of traction recently. With native hardware support for ray tracing, a lot of games are using it, and there are a lot of tutorials teaching how to implement one². In short, we cast a bunch of rays in 3D space, and calculate their trajectories, looking for what ray will hit and bounce off. Different materials have different bounce properties, and by tracing rays from the camera to the source of light, we can imitate illumination. There are also a lot of different approaches how to calculating bouncing, e.g. for global illumination, and ambient light, but I’ve felt that it is a rather complicated task, for a weekend post. And unlike raycasting, most ray-tracers require polygonal information in order to work, whereas raycasting only needs to know wall start and end points.

I’ve wanted a similar approach for 3D rendering, where we specify an object in terms of its mathematical representation. Like for a sphere, we’ll just specify coordinates of a center, and a radius, and our rays will find intersection points with it, providing us sufficient data to draw this sphere on screen. And recently, I’ve read about a similar technique, that uses rays for drawing on the screen, but instead of casting infinite rays as in raycasting, it marches a ray in terms of steps. And it also uses a special trick, to make this process very optimized, therefore we can use it for rendering real 3D objects.

I’ve decided to structure this post similarly to the one about raycasting, so this will be another long-read, often more about Fennel rather than raymarching, but at the end, I promise that we’ll get something that looks like this:

So, just as in raycasting, first we need to do is to understand how the raymarching engine works on paper.

Raymarching basics

Raymarching can be illustrated similarly to raycaster, except it requires more steps until we could render our image. First, we need a camera, and an object to look at:

Our first step would be to cast a ray, however, unlike with raycasting, we’ll cast a portion of a ray:

We then check if the ray intersects with the sphere. It’s not, so we do one more step:

It’s not intersecting yet, so we repeat again:

Oops, the ray overshot and is now inside the sphere. This is not really good option for us, as we want our rays to end directly at the object’s surface, without calculating the intersection point with the object itself. We can fix this by casting a shorter ray:

However, this is very inefficient! And besides, if we’ll change the angle a bit or move the camera, we will overshoot again. This means that we’ll either have an incorrect result or require a very small step size, which will blow up the computation process. How we can fix this?

Distance estimation

The solution to this is a signed distance function or a so-called Distance Estimator. Imagine if we knew how far we are from the object at any point in time? This would mean that we can shoot a ray of this length in any direction and still don’t hit anything. Let’s add another object to the scene:

Now, let’s draw two circles, which will represent distances from the objects to the point from where we’ll cast rays:

We can see, that there are two circles, and one is bigger than another. This means, that if we choose the shortest safe distance, we can safely cast rays in any direction and not overshoot anything. For example, let’s cast a ray towards the square:

We can see, that we haven’t reached the square, but more importantly, we did not overshoot it. Now we need to march the ray again, but what distance should it cover? To answer this question, we need to take another distance estimation from the ray end to the objects in the scene:

Once again we choose a shorter distance, and march towards the square, then get the distance again, and repeat the whole process:

You can see that with each step the distance to the object becomes smaller, and thus we will never overshoot the object. However, this also means, that we will take a lot of really small steps until we finally fully hit the object if we ever do. This is not a good idea, because it is even more inefficient than using fixed distance, and produces too accurate results, which we don’t really need. So instead of marching up until we exactly hit the object, we will march enough times. E.g., until the distance to the object is small enough, then there’s no real point to continue marching, as it is clear that we will hit the object soon. But this also means, that if the ray goes near the edge of an object, we do a lot of expensive steps of computing distance estimations.

Here’s a ray that is parallel to the side of the square, and marches towards the circle:

We do a lot of seemingly pointless measurements, and if a ray was closer to the square’s side, we would do even more steps. However, this also means, that we can use this data (since we’re already computed it) to render such things as glow, or ambient occlusion. But more on this later.

Once a ray hit an object we have all the data we need. Ray represents a point on the screen, and the more rays we cast the higher resolution of our image will be. And since we’re not using triangles to represent objects, our spheres will always be smooth, no matter how close we are to them, because there are no polygons involved.

This is basically it. Ray marching is a quite simple concept, just like raycaster, although it’s a bit more complicated, as we do have to compute things in 3D space now. So let’s begin implementing it by installing the required tools, and setting up the project.

Project structure

As you know from the title we will use two main tools to create ray-marcher, which are LÖVE, a free game engine, and Fennel the programming language. I’ve chosen Fennel, because it is a Lisp-like language, that compiles to Lua, and I’m quite a fan of Lisps. But we also needed to draw somewhere, and I know no GUI toolkit for Lua. But there is LÖVE - a game engine that runs Lua code, which is capable of running on all systems, thus a perfect candidate for our task.

Installation steps may differ per operating system, so please refer to manuals³^,⁴. At the time of writing this post, I’m using Fedora GNU/Linux, so for me it means:

$ sudo dnf install love luarocks readline-devel
$ luarocks install --local fennel
$ luarocks install --local readline # requires readline-devel
$ export PATH="$PATH:$HOME/.luarocks/bin"

It’s better to permanently add $HOME/luarocks/bin (or another path, if your installation differs) to the PATH variable in your shell, in order to be able to use installed utilities without specifying the full path every time. You can test if everything is installed correctly, by running fennel in your command line.

$ fennel
Welcome to Fennel 0.5.0 on Lua 5.3!
Use (doc something) to view documentation.
>> (+ 1 2 3)
6
>>

For other distributions, installation steps may vary, and for Windows, I think it’s safe to skip the readline part, which is fully optional but makes editing in a REPL a bit more comfortable.

Once everything is installed, let’s create the project directory and the main.fnl file, where we will write our code.

$ mkdir love_raymarching
$ cd love_raymarching
$ touch main.fnl

And that’s it! We can test if everything works by adding this code to main.fnl:

(fn love.draw []
  (love.graphics.print "It works!"))

Now we can compile it with fennel --compile main.fnl > main.lua, thus producing the main.lua file, and run love . (dot is intentional, it indicates current directory).

A window should appear, with white text It works! in the upper left corner:

Now we can begin implementing our ray marcher.

Scene setup

Just as in raycaster, we need a camera that will shoot rays, and some objects to look at. Let’s begin by creating a camera object, that will store coordinates and rotation information. We can do so, by using var to declare a variable that is local to our file, and that we can later change with set⁵:

(var camera {:pos [0.0 0.0 0.0]
             :x-rotate 0.0
             :z-rotate 0.0})

For those unfamiliar with Lisps, and especially Clojure, let me quickly explain what this syntax is. If you know this stuff, feel free to skip this part.

We start by using a var special form, that binds a value to a name like this: (var name value). So if we start the REPL, using the fennel command in the shell, and write (var a 40), a new variable a will be created. We then can check, that it has the desired value by typing a, and pressing return:
>> (var a 40)
>> a
40
We can then alter the contents of this variable by using set special form, which works like this (set name new-value):
>> (set a (+ a 2))
>> a
42
Now to curly and square brackets. Everything enclosed in curly braces is a hashmap. We can use any Lua value as our key, and the most common choice is a string, but Fennel has additional syntax for defining keys - a colon followed by a word: :a. This is called a keyword, and in Fennel, it is essentially the same as "a", but we don’t need to write a pair of quotes. However, keywords can’t contain spaces and some other symbols.

So writing this {:a 0 :b 2 :c :hello} in the REPL will make a new table, that holds three key-value pairs, which we can later get with another syntax - the dot .. Combining it with var, we can see that it works:
>> (var m {:a 1 :b 2 :c :hello})
>> (. m :b)
2
There’s also a shorthand for this syntax, that is, we can type m.b and access the :b key’s value:
>> m.b
2
>> m.c
"hello"
Notice that even though we’ve specified the value for :c as :hello, the REPL printed it to us as "hello".

We’re left with square brackets now, and this is a plain simple vector. It can grow and shrink, and store any Lua values in it:
>> [0 :a "b c" (fn [x] x)]
[0 "a" "b c" #<function: 0x56482230e090>]
However Lua doesn’t really have vectors or arrays, and it utilizes tables for this, where keys are simply indexes. So the code above is equivalent to this Fennel expression {1 0 2 "a" 3 "b c" 4 (fn [x] x)}, but we can use square brackets for convenience.

Note, that we can combine indexed tables (vectors) and ordinary tables (hashmaps) together. We can do it as shown above, by specifying indexes as keys, or defining a vector var and set a key in it to some value:
>> (var v [0 1 :a])
>> (set v.a 3)
>> v
{:a 3
 1 0
 2 1
 3 "a"}

So camera is essentially a Lua table, that stores keys :pos, :x-rotate, and :y-rotate, each storing a respective value. We use a vector as our position, and two floats as our rotation angles. Now we can make objects, but before that, we need a scene to store those objects:

(var scene [])

Yep, that’s our scene. Nothing fancy, simply an empty vector to which we will later add objects.

Now we can create these objects, so let’s start with perhaps the simplest one - a sphere. And I’ll also briefly explain what makes raymarching different from other methods of creating 3D graphics.

Creating objects

What is a sphere? That depends on the domain, we’re working in. Let’s open up Blender, remove the default cube, and create sphere with Shift+a, Mesh, UV Sphere:

To me, this looks nothing like a sphere, because it consists of rectangles. However, if we subdivide the surface, we can get a more correct representation:

This looks more like a sphere, but this is still just an approximation. Theoretically, if we move very close to it, we will see the edges and corners, especially with flat shading. Also, each subdivision adds more points, and it gets more and more expensive to compute:

We have to make these trade-offs because we don’t need very accurate spheres when we need real-time processing. But raymarching doesn’t have this limitation, because the sphere in raymarching is defined by the point and radius length. Which we can then work with by using the signed distance function.

So let’s create a function, that will produce a sphere:

(fn sphere [radius pos color] ➊
  (let [[x y z] ➋ (or pos [0 0 0])
        [r g b] (or color [1 1 1])]
    {:radius (or radius 5)
     :pos [(or x 0) (or y 0) (or z 0)]
     :color [(or r 0) (or g 0) (or b 0)]
     :sdf sphere-distance ➌}))

There’s a lot of stuff going on, so let’s dive into it.

This is a so-called constructor - a function, that takes some parameters and constructs an object with these parameters applied, then returns it. In most typed languages we would define a class, or structure to represent this object, however, in Fennel (and hence in Lua) we can just use a table. And this is my favorite part of such languages.

So we used fn special form to create a function named sphere, that takes three parameters: radius, position in space pos, and color ➊. Then we see another special form let. It is used to introduce locally scoped variables and has another nice property - destructuring ➋.

Let’s quickly understand how let works in this case. If you know how destructuring works, you can skip this part.

Here’s a simple example:
>> (let [a 1
         b 2]
     (+ a b))
3
We’ve introduced two local variables a and b, which hold values 1 and 2 respectively. Then we computed their sum and returned it as a result.

This is good, but what if we wanted to compute a sum of three vector elements multiplied by b? Let’s put a vector into a:
>> (let [a [1 2 3]
         b 2]
     <???>)
There are many ways to do this, such as reduce over a vector with a function that sums elements, or getting values from the vector in a loop and putting those into some local variable. However, in the case of our project, we always know exactly how many elements there will be, so we can just take these out by indexes without any kind of loop:
>> (let [a [1 2 3]
         b 2
         a1 (. a 1)
         a2 (. a 2)
         a3 (. a 3)]
     (* (+ a1 a2 a3) b))
12
Yet, this is very verbose, and not really good. We can make it a bit less verbose by skipping local variable definitions and using values directly in the sum:
>> (let [a [1 2 3]
         b 2]
     (print (.. "value of the second element is " (. a 2)))
     (* (+ (. a 1) (. a 2) (. a 3)) b))
value of the second element is 2
12
However, again, this isn’t really great, as we have to repeat the same syntax three times, and what if we want to use the second value from the vector in several places? Like here, I’ve added print since I particularly about the second element’s value, and want to see it in the log, but I have to repeat myself and get the second element twice. We could use a local binding for this, but we don’t want to do this manually.

That’s where destructuring comes in handy, and trust me, it is a very handy thing. We can specify a pattern, that is applied to our data, and binds variables for us like this:
>> (let [[a1 a2 a3] [1 2 3]
         b 2]
     (print (.. "value of the second element is " a2))
     (* (+ a1 a2 a3) b))
value of the second element is 2
12
This works somewhat like this:
[1  2  3]
 ↓  ↓  ↓
[a1 a2 a3]
This is much shorter than any of the previous examples and allows us to use any vector values in several places.

We can also destructure maps like this:
>> (var m {:a-key 1 :b-key 2})
>> (let [{:a-key a
          :b-key b} m]
     (+ a b))
3
And this also has a shorthand for when the name of the key and the name of desired local binding will match:
>> (var m {:a 1 :b 2})
>> (let [{: a : b} m]
     (+ a b))
3
Which is even shorter.

All this essentially boils down to this kind of Lua code:
-- vector destructuring
-- (let [[a b] [1 2]] (+ a b))
local _0_ = {1, 2}
local a = _0_[1]
local b = _0_[2]
return (a + b)

-- hashmap destructuring
-- (let [{: a : b} {:a 1 :b 2}] (+ a b))
local _0_ = {a = 1, b = 2}
local a = _0_["a"]
local b = _0_["b"]
return (a + b)
This is nothing special really, but this example still shows the power of Lisp’s macro system, in which destructuring is implemented. But it gets really cool when we use this in function forms, as we will see later.

If we were to call (sphere) now, we would get an error, because we specified a value ➌ for a key :sdf, that doesn’t yet exist. SDF stands for Signed Distance Function. That is a function, that will return the distance from a given point to an object. The distance is positive when the point is outside of the object and negative when the point is inside the object.

Let’s define an SDF for a sphere. What’s great about spheres, is that to compute the distance to the sphere’s surface, we only need to compute the distance to the center of the sphere, and subtract the sphere’s radius from this distance.

Let’s implement this:

(local sqrt math.sqrt) ➊

(fn sphere-distance [{:pos [sx sy sz] : radius} [x y z]] ➋
  (- (sqrt (+ (^ (- sx x) 2) (^ (- sy y) 2) (^ (- sz z) 2)))
     radius))

For performance reasons we declare math.sqrt as a local variable sqrt, that holds function value, to avoid repeated table lookup.

As was later pointed out, Luajit does optimize such calls, and there is no repeated lookup for method calls. This is still true for plain Lua, so I’m going to keep this as is, but you can skip all these local definitions if you want and use methods directly.

And at ➋ we again see destructuring, however not in the let block, but in the function argument list. What essentially happens here is this - function takes two parameters, the first of which is a hashmap, which must have a :pos keyword associated with a vector of three numbers, and a :radius keyword with a value. The second parameter is simply a vector of three numbers. We immediately destructured these parameters into a set of variables local to the function body. Hashmap is being destructured into sphere position vector, which is immediately destructured to sx, sy, and sz, and a radius variable storing sphere’s radius. Second parameter is destructured to x, y, and z. We then compute the resulting value by using the formula above. However, Fennel and Lua only understand definitions in the order from the top to the bottom, so we need to define sphere-distance before sphere.

Let’s test our function by passing several points and a sphere of radius 5:

>> (sphere-distance (sphere 5) [5 0 0])
0.0
>> (sphere-distance (sphere 5) [0 15 0])
10.0
>> (sphere-distance (sphere 5) [0 0 0])
-5.0

Great! First, we check if we’re on the sphere’s surface, because the radius of our sphere is 5, and we’ve set x coordinate to 5 as well. Next, we check if we’re 10 something away from the sphere, and lastly, we check that we’re inside the sphere because the sphere’s center and our point both are at the origin.

But we also can call this function as a method with : syntax:

>> (local s (sphere))
>> (s:sdf [0 0 0])
-5

This works because methods in Lua are syntactic sugar. When we write (s:sdf p) it is essentially equal to (s.sdf s p), and our distance function takes sphere as its first parameter, which allows us to utilize method syntax.

Now we need a distance estimator - a function that will compute distances to all objects and will return the shortest one, so we could then safely extend our ray by this amount.

(local DRAW-DISTANCE 1000)

(fn distance-estimator [point scene]
  (var min DRAW-DISTANCE)
  (var color [0 0 0])
  (each [_ object (ipairs scene)]
    (let [distance (object:sdf point)]
      (when (< distance min)
        (set min distance)
        (set color (. object :color)))))
  (values min color))

This function will compute the distance to each object in the scene from given point, using our signed distance functions, and will choose the minimum distance and the color of this ray. Even though it makes little sense to return color from the distance-estimator, we’re doing this here because we don’t want to compute this whole process again just to get the color of the endpoint.

Let’s check if this function works:

>> (distance-estimator [5 4 0] [(sphere) (sphere 2 [5 7 0] [0 1 0])])
1.0     [0 1 0]

It works, we obtained the distance to the second sphere, and its color because the point we specified was closer to this sphere than to the other.

With the camera, object, a scene, and this function we have all we need to start shooting rays and rendering this on screen.

Marching ray

Just as in raycaster, we cast rays from the camera, but now we do it in 3D space. In raycasting, our horizontal resolution was specified by a number of rays, and our vertical resolution was basically infinite. For 3D this is not an option, so our resolution now depends on the 2D matrix of rays, instead of the 1D matrix.

Quick math. How many rays we’ll need to cast in order to fill up 512 by 448 pixels? The answer is simple - multiply width and height and here’s the amount of rays you’ll need:

>> (* 512 448)
229376

A stunning 229376 rays to march. And each ray has to do many distance estimations as it marches away from the point. Suddenly, all that micro-optimizations, like locals for functions do not feel that unnecessary. Let’s hope for the best and that LÖVE will handle real-time rendering. We can begin by creating a function that marches a single ray in the direction our camera looks. But first, we need to define what we would use to specify coordinates, directions, and so on in our 3D space.

My first attempt was to use spherical coordinates to define ray direction and move points in 3D space relative to the camera. However, it had a lot of problems, especially when looking at objects at angles different from 90 degrees. Like here’s a screenshot of me looking at the sphere from the “front”:

And here’s when looking from “above”:

And when I added the cube object, I noticed a slight fish-eye distortion effect:

Which was not great at all. So I’ve decided that I would remake everything with vectors, and make a proper camera, with a “look-at” point, will compute projection plane, and so on.

And to do this we need to be able to work with vectors - add those, multiply, normalize, e.t.c. I’ve wanted to refresh my knowledge on this topic, and decided not to use any existing library for vectors, and implement everything from scratch. It’s not that hard. Especially when we already have vectors in the language, and can destructure it to variables with ease.

So we need these basic functions:

vec3 - a constructor with some handy semantics,
vec-length - function that computes magnitude of vector,
arithmetic functions, such as vec-sub, vec-add, and vec-mul,
and other unit vector functions, mainly normalize, dot-product, and cross-product.

Here’s the source code of each of these functions:

(fn vec3 [x y z]
  (if (not x) [0 0 0]
      (and (not y) (not z)) [x x x]
      [x y (or z 0)]))

(fn vec-length [[x y z]]
  (sqrt (+ (^ x 2) (^ y 2) (^ z 2))))

(fn vec-sub [[x0 y0 z0] [x1 y1 z1]]
  [(- x0 x1) (- y0 y1) (- z0 z1)])

(fn vec-add [[x0 y0 z0] [x1 y1 z1]]
  [(+ x0 x1) (+ y0 y1) (+ z0 z1)])

(fn vec-mul [[x0 y0 z0] [x1 y1 z1]]
  [(* x0 x1) (* y0 y1) (* z0 z1)])

(fn norm [v]
  (let [len (vec-length v)
        [x y z] v]
    [(/ x len) (/ y len) (/ z len)]))

(fn dot [[x0 y0 z0] [x1 y1 z1]]
  (+ (* x0 x1) (* y0 y1) (* z0 z1)))

(fn cross [[x0 y0 z0] [x1 y1 z1]]
  [(- (* y0 z1) (* z0 y1))
   (- (* z0 x1) (* x0 z1))
   (- (* x0 y1) (* y0 x1))])

Since we already know how destructuring works, it’s not hard to see what these functions do. vec3, however, has some logic in it, and you can notice that if has three outcomes. if in Fennel is more like cond in other lisps, which means that we can specify as many else if as we want.

Therefore, calling it without arguments produces a zero-length vector [0 0 0]. If called with one argument, it returns a vector where each coordinate is set to this argument: (vec 3) will produce [3 3 3]. In other cases we either specified or not specified z, so we can simply create a vector with x, y, and either 0 or z.

You may wonder, why this is defined as functions, and why I didn’t implement operator overloading, so we could simply use + or * to compute values? I’ve tried this, however, this is extremely slow, since on each operation we have to do a lookup in meta-table, and this is like really slow.

Here’s a quick benchmark:

(macro time [body]
  `(let [clock# os.clock
         start# (clock#)
         res# ,body
         end# (clock#)]
     (print (.. "Elapsed " (* 1000 (- end# start#)) " ms"))
     res#))

;; operator overloading
(var vector {})
(set vector.__index vector)

(fn vec3-meta [x y z]
  (setmetatable [x y z] vector))

(fn vector.__add [[x1 y1 z1] [x2 y2 z2]]
  (vec3-meta (+ x1 x2) (+ y1 y2) (+ z1 z2)))

(local v0 (vec3-meta 1 1 1))
(time (for [i 0 1000000] (+ v0 v0 v0 v0)))

;; basic functions
(fn vec3 [x y z]
  [x y z])

(fn vector-add [[x1 y1 z1] [x2 y2 z2]]
  (vec3 (+ x1 x2) (+ y1 y2) (+ z1 z2)))

(local v1 (vec3 1 1 1))
(time (for [i 0 1000000] (vector-add (vector-add (vector-add v1 v1) v1) v1)))

If we run it with lua interpreter, we’ll see the difference:

$ fennel --compile test.fnl | lua
Elapsed 1667.58 ms
Elapsed 1316.078 ms

Testing this with luajit claims that this way is actually faster, however, I’ve experienced a major slowdown in the renderer - everything ran about 70% slower, according to the frame per second count. So functions are okay, even though are much more verbose.

Now we can define a march-ray function:

(fn move-point [point dir distance] ➊
  (vec-add point (vec-mul dir (vec3 distance))))

(local MARCH-DELTA 0.0001)
(local MAX-STEPS 500)

(fn march-ray [origin direction scene]
  (var steps 0)
  (var distance 0)
  (var color nil)

  (var not-done? true) ➋
  (while not-done?
    (let [➍ (new-distance
              new-color) (-> origin
                             (move-point direction distance)
                             (distance-estimator scene))]
      (when (or (< new-distance MARCH-DELTA)
                (>= distance DRAW-DISTANCE)
                (> steps MAX-STEPS) ➌)
        (set not-done? false))
      (set distance (+ distance new-distance))
      (set color new-color)
      (set steps (+ steps 1))))
  (values distance color steps))

Not much, but we have some things to discuss.

First, we define a function to move points in 3D space ➊. It accepts a point, which is a three-dimensional vector, a direction vector dir, which must be normalized, and a distance. We then multiply the direction vector by a vector that consists of our distances and add it to the point. Simple and easy.

Next, we define several constants, and the march-ray function itself. It Defines some local vars, that hold initial values, and uses a while loop to march a given ray enough times. You can notice, that at ➋ we created a not-done? var, that holds true value, and then use it in the while loop as our test. And you also can notice that at ➌ we have a test, in case of which we set not-done? to false and exit the loop. So you may wonder, why not use for loop instead? Lua supports index-based for loops. Fennel also has support for these. So why use while with a variable?

Because Fennel has no break special form for some reason.

Here’s a little rant. You can skip it if you’re not interested in me making unconfirmed inferences about Fennel :).

I think that Fennel doesn’t support break because Fennel is influenced by Clojure (correct me if I’m wrong), and Clojure doesn’t have break either. However, looping in Clojure is a bit more controllable, as we choose when we want to go to the next iteration:
(loop [i 0]
  ;; do stuff
  (when (< i 10)
    (recur (+ i 1))))
Which means that when i is less then 10 I want you to perform another iteration.

In Fennel, however, the concept isn’t quite like this, because we have to define a var explicitly, and put it into the while test position:
(var i 0)
(while (< i 10)
  ;; do stuff
  (set i (+ i 1)))
You may not see the difference, but I do. This also can be trivially expressed as a for loop: (for [i 0 10] (do-stuff)). However, not every construct can be defined as for loop, when we don’t have break. And in Clojure we don’t have to declare a variable outside the loop, since loop does it for us, but the biggest difference is here:
(loop [i 0]
  (when (or (< i 100)
            (< (some-foo) 1000))
    (recur (inc i))))
Notice, that we’re looping until i reaches 100, or until some-foo returns something greater than 1000. We can easily express this as for loop in Lua:
for i = 0, 100 do
   if some_foo() > 1000 then
      break
   end
end
However, we can’t do the same in Fennel, because there’s no break. In this case we could define i var, put some_foo() < 1000 to the while loop test, and then use break when i reaches 100, like this:
(var i 0)
(while (or (< i 100)
           (< (some-foo) 1000))
  (set i (+ i 1)))
This is almost like the Clojure example, and you may wonder why I complain, but in the case of march-ray function, we can’t do this either! Because the function we call returns multiple values, we need to destructure ➍ to be able to test those. Or in some loops, such a function may depend on the context of the loop, so it has to be inside the loop, not in the test.

So not having break, or the ability to control when to go to the next iteration is a serious disadvantage. Yes, Clojure’s recur is also limited, since it must be in the tail position, so you can’t use it as continue or something like that. But it’s still a bit more powerful construct. I’ve actually thought about writing a loop macro, but it seems that it’s not as easy to do in Fennel, as in Clojure, because Fennel lacks some inbuilt functions to manipulate sequences. I mean it’s totally doable, but requires way too much work compared to defining a Boolean var and setting it in the loop.

At ➍ we see the syntax that I didn’t cover before: (let [(a b) (foo)] ...). Many of us, who are familiar with Lisp and especially Racket may be confused. You see, in Racket, and other Scheme implementations (that allow using different kinds of parentheses) let has this kind of syntax:

(let [(a 1)   ;; In Scheme square brackets around bindings
      (b 41)] ;; are replaced with parentheses
  (+ a b))

Or more generally, (let ((name1 value1) (name2 value2) ...) body). However, in the case of the march-ray function, we see a similar form, except the second element has no value specified. This is again a valid syntax in some lisps (Common Lisp, for example), as we can make a binding that holds nothing and later set it, but this is not what happens in this code, as we don’t use foo at all:

(let [(a b) (foo)]
  (+ a b))

And, since in Fennel we don’t need parentheses, and simply specify bindings as a vector [name1 value1 name2 value2 ...], another possible confusion may happen. You may think that (a b) is a function call that returns a name, and (foo) is a function call that produces a value. But then we somehow use a and b. What is happening here?

But this is just another kind of destructuring available in Fennel.

Lua has 1 universal data type, called a table. However Lua doesn’t have any special syntax for destructuring, so when a function needs to return several values, you have two options. First, you can return a table:

function returns_table(a, b)
   return {a, b}
end

But the user of such function will have to get values out of the table themselves:

local res = returns_table(1, 2)
local a, b = unpack(res) -- or use indexes, e.g. local a = res[1]
print("a: " .. a .. ", b: " .. b)
-- a: 1, b: 2

But this is extra work, and it ties values together into a data structure, which may not be really good for you. So Lua has a shorthand for this - you can return multiple values:

function returns_values(a, b)
   return a, b
end

local a, b = returns_values(1, 2)
print("a: " .. a .. ", b: " .. b)
-- a: 1, b: 2

This is shorter and more concise. Fennel also support this multivalue return with values special form:

(fn returns-values [a b]
  (values a b))

This is equivalent to the previous code, but how do we use these values? All binding forms in Fennel support destructuring, so we can write this as:

(local (a b) (returns-values 1 2))
(print (.. "a: " a ", b: " b))
;; a: 1, b: 2

Same can be done with vectors or maps when defining, local, var, or global variables:

(local [a b c] (returns-vector)) ;; returns [1 2 3]
(var {:x x :y y :z z} (returns-map)) ;; returns {:x 1 :y 2 :z 3}
(global (bar baz) (returns-values)) ;; returns (values 1 2)

And all of this works in let or when defining a function!

OK. We’ve defined a function that marches a ray, now we need to shoot some!

Shooting rays

As with math functions, let’s define some local definitions somewhere at the top of the file:

(local love-points love.graphics.points)
(local love-dimensions love.graphics.getDimensions)
(local love-set-color love.graphics.setColor)
(local love-key-pressed? love.keyboard.isDown)
(local love-get-joysticks love.joystick.getJoysticks)

This is pretty much all we’ll need from LÖVE - two functions to draw colored pixels, one function to get the resolution of the window, and input handling functions for the keyboard and gamepad. We’ll also define some functions in love namespace table (IDK how it is called properly in Lua, because it is a table that acts like a namespace) - love.load, love.draw, and others along the way.

Let’s begin by initializing our window:

(local window-width 512)
(local window-height 448)
(local window-flags {:resizable true :vsync false :minwidth 256 :minheight 224})

(fn love.load []
  (love.window.setTitle "LÖVE Raymarching")
  (love.window.setMode window-width window-height window-flags))

This will set our window’s default width and height to 512 by 448 pixels and set the minimum width and height to 256 by 224 pixels respectively. We also add title "LÖVE Raymarching" to our window, but it is fully optional.

Now we can set love.draw function, which will shoot 1 ray per pixel, and draw that pixel with the appropriate color. However, we need a way of saying in which direction we want to shoot our ray. To define the direction we will first need a projection plane and a look-at point.

Let’s create a look-at point as a simple zero vector [0 0 0] for now:

(local lookat [0 0 0])

Now we need to understand how we define our projection plane. In our case, a projection plane is a plane that is our screen, and our camera is some distance away from the screen. We also want to be able to change our field of view, or FOV for short, so we need a way of computing the distance to projection, since the closer we are to the projection plane, the wider our field of view:

We can easily compute the distance if we have an angle, which we also can define as a var:

(var fov 60)

Now we can compute our projection distance (PD), by using this formula:

Where fov is in Radians. And to compute radians we’ll need this constant:

(local RAD (/ math.pi 180.0))

Now we can transform any angle into radians by multiplying it by this value.

At this point, we know what is the distance to our projection plane, but we don’t know its size and position. First, we need a ray origin (RO), and we already have it as our camera, so our ro will be equal to the current value of camera.pos. Next, we need a look-at point, and we have it as a lookat variable, which is set to [0 0 0]. Now we can define a direction vector, that will specify our forward direction:

And with this vector F if we move our point the distance that we’ve computed previously, we’ll navigate the center of our projection plane, which we can call C:

The last thing we need to know, in order to get our orientation in space, is where is up and right. We can compute this by specifying an upward vector and taking a cross product of it and our forward vector, thus producing a vector that is perpendicular to both of these vectors, and pointing to the right. To do this we need an up vector, which we define like this [0 0 -1]. You may wonder why it is defined with the z-axis negative, but this is done so positive z values actually go up as we look from the camera, and the right is to the right. We then compute the right vector as follows:

And the up vector U is a cross product of R and F. Let’s write this down as in love.draw:

(fn love.draw []
  (let [(width height) (love-dimensions)
        projection-distance (/ 1 (tan (* (/ fov 2) RAD)))
        ro camera.pos
        f (norm (vec-sub lookat ro))
        c (vec-add ro (vec-mul f (vec3 projection-distance)))
        r (norm (cross [0 0 -1] f))
        u (cross f r)]
    nil)) ;; TBD

Currently, we only compute these values but do not use those, hence the nil at the end of the let. But now, as we know where our projection plane is, and where our right and up are, we can compute the intersection point, where at given x and y coordinates of a plane in unit vector coordinates, thus defining a direction vector.

So, for each x from 0 to width and each y from 0 to height we will compute a uv-x and uv-y coordinates, and find the direction vector rd. To find the uv-x we need to make sure it is between -1 and 1 by dividing current x by width and subtracting 0.5 from it, then multiplying by x/width. For uv-y we only need to divide current y by height, and subtract 0.5:

(for [y 0 height]
  (for [x 0 width]
    (let [uv-x (* (- (/ x width) 0.5) (/ width height))
          uv-y (- (/ y height) 0.5)]
      nil))) ;; TBD

Now as we have uv-x and uv-y, we can compute intersection point i, by using the up and right vectors and the center of the plane:

And finally, compute our direction vector RD:

And now we can use our march-ray procedure to compute the distance and color of the pixel. Let’s wrap everything up:

(local tan math.tan)
(fn love.draw []
  (let [projection-distance (/ 1 (tan (* (/ fov 2) RAD)))
        ro camera.pos
        f (norm (vec-sub lookat ro))
        c (vec-add ro (vec-mul f (vec3 projection-distance)))
        r (norm (cross [0 0 -1] f))
        u (cross f r)
        (width height) (love-dimensions)]
    (for [y 0 height]
      (for [x 0 width]
        (let [uv-x (* (- (/ x width) 0.5) (/ width height))
              uv-y (- (/ y height) 0.5)
              i (vec-add c (vec-add
                            (vec-mul r (vec3 uv-x))
                            (vec-mul u (vec3 uv-y))))
              rd (norm (vec-sub i ro))
              (distance color) (march-ray ro rd scene)]
          (if (< distance DRAW-DISTANCE)
              (love-set-color color)
              (love-set-color 0 0 0))
          (love-points x y))))))

Now, if we set the scene to contain a default sphere, and place our camera at [20 0 0], we should see this:

This is correct because our default sphere has white as the default color.

You can notice, that we compute distance and color by calling (march-ray ro rd scene), and then check if distance is less than DRAW-DISTANCE. If this is the case, we set the pixel’s color to the color found by march-ray function, otherwise, we set it to black. Lastly, we draw the pixel to the screen and repeat the whole process for the next intersection point, thus the next pixel.

But we don’t have to draw black pixels if we didn’t hit anything! Remember, that in the beginning, I’ve written, that if we go past the object, we do many steps, and we can use this data to render glow. So if we modify love.draw function a bit, we will be able to see the glow around our sphere. And the closer the gay got to the sphere, the stronger the glow will be:

;; rest of love.draw
(let [ ;; rest of love.draw
      (distance color steps) (march-ray ro rd scene)]
  (if (< distance DRAW-DISTANCE)
    (love-set-color color)
    (love-set-color (vec3 (/ steps 100))))
  (love-points x y))
;; rest of love.draw

Here, I’m setting the color to the number of steps divided by 100, which results in this glow effect:

Similarly to this glow effect, we can create a fake ambient occlusion - the more steps we did before hitting the surface, the more complex it is, hence less ambient light should be able to pass. Unfortunately, the only object we have at this moment is a sphere, so there’s no way of showing this trick on it, as its surface isn’t very complex.

All this may seem expensive, and it actually is. Unfortunately, Lua doesn’t have real multithreading to speed this up, and the threads feature, provided by LÖVE results in even worse performance than computing everything in a single thread. Well, at least the way I’ve tried it. There’s a shader DSL in LÖVE, which could be used to compute this stuff on GPU, but this is currently out of the scope of this project, as I wanted to implement this in Fennel.

Speaking of shaders, now, that we can draw pixels on the screen, we also can shade those, and compute lighting and reflections!

Lighting and reflections

Before we begin implementing lighting, let’s add two more objects - a ground plane, and an arbitrary box. Much like a sphere object, we first define the signed distance function, and then the constructor for the object:

(local abs math.abs)

(fn box-distance [{:pos [box-x box-y box-z]
                   :dimensions [x-side y-side z-side]}
                  [x y z]]
  (sqrt (+ (^ (max 0 (- (abs (- box-x x)) (/ x-side 2))) 2)
           (^ (max 0 (- (abs (- box-y y)) (/ y-side 2))) 2)
           (^ (max 0 (- (abs (- box-z z)) (/ z-side 2))) 2))))

(fn box [sides pos color]
  (let [[x y z] (or pos [0 0 0])
        [x-side y-side z-side] (or sides [10 10 10])
        [r g b] (or color [1 1 1])]
    {:dimensions [(or x-side 10)
                  (or y-side 10)
                  (or z-side 10)]
     :pos [(or x 0) (or y 0) (or z 0)]
     :color [(or r 0) (or g 0) (or b 0)]
     :sdf box-distance}))

(fn ground-plane [z color]
  (let [[r g b] (or color [1 1 1])]
    {:z (or z 0)
     :color [(or r 0) (or g 0) (or b 0)]
     :sdf (fn [plane [_ _ z]] (- z plane.z))}))

In case of ground-plane we incorporate :sdf as a anonymous function, because it is a simple one-liner.

Now, as we have more objects, let’s add those to the scene and see if those work:

(var camera {:pos [20.0 50.0 0.0]
             :x-rotate 0.0
             :z-rotate 0.0})

(local scene [(sphere nil [-6 0 0] [1 0 0])
              (box nil [6 0 0] [0 1 0])
              (ground-plane -10 [0 0 1])])

With this scene and camera we should see this:

It’s a bit sadistic in the eyes, but we can at least be sure that everything works correctly. Now we can implement lighting.

In order to calculate lighting, we’ll need to know a normal to the surface at the point. Let’s create get-normal function, that receives the point, and our scene:

(fn get-normal [[px py pz] scene]
  (let [x MARCH-DELTA
        (d) (distance-estimator [px py pz] scene)
        (dx) (distance-estimator [(- px x) py pz] scene)
        (dy) (distance-estimator [px (- py x) pz] scene)
        (dz) (distance-estimator [px py (- pz x)] scene)]
    (norm [(- d dx) (- d dy) (- d dz)])))

It is a nice trick, since we create three more points around our original point, use the existing distance estimation function, and get a normalized vector of subtraction of each axis from the original point, with the distance to the new point. Let’s use this function to get normal for each point, and use the normal as our color:

;; rest of love.draw
(if (< distance DRAW-DISTANCE)
    (love-set-color (get-normal (move-point ro rd distance) scene))
    (love-set-color 0 0 0))
;; rest of love.draw

Notice that in order to get endpoint of our ray we move-point ro along the direction rd using the computed distance. We then pass the resulting point into get-normal, and our scene, thus computing the normal vector, which we then pass to love-set-color, and it gives us this result:

You can see that the ground-plane remained blue, and this isn’t an error. Blue in our case is [0 0 1], and since in our world, positive z coordinates indicate up, we can see it directly in the resulting color of the plane. The top of the cube and the sphere are also blue, and the front side is green, which means that our normals are correct.

Now we can compute basic lighting. For that we’ll need a light object:

(var light [70 40 100])

Let’s create a shade-point function, that will accept a point, point color, light position, and a scene:

(fn shade-point [point color light scene]
  (vec-mul color (vec3 (point-lightness point scene light))))

It may seem that this function’s only purpose is to call point-lightness, which we will define a bit later, and return a new color. And this is true, at least for now. Let’s create point-lightness function:

(fn clamp [a l t]
  (if (< a l) l
      (> a t) t
      a))

(fn above-surface-point [point normal]
  (vec-add point (vec-mul normal (vec3 (* MARCH-DELTA 2)))))

(fn point-lightness [point scene light]
  (let [normal (get-normal point scene) ➊
        light-vec (norm (vec-sub light point))
        (distance) (march-ray (above-surface-point point normal) ➋
                              light-vec
                              scene)
        lightness (clamp (dot light-vec normal) 0 1)] ➌
    (if (< distance DRAW-DISTANCE)
        (* lightness 0.5)
        lightness)))

What this function does, is simple. We compute the normal ➊ for given point, then we find a point that is just above the surface, using above-surface-point function ➋. And we use this point as our new ray origin to march towards the light. We then get the distance from the march-ray function and check if we’ve gone all the way to the max distance or not. If not, this means that there was a hit, and we divide total lightness by 2 thus creating a shadow. In the other case, we return lightness as is. And lightness is a dot product between light-vec and normal to the surface ➌, where light-vec is a normalized vector from the point to the light.

If we again modify our love.draw function like this:

;; rest of love.draw
(if (< distance DRAW-DISTANCE)
    (let [point (move-point ro rd distance)]
      (love-set-color (shade-point point color scene light)))
    (love-set-color 0 0 0))
;; rest of love.draw

We should see the shadows:

This already looks like real 3D, and it is. But we can do a bit more, so let’s add reflections.

Let’s create a reflection-color function:

(var reflection-count 3)

(fn reflection-color [color point direction scene light]
  (var [color p d i n] [color point direction 0 (get-normal point scene)]) ➊
  (var not-done? true)
  (while (and (< i reflection-count) not-done?)
    (let [r (vec-sub d (vec-mul (vec-mul (vec3 (dot d n)) n) [2 2 2])) ➋
          (distance new-color) (march-ray (above-surface-point p n) r scene)] ➌
      (if (< distance DRAW-DISTANCE)
          (do (set p (move-point p r distance))
              (set n (get-normal p scene))
              (set d r) ➍
              (let [[r0 g0 b0] color
                    [r1 g1 b1] new-color
                    l (/ (point-lightness p scene light) 2)]
                (set color [(* (+ r0 (* r1 l)) 0.66)
                            (* (+ g0 (* g1 l)) 0.66)
                            (* (+ b0 (* b1 l)) 0.66)]) ➎))
          (set not-done? false) ➏))
    (set i (+ i 1)) ➐)
  color)

This is quite a big function, so let’s look at it piece by piece.

First, we use destructuring to define several vars ➊, which we will be able to change using set later in the function. Next, we go into the while loop, which checks both for maximum reflections reached, and if the ray went to infinity. The first thing we do in the loop, computes the reflection vector r ➋, by using this formula:

This is our new direction, which we will march from new above-surface-point ➌. If we’ve hit something, and our distance will be less than DRAW-DISTANCE, we’ll set our point p to new point, compute new normal n, and set direction d to previous direction, which was reflection vector r ➍. Next, we compute the resulting color. I’m doing a simple color addition here, which is not an entirely correct way of doing it, but for now, I’m fine with that. We also compute lightness of the reflection point, and divide it by 2, so our reflections appear slightly darker. Then we add each channel and make sure it is not greater than 1, by multiplying it by 0.66 ➎. The trick here is that maximum lightness we can get is 0.5, so if we add two values, one of which is multiplied by 0.5 overall result can be averaged by multiplying by 0.66. This way we do not lose brightness all the way and the reflection color blends with the original color nicely.

In case we don’t hit anything, it means that this is the final reflection, therefore we can end ➏ the while loop on this iteration. Lastly, since I’ve already ranted on the absence of break in Fennel, we have to increase the loop counter manually ➐ at the end of the loop.

Let’s change shade-point so it will pass color into this function:

(fn shade-point [point color direction scene light]
  (-> color
      (vec-mul (vec3 (point-lightness point scene light)))
      (reflection-color point direction scene light)))

You can notice that I’ve added the direction parameter, as we need it for computing reflections, so we also have to change the call to shade-point in love.draw function:

;; rest of love.draw
(if (< distance DRAW-DISTANCE)
    (let [point (move-point ro rd distance)]
      (love-set-color (shade-point point color rd scene light))) ;; rd is our initial direction
    (love-set-color 0 0 0))
;; rest of love.draw

Let’s try this out (I’ve brought ground-plane a bit closer to objects so we could better see reflections):

We can see reflections, and reflections of reflections in reflections, because previously we’ve set reflection-count to 3. Currently, our reflections are pure mirrors, as we reflect everything at a perfect angle, and shapes appear just as real objects. This can be changed by introducing materials, that have different qualities like roughness, and by using better reflection algorithms like Phong shading, but maybe next time. Refractions also kinda need materials, as refraction angles can be different, depending on what kind of material it goes through. E.g. glass and still pool of water should have different refraction angles. And some surfaces should reflect rays at certain angles, and let them go through at other angles, which will also require certain modifications in the reflection algorithm.

Now, if we would set our camera, lookat, and light to:

(local lookat [19.75 49 19.74])

(var camera {:pos [20 50 20]
             :x-rotate 0
             :z-rotate 0})

(local scene [(box [5 5 5] [-2.7 -2 2.5] [0.79 0.69 0.59])
              (box [5 5 5] [2.7 2 2.5] [0.75 0.08 0.66])
              (box [5 5 5] [0 0 7.5] [0.33 0.73 0.42])
              (sphere 2.5 [-2.7 2.5 2.5] [0.56 0.11 0.05])
              (sphere 10 [6 -20 10] [0.97 0.71 0.17])
              (ground-plane 0 [0.97 0.27 0.35])])

We would see an image from the beginning of this post:

For now, I’m pretty happy with the current result, so lastly let’s make it possible to move into our 3D space.

User input

We’ll be doing two different ways of moving in our scene - with keyboard and gamepad. The difference mostly is in the fact, that gamepads can give us floating point values, so we can move slower or faster depending on how we move the analogs.

We’ve already specified needed functions from LÖVE as our locals, but to recap, we’ll need only two:

(local love-key-pressed? love.keyboard.isDown)
(local love-get-joysticks love.joystick.getJoysticks)

But first, we’ll need to make changes to our camera, as currently, it can only look at the origin.

How will we compute the look-at point for our camera so we will be able to move it around in a meaningful way? I’ve decided that a good way will be to “move” the camera forward a certain amount, and then rotate this point around the camera by using some angles. Luckily for us, we’ve already specified that our camera has two angles :x-rotate, and z-rotate:

(var camera {:pos [20 50 20]
             :x-rotate 255
             :z-rotate 15})

And it is also declared as a var, which means that we can set new values into it. Let’s write a function that will compute a new lookat point for current camera position and rotation:

(local cos math.cos)
(local sin math.sin)

(fn rotate-point [[x y z] [ax ay az] x-angle z-angle]
  (let [x (- x ax)
        y (- y ay)
        z (- z az)
        x-angle (* x-angle RAD)
        z-angle (* z-angle RAD)
        cos-x (cos x-angle)
        sin-x (sin x-angle)
        cos-z (cos z-angle)
        sin-z (sin z-angle)]
    [(+ (* cos-x cos-z x) (* (- sin-x) y) (* cos-x sin-z z) ax)
     (+ (* sin-x cos-z x) (* cos-x y) (- (* sin-x sin-z z)) ay)
     (+ (* (- sin-z) x) (* cos-z z) az)]))

(fn forward-vec [camera]
  (let [pos camera.pos]
    (rotate-point (vec-add pos [1 0 0]) pos camera.x-rotate camera.z-rotate)))

The first function rotate-point will rotate one point around another point by using two degrees. It is based on aircraft principal axes, but we only have two axes, so we do not need to “roll”, hence we do little fewer computations here.

Next is the forward-vec function, that computes current “forward” vector for camera. Forward, in this case, means the direction camera is “facing”, which is based on two angles we specify in the camera.

With this function we can implement basic movement and rotation functions for the camera:

(fn camera-forward [n]
  (let [dir (norm (vec-sub (forward-vec camera) camera.pos))]
    (set camera.pos (move-point camera.pos dir n))))

(fn camera-elevate [n]
  (set camera.pos (vec-add camera.pos [0 0 n])))

(fn camera-rotate-x [x]
  (set camera.x-rotate (% (- camera.x-rotate x) 360)))

(fn camera-rotate-z [z]
  (set camera.z-rotate (clamp (+ camera.z-rotate z) -89.9 89.9)))

(fn camera-strafe [x]
  (let [z-rotate camera.z-rotate]
    (set camera.z-rotate 0)
    (camera-rotate-x 90)
    (camera-forward x)
    (camera-rotate-x -90)
    (set camera.z-rotate z-rotate)))

And if we modify our love.draw again, we’ll be able to use our computed look-at point as follows:

(fn love.draw []
  (let [;; rest of love.draw
        lookat (forward-vec camera)
        ;; rest of love.draw

Now we don’t need a global lookat variable, and it is actually enough for us to compute new lookat every frame.

As for movement, let’s implement a simple keyboard handler:

(fn handle-keyboard-input []
  (if (love-key-pressed? "w") (camera-forward 1)
      (love-key-pressed? "s") (camera-forward -1))
  (if (love-key-pressed? "d")
      (if (love-key-pressed? "lshift")
          (camera-strafe 1)
          (camera-rotate-x 1))
      (love-key-pressed? "a")
      (if (love-key-pressed? "lshift")
          (camera-strafe -1)
          (camera-rotate-x -1)))
  (if (love-key-pressed? "q") (camera-rotate-z 1)
      (love-key-pressed? "e") (camera-rotate-z -1))
  (if (love-key-pressed? "r") (camera-elevate 1)
      (love-key-pressed? "f") (camera-elevate -1)))

Similarly, we can implement controller support:

(fn handle-controller []
  (when gamepad
    (let [lstick-x  (gamepad:getGamepadAxis "leftx")
          lstick-y  (gamepad:getGamepadAxis "lefty")
          l2        (gamepad:getGamepadAxis "triggerleft")
          rstick-x  (gamepad:getGamepadAxis "rightx")
          rstick-y  (gamepad:getGamepadAxis "righty")
          r2        (gamepad:getGamepadAxis "triggerright")]
      (when (and lstick-y (or (< lstick-y -0.2) (> lstick-y 0.2)))
        (camera-forward (* 2 (- lstick-y))))
      (when (and lstick-x (or (< lstick-x -0.2) (> lstick-x 0.2)))
        (camera-strafe (* 2 lstick-x)))
      (when (and rstick-x (or (< rstick-x -0.2) (> rstick-x 0.2)))
        (camera-rotate-x (* 4 rstick-x)))
      (when (and rstick-y (or (< rstick-y -0.2) (> rstick-y 0.2)))
        (camera-rotate-z (* 4 rstick-y)))
      (when (and r2 (> r2 -0.8))
        (camera-elevate (+ 1 r2)))
      (when (and l2 (> l2 -0.8))
        (camera-elevate (- (+ 1 l2)))))))

Only for a controller, we make sure that our l2 and r2 axes are from 0 to 2, since by default these axes are from -1 to 1, which isn’t going to work for us. Similarly to this, we can add the ability to change the field of view or reflection count, but I’ll leave this out for those who are interested in trying it themselves. It’s not hard.

As a final piece, we need to detect if the controller was inserted and handle keys somewhere. So let’s add these two final functions that we need for everything to work:

(var gamepad nil)

(fn love.joystickadded [g]
  (set gamepad g))

(fn love.update [dt]
  (handle-keyboard-input)
  (handle-controller))

love.joystickadded will take care of watching for new controllers, and love.update will ask for new input every now and then.

By this moment we should have a working raymarching 3D renderer with basic lighting and reflections!

Final thoughts

I’ve decided to write this post because I was interested in three topics:

Fennel, a Lisp-like language, which is a lot like Clojure syntax-wise, and has great interop with Lua (because it IS Lua)
LÖVE, is a nice game engine I’ve been watching for a long time already and played some games written with it, which were quite awesome,
and Lua itself, a nice, fast scripting language, with the cool idea that everything is a table.

Although I didn’t use much of Lua here, I’ve actually tinkered with it a lot during the whole process, testing different things, reading Fennel’s compiler output, and benchmarking various constructs, like field access, or unpacking numeric tables versus multiple return values. Lua has some really cool semantics of defining modules as tables and incorporating special meaning to tables via setmetatable, which is really easy to understand in my opinion.

Fennel is a great choice if you don’t want to learn Lua syntax (which is small, but, you know, it exists). For me, Fennel is a great language, because I don’t have to deal with Lua syntax AND because I can write macros. And even though I didn’t write any macro for this project, because everything is already presented in Fennel itself, the possibility of doing this is worth something. Also, during benchmarking various features, I’ve used self-written time macro:

(macro time [body]
  `(let [clock# os.clock
         start# (clock#)
         res# ,body
         end# (clock#)]
     (print (.. "Elapsed: " (* 1000 (- end# start#)) " ms"))
     res#))

So the ability to define such things is a good thing.

LÖVE is a great engine, and although I’ve used a very little bit of it, I still think that this is a really cool project, because there is so much more in it. Maybe someday I’ll make a game that will realize LÖVE’s full potential.

On a downside note… The resulting raymarching is very slow. I’ve managed to get around 25 FPS for a single object in the scene, and a 256 by 224 pixel resolution. Yes, this is because it runs in a single thread, and does a lot of expensive computations. Lua itself isn’t a very fast language, and even though LÖVE uses Luajit - a just-in-time compiler that emits machine code, it’s still not fast enough for certain operations, or techniques. For example, if we implement operator overloading for vectors we’ll lose a lot of performance for constant table lookups. This is an existing problem in Lua, since it does its best of being small and embeddable, so it could work nearly on anything, therefore it doesn’t do a lot of caching and optimizations.

But hey, this is a raymarching in ~350 lines of code with some cool tricks like destructuring! I’m fine with the results. A slightly more polished version of the code from this article is available at this repository, so if anything doesn’t work in the code above, or you got lost and just want to play with the final result, you know where to go :)

Till next time, and thanks for reading!

https://en.wikipedia.org/wiki/Ray_tracing_(graphics) ↩︎
https://github.com/ssloy/tinyraytracer ↩︎
https://fennel-lang.org/setup ↩︎
https://love2d.org/wiki/Getting_Started ↩︎
there’s no need to declare a variable as var if it is a table and we’re only going to change the values stored inside the table, not the table itself. ↩︎

Comment via email

Simple Ray Casting with ClojureScript

Thu, 04 Jun 2020 13:49:00 +0300

Ray casting is quite an old technique, that was heavily used in the early days of game development in a lot of games to create an illusion of 3D space. The most known example, and perhaps the first widely successful game that used this technique, was Wolfenstein 3D, made by ID Software in 1992. There were a lot of other games for all kinds of platforms, that used ray casting, for example, I remember playing the labyrinth game on Siemens C35 in around 2001:

Yup, this phone is still alive, and still has this labyrinth game

There’s probably no reason to use ray casting for rendering pseudo-3D environments today, since this technique is very limited, and modern hardware is heavily optimized for working with triangles, which allows us to create very complex geometry that is impossible to model with ray casting. But I think that ray casting is a kinda cool idea, a simple concept, and definitively was a very smart move in the nineties game development. Additionally, ray casting has a lot more use cases than a simple rendering engine. Also, raycasting seems not to be a real word, but I’m going to refer to this technique like that further on, because it is convenient, and the engine itself can be referred to as raycaster.

For this project, I’ve chosen ClojureScript because I want to get into it, and into Clojure as well. Although my experience with Lisps is not very rich, the main usage right now is for writing functions in Emacs Lisp, but those are rather basic. I’m also going through SICP with GNU Guile and Racket, and though exercises in this book are sometimes brutal, this is not real programming experience. So the real goal of this post is rather not to implement a basic raycaster, but learn some Clojure. What, you thought we’re here for games? Just kidding, we’ll make a simple maze game too, which will be playable on this page.

But first, let’s understand what raycasting is, by going through some basic examples.

Ray casting basics

The general idea behind this technique is that we can imitate a 3D environment based only on 2D information. This is done by casting rays from the point, where the camera stands, and measuring the length of each ray until it hits any of the line segments, that represent walls on a 2D plane. I’ve prepared some pictures to illustrate this idea:

We can look at this as a top-down view of our scene. But how would we convert it to a first-person pseudo-3D view? The answer, as you might expect, is rays. Our camera will shoot a certain amount of rays in front of it, and we will see which rays have intersection points with our red and green walls. Let’s shoot 6 rays:

Now we can find intersections with our walls. I’ve cut those rays, and calculated their lengths - this is the only information we need to make this 2D plane into a pseudo-3D scene. Going from left to right, lengths are roughly 23.7, 24.2, inf, 34.8, 30.3, 27.5 pixels each:

So, in order to make a 3D scene out of these lengths we, first, have to create an empty scene. Let’s make it 256 by 224 pixels. We then divide this scene’s width by amount of rays, to compute the width of each ray, and fill this scene with rectangles of this width, which gives us roughly 42.7 pixels wide rectangles:

This doesn’t look like 3D yet, and you can notice that there are only 5 out of the total 6 rectangles presented. This is due to the fact that one ray had infinity length, since it did not intersect with anything, so we don’t draw anything there. And to make it look 3D we need to change the height of each rectangle accordingly to the length of each ray. General rule – the shorter the ray, the bigger the height:

Now, this looks more like a 3D scene, isn’t it? But the walls don’t exactly look like walls, more like a set of rectangles. We can fix this by increasing our resolution, which we do by casting more rays. Also, let’s add background and remove rectangle outlines:

We can also change the field of view, by keeping the same amount of rays but changing the angle between those:

Which is more convincing, but still not as smooth as it could be. But, we can think about rays as our resolution, so if we would cast 256 rays, one ray for each pixel of image width, we would get something like this:

More advanced raycasting engines can produce various perspective corrections for such rectangles, making things appear at different heights. This is often used to imitate a camera shake while walking. Textures can be mapped to walls and the floor, and very basic lighting can be achieved by changing texture brightness depending on the distance. Even more advanced engines allow changing the vertical angle of the camera to imitate looking up and down. But we will implement pretty basic untextured raycasting, extending it further can be an interesting task, but I don’t feel like doing it with canvas. Maybe later, with WebGL.

Project structure

I’ll be using shadow-cljs to manage my project. I’ve found this one very straightforward and simple to set up with Leiningen. To create cljs project via lein type this in the command line (I’m using Linux, so) some details on project setup may vary for different operating systems:

$ lein new shadow-cljs raycasting

As a result, it should create the following file structure for us:

raycasting/
├── package.json
├── public
│   ├── css
│   │   └── style.css
│   └── index.html
├── README.md
├── shadow-cljs.edn
└── src
    └── raycasting
        └── core.cljs

Let’s look at shadow-cljs.edn:

;; shadow-cljs configuration
{:source-paths ["src"]
 :dependencies [[binaryage/devtools "0.9.7"]
                [reagent "0.8.0-alpha2"]]
 ;; set a nrepl port for connection to a REPL.
 :nrepl {:port 8777}
 :builds {:app {:target :browser
                :output-dir "public/js/compiled"
                :asset-path "/js/compiled"
                :modules {:main {:entries [raycasting.core]}}
                :devtools
                ; before live-reloading, any code calls this function
                {:before-load raycasting.core/stop
                 ;; after live-reloading finishes call this function
                 :after-load raycasting.core/start
                 ;; serve the public directory over http at port 8700
                 :http-root    "public"
                 :http-port    8700
                 :preloads     [devtools.preload]}}}}

Probably you won’t need to change much here, but I’ve removed reagent dependency, because I don’t need it, so my shadow-cljs.edn looks like this:

{:source-paths ["src"]
 :dependencies [[binaryage/devtools "0.9.7"]]
 :nrepl {:port 8777}
 :builds
 {:app {:target :browser
        :output-dir "public/js/compiled"
        :asset-path "/js/compiled"
        :compiler-options {:optimizations :advanced}
        :modules {:main
                  {:entries [raycasting.core]}}
        :devtools {:http-root "public"
                   :http-port 8700
                   :preloads  [devtools.preload]}}}}

I’ve also added :compiler-options {:optimizations :advanced} to produce smaller js file, and removed :before-load and :after-load functions, because I don’t think we need those, and script initialization on page load is sufficient enough.

One last thing - we need a test page to see the results of our code, so let’s create public/index.html file, where we will add our canvas, and other elements as we go.

With the project setup and ready we now can begin working on ray casting by creating a camera.

Creating a camera

Since we’re going to cast rays out from the camera, we need a camera in the first place. Camera will be represented as a single point on the plane with x and y coordinates, and degree parameter. Let’s create a file src/raycasting/camera.cljs and define camera by using atom so we could later update it:

(ns raycasting.camera)

(def camera (atom {:x 0.0 :y 0.0 :degree 0.0}))

Code Snippet 1: Contents of src/raycasting/camera.cljs

Our camera is a hash map with three key-value pairs for each of its parameters. We can later access these parameters by calling keys on this map like this:

raycasting.camera> (:degree @camera)
0.0

This is quite handy, and we can update our map with assoc procedure:

raycasting.camera> (assoc @camera :degree 45.0)
{:x 0.0 :y 0.0 :degree 45.0}

Or use merge-with procedure to change the value currently stored in the map, by using some procedure, which is + in our case:

raycasting.camera> (merge-with + @camera {:degree 90.0})
{:x 0.0 :y 0.0 :degree 90.0}

You can notice that while I’ve used assoc to change my :degree to 45.0 and then used merge-with with + to add 90.0 degrees to current :degree, I’ve still got 90.0 as the result, and not the expected 135.0. This is because camera is a value, and can’t really change, and instead we’re producing a new value based on old one. And since our old value never changed, it still had 0.0 as :degree. To understand how this works we need to understand what is considered a value and why. You can skip explanations of this if you want, since it mostly has nothing to do with raycasting itself, but this still may explain certain things that we will see later in the code.

In Clojure, we mostly work with values, and there are no variables as presented in other languages. To make it more clear, let’s talk about what is considered a value. For example, in Rust 42 is a value, that we can assign to a variable like this:
let mut a = 42;
We’ve created a mutable variable a, and put 42 into it. We can later mutate a to hold another value:
a -= 15;
The key here is mutate - we’re not magically transforming 42 itself into 27, we’re changing the contents of a. So a is like a box that contains a value. You can’t really do anything to 42 itself – it is and always will be 42, that’s why it is a value. So when we did a -= 15, we’ve produced a new value based on the old one, and put it into a. So values never change, only variables that hold these values change what they are holding.

As an example of something that is not a value in Rust, we can look at the Vector collection:
let mut b = vec![1, 2, 3];
This is a dynamic array, that holds three elements. And we can actually change this array by using different methods that it provides, like push:
b.push(4); // now collection holds these four elements [1, 2, 3, 4]
After this push, whenever we refer to b it will hold four elements. We’ve declared b as mut, but we’re not mutating b itself, but the collection that b holds - and because of that this is not a value. mut keyword only specifies that we can mutate collection. But even if we were to drop the mut keyword in both examples, e.g. let a = 42, let b = vec![1, 2, 3], we would not be able to mutate both of these, but it still would not turn [1, 2, 3] into a value, although we can treat it as a value, underlying semantics of a collection has not changed.

(Semi-)real-world example - I give you an apple, and ask you to give me back half of it. You slice the apple and give me back one half. This apple is not a value, because you’ve literally changed it by slicing, and now the original apple is no longer available for both of us. You now hold half of the apple, and I hold another half. This is what happens when you modify a vector or any other collection.

Then I give you an apple made out of a material that once cast, can’t be destroyed, and ask you to give me half of it. You can’t slice it, or do anything to it at all, so you take very precise measures of this apple, cast a new piece out of the same material, and give it back to me. We now have the original apple and an apple slice. Then you can throw this apple in the garbage because you can’t really do anything with it. This is what essentially happens when you do math with numbers - you can’t change 42, you can take the measure (15) and produce 27 by subtraction. And this is what makes such an apple to be a value.

So in Clojure, we work with such type of data, and all Clojure collections are immutable. But the other major aspect of Clojure’s collections is persistence. The apple I’ve described isn’t really persistent, because once you’ve made a new slice, nothing really tells me what its past state was - was it a whole apple or 3/4 of an apple? So in order to make things persistent, we must provide additional information with apple, like a serial number for example. When you cast a new slice, you create a new serial number, that contains information about the old serial number. This way we can look at our piece, and determine what apple was used as a reference.

Now, whenever we create new copies, we encode the previous serial number into the current serial number, and from any point, we are able to trace back to the original state of the apple.

You can argue, that this can be done with an ordinary apple just as with an indestructible one, but the difference is, that an ordinary apple can be changed. Imagine that you’ve made a new apple based on it, added a serial number, that encodes that it was derived from the original apple, and then someone bit off a piece of the original apple. Then any holder of your copy of apple will try to refer to the original one and will find out not what they expected. Or maybe what they expected, since the apple could have been bitten before and you’ve restored the original form of an apple when made it. There’s no way to tell and preserve correct history. So even though we can enforce mutation restrictions in Rust, this does not make the vector into a value.

This is kinda what Clojure does with its collections. But instead of using identifiers, Clojure uses path copying for sharing structure between states. So newer state refers to some point in the old state. There are many different ways to maintain persistence, which are nicely described on this Wikipedia page.

A very simple example of persistent collection we can refer to is a single linked list, that grows at the front. Let’s start with a list of these three items (1 2 3). This can be represented as boxes that hold values, and have pointers to what should be the next value:

So 1 refers to 2, 2 refers to 3, and 3 refers to nothing, which indicates end of the list. Now we add another element to it at the front, which produces a new list (0 1 2 3):

You can see that all we did is created a box to hold 0 and told it to point to a box that holds 1. The rest thing is our old list, marked with green boxes, and we did not copy anything from it. And old list did not change at all, only a new node was added to it at the front, but the old list knows nothing about it. So if we stored our original list somewhere, and added 0 to it, our original list was not changed.

Furthermore, if we check the identity of our new list without its first element, it will be the same as in the original list:
user=> (identical? '(1 2 3) '(1 2 3))
false
user=> (def a '(1 2 3))
user=> (identical? a (rest (conj a 0)))
true
First identical? test gives us false because these are two different objects, even though their values are the same. The second identical? test gives us true, because, as I’ve said, by adding a new value to the list, and then removing it, we get back the original list.

And all of the collections in Clojure work this way, with a promise of fast change and low memory cost. Although such collections are not as fast as mutable non-persistence collections, they are much more reliable, especially when it comes to concurrent programming, and reliability is much more important than speed most of the time.

But in our raycasting we will have to really change camera position, so how do we do it if collections can’t be changed, and we’re using a hash map to hold camera coordinates and angle?

Moving the camera

When we’ve created camera we’ve used the atom procedure to produce a reference type that can be later atomically swapped to hold another value, and the swapping mechanism is concurrently safe. So, in order to update our map, all we need to do is to call swap! procedure, and pass our atom and a procedure that will update the value:

raycasting.camera> (swap! camera (fn [c] (assoc c :degree 45.0)))
{:x 0.0 :y 0.0 :degree 45.0}

Now, when we dereference camera with @, we can actually see the updated value:

raycasting.camera> @camera
{:x 0.0 :y 0.0 :degree 45.0}

Using swap with anonymous procedures is kinda tedious, so instead, let’s create a set of procedures that we will use to move the camera around:

(def radian (/ Math/PI 180.0)) ➊

(defn move-point [[x y] degree amount] ➋
  (let [angle (* degree radian)]
    [(+ x (m/three-decimal (* (Math/sin angle) amount)))
     (+ y (m/three-decimal (* (Math/cos angle) amount)))]))

(defn move-forward
  "Move `camera` forward given `amount` respecting the `degree`."
  ([camera] (move-forward camera 1))
  ([camera amount]
   (let [{x :x
          y :y
          degree :degree} camera ➌
         [x y] (move-point [x y] degree amount)]
     (assoc camera :x x :y y))))

This procedure will move our camera forward relatively to where the camera is pointed at. We compute ➊ only once, to later convert degrees to radians by multiplication. The move-point ➋ procedure will later be used in several places of our program, so it is good to have it as a separate procedure, while move-forward is used exclusively for camera movement. And inside we have weird construction ➌ which is called Associative Destructuring. We essentially bind x, y, and degree within our let block, to the values contained in camera. Now let’s try to move our camera around:

raycasting.core> (move-forward (assoc @camera :degree 0.0) 10)
{:x 0, :y 10, :degree 0}
raycasting.core> (move-forward (assoc @camera :degree 90.0) 10)
{:x 10, :y 6.123233995736766e-16, :degree 90}

Uh oh. Moving forward with 0 degrees was fine, but when we’ve turned 90 degree, we’ve got 6.123233995736766e-16 as our y coordinate. This value is very close to 0, but we don’t really need such precision, and there are some problems with such small values in JavaScript. Let’s write a macro, that will truncate it to three decimal places, which would be more than enough for our needs:

(defmacro three-decimal
  "Truncate `double` to three decimal places."
  [num]
  `(/ (int (* 1000 ~num)) 1000.0))

(defn move-forward
  "Move `camera` forward given `amount` respecting the `degree`."
  ([camera] (move-forward camera 1))
  ([camera amount]
   (let [rad (* (:degree camera) (/ Math/PI 180.0))]
     (merge-with + camera {:x (three-decimal (* (Math/sin rad) amount))
                           :y (three-decimal (* (Math/cos rad) amount))}))))

This will not work though. The problem is, that we can’t just define a macro in the same file that we’ve declared procedure. This is a difference between Clojure and ClojureScript, so we have to create new file src/raycasting/macros.cljc, and use :require-macros in our namespace definition for camera.cljs:

(ns raycasting.camera
  (:require-macros [raycasting.macros :as m]))

Now we can update move-forward to refer to macro:

(defn move-forward
    "Move `camera` forward given `amount` respecting the `degree`."
    ([camera] (move-forward camera 1))
    ([camera amount]
     (let [rad (* (:degree camera) (/ Math/PI 180.0))]
       (merge-with + camera {:x (m/three-decimal (* (Math/sin rad) amount))
                             :y (m/three-decimal (* (Math/cos rad) amount))}))))

Let’s try it:

raycasting.core> (move-forward (assoc @camera :degree 0.0) 10)
{:x 0, :y 10, :degree 0}
raycasting.core> (move-forward (assoc @camera :degree 90.0) 10)
{:x 10, :y 0, :degree 90}

Nice. Now, we can do the same thing to rotate the camera:

(defn rotate
  "Rotate `camera` by a `degree`."
  ([camera] (rotate camera 0.5))
  ([camera degree]
   (assoc camera :degree (mod (+ (:degree camera) degree) 360.0))))

And if we call this:

raycasting.core> (rotate @camera 420)
{:x 0.0, :y 0.0, :degree 60.0}

The rotate procedure ensures that our :degree stays inside 360 degrees, so when we specify a turn that is more than 360 degrees, we wrap around. These are two main procedures we will later use.

Drawing

Now we can draw our camera on <canvas>. Let’s add this to our index.html:

<!DOCTYPE html>
<html lang="en-US">
  <head>
    <meta charset="UTF-8">
    <script src="js/compiled/main.js"></script>
  </head>
  <body>
    <canvas id="raycaster" width="512" height="224"></canvas>
    <script>
      window.onload = function() {
        raycasting.core.init();
      }
    </script>
  </body>
</html>

We’ve added our <canvas> and gave it an id. We will later be able to refer to this canvas via this id, so let’s create two vars to hold the canvas object, and its context:

(ns raycasting.core
  (:require [raycasting.camera :as cam]))

(defonce *canvas* nil)
(defonce *ctx* nil)

(defn ^:export init []
  (when-let [canvas (. js/document getElementById "raycaster")]
    (set! *canvas* canvas)
    (when (. *canvas* -getContext)
      (set! *ctx* (. *canvas* getContext "2d")))))

We use defonce here, so when we save file, and shadow-cljs hot reloads the code, we will not redefine our *canvas* and *ctx* to nil. And init procedure will run on onload event, and set our *canvas* and *ctx*.

Let’s create draw-camera procedure, that will take current camera state, and draw it to canvas:

(defn draw-line
  ([[x1 y1] [x2 y2]]
   (draw-line [x1 y1] [x2 y2] "#000000"))
  ([[x1 y1] [x2 y2] color]
   (set! (. ctx -strokeStyle) color)
   (doto ctx
     (.beginPath)
     (.moveTo x1 y1)
     (.lineTo x2 y2)
     (.stroke))))

(defn draw-camera [camera]
  (let [[x y :as pos] [(:x camera) (:y camera)]
        pointer (cam/move-point pos (:degree camera) 7)
        width 5]
    (draw-line pos pointer "#000000")
    (set! (. ctx -fillStyle) "#000000")
    (. ctx fillRect (- x (/ width 2)) (- y (/ width 2)) width width)))

Now, if we write this to the REPL:

raycasting.core> (draw-camera @cam/camera)
nil

We should see our camera:

Now let’s add some walls to look at.

Creating walls

I need to mention, that many raycasting engines define stages in terms of squares on the grid. This is useful because we can check intersections a lot faster since we only need to perform checks along the ray in fixed points of space. While this is quite fast, I want arbitrarily placed walls in my raycaster. Because of this, our algorithm will not be as optimal, but we will be able to handle more complex wall placement.

Let’s create new file src/raycasting/stage.cljs. In this file, we will define our stages. Each stage is a vector, with line segments, that have three components - beginning coordinate, endpoint, and color. Let’s define stage, as on our example picture.

(ns raycasting.stage)

(def example-stage
  [ ➊
   [ ➋
    [23.468 126.290] ➌
    [106.189 87.527] ➍
    "#89a02c"] ➎
   [[124.947 40.268] [166.507 95.415] "#916f6f"] ➏])

So what we’re doing here is, we begin by creating a vector ➊. This vector will hold all lines that our stage uses. We define another vector ➋, that will hold beginning point ➌, ending point ➍, and wall color ➎. Lastly, we specify another line ➏, and this process can continue on and on. Bigger stages will require a lot of walls, and this can be a performance hit, but we’re not aiming for the best efficiency.

Now we can implement wall drawing with our draw-line procedure, that we’ve already used in draw-camera procedure. Let’s create draw-stage procedure, that will walk through our vector of walls and draw each on the canvas:

(defn draw-stage [stage]
  (doseq [line stage]
    (apply draw-line line)))

doseq is a great way to iterate on a collection for producing side effects, such as drawing on the screen. Let’s move our camera to the position 119.5,180, and rotate it to 180 so it is placed as on our example. Now if we call this procedure, we should see our stage:

raycasting.core (swap! cam/camera #(assoc % :x 119.5 :y 180 :degree 180))
{:x 119.5 :y 180 :degree 180}
raycasting.core> (draw-camera cam/camera)
nil
raycasting.core> (draw-stage stage/example-stage)
nil

While we are at this, notice how awkward we’ve been setting our position for camera:

(swap! cam/camera #(➊ assoc ➋ % ➌ :x 119.5 :y 180 :degree 180))

➊ #() is a shorthand for creating an anonymous procedure. This procedure will call assoc ➋, and % ➌ will be our cam/camera. A more elaborate way to write the same code would be (fn [camera] (assoc camera …)). We could simplify this by using reset!:

(reset! cam/camera {:x 119.5 :y 180 :degree 180})

Which is much simpler, but still very error-prone, because we’ll have to remember what keys should be in the map. This is not an issue for three key-value pair maps, but for huge maps, it will be better to create some kind of initialization procedure. Let’s create one in raycasting.camera namespace:

(defn set-position
  "Set position of the `camera` to a certain `x`, `y`, and `degree`.")
➊ ([camera] (set-position camera 0 0 0))
➋ ([camera x y] (set-position camera x y 0))
➌ ([camera x y degree] (assoc camera :x x :y y :degree (mod degree 360.0)))

This is called Multi-arity function, we’ve been using it before, but I’ve never explained what it is. In Clojure and ClojureScript it is possible to define procedure overloading based on the number of given arguments. In this example we create three possible ways to call our procedure: ➊ - we only pass our camera parameter, and it resets its position to 0,0 coordinates, and set’s 0 degree angle, ➋ - we specify coordinates, but we don’t care about our angle, so we reset it, and ➌ - we provide all needed parameters, and set those accordingly with assoc. The beauty of multi-arity procedures is that it can call itself with another amount of arguments, so in this case, there’s only one real body, that does the work (➌), and others (➊, ➋) are only calling it with all needed parameters. With this procedure we can quickly set the desired position for our camera:

raycasting.core> (swap! cam/camera cam/set-position) ;; reset
{:x 0 :y 0 :degree 0}
raycasting.core> (swap! cam/camera cam/set-position 10 20) ;; set coordinates
{:x 10 :y 20 :degree 0}
raycasting.core> (swap! cam/camera cam/set-position 10 20 90) ;; fully specify position
{:x 10 :y 20 :degree 90}

We can use this later when we initialize our stages in the game.

Casting rays

Now, when we have our camera and walls, we can finally cast some rays. Although, we’re not casting rays, but really long line segments because our algorithm will check for intersections between line segments of stage walls, and our rays.

First, we need some linear algebra. In particular, we need to check if two line segments intersect or not. This is done by three procedures. First one checks if a point lies on the line segment:

(defn on-segment?
  "Checks if point `[ax ay]` lies on segment defined by two points `[b
  c]`, where each point is defined as a vector `[x y]`."
  [[ax ay] [[bx by] [cx cy]]]
  (and (<= ax (max bx cx))
       (>= ax (min bx cx))
       (<= ay (max by cy))
       (<= ay (min by cy))))

This procedure accepts a point, and a line segment defined as two points and checks whenever the point lies on that line segment. We will need this procedure because when we will check for intersections, we need to ensure, that we’re staying inside line segments.

Next bit is orientation procedure:

(defn orientation [[ax ay] [bx by] [cx cy]]
  (let [orientation (- (* (- by ay) (- cx bx))
                       (* (- bx ax) (- cy by)))]
    (cond (> orientation 0) :cw
          (< orientation 0) :cc
          :else :colinear)))

This procedure checks the relationship of point a, and points b and c. These relationships can be :cw (for clockwise), :cc (for counter clockwise), and :colinear:

Now we can check for the intersection itself:

(defn intersect?
  "Checks if two line segments intersect. Line segments are defined as
  vector of two points `[a1 a2]`, and each point is a vector of two
  coordinates `[x y]`."
  [[a1 a2] [b1 b2]]
  (let [o1 (orientation a1 a2 b1)
        o2 (orientation a1 a2 b2)
        o3 (orientation b1 b2 a1)
        o4 (orientation b1 b2 a2)]
    (or
     (and (not (= o1 o2))
          (not (= o3 o4)))
     (and (= o1 :colinear)
          (on-segment? b1 [a1 a2]))
     (and (= o2 :colinear)
          (on-segment? b2 [a1 a2]))
     (and (= o3 :colinear)
          (on-segment? a1 [b1 b2]))
     (and (= o4 :colinear)
          (on-segment? a2 [b1 b2])))))

To find the point of the intersection itself, we need to calculate these two formulas:

Let’s write those as intersection procedure:

(defn intersection [[[x1 y1] [x2 y2] :as ray] [[x3 y3] [x4 y4] :as wall]]
  (let [x (/ (- (* (- (* x1 y2) (* y1 x2)) (- x3 x4)) (* (- x1 x2) (- (* x3 y4) (* y3 x4))))
             (- (* (- x1 x2) (- y3 y4)) (* (- y1 y2) (- x3 x4))))
        y (/ (- (* (- (* x1 y2) (* y1 x2)) (- y3 y4)) (* (- y1 y2) (- (* x3 y4) (* y3 x4))))
             (- (* (- x1 x2) (- y3 y4)) (* (- y1 y2) (- x3 x4))))]
    [x y]))

I’ve added :as ray and :as wall to make it more clear what these points are related to. The order doesn’t really matter, since we’re computing a point, but I think it gives a slight idea of what this procedure expects.

As a final piece, we need a procedure, that will find all intersections for our ray, and return those in some form, that will be usable for us later. I’ve created this procedure, that takes our stage, and two points as ray:

(defn find-intersections [stage [origin end :as ray]]
➊ (->> stage
       (map (fn [wall]
              (if (intersect? ray wall)
                (let [new (intersection ray wall)]
                  [(distance origin new) new])
                [10000000 end])))
       (into {})))

Here we’re using thread last macro ➊, which essentially takes the result of our expression, and puts it in the last position in the next expression. We then map with an anonymous procedure, that takes wall, from our stage, and checks if it intersects? with our ray. If it does, we calculate new intersection point, and return a vector of the distance between ray origin and intersection point, and this new point. When map finishes, it produces this kind of list ([10 [0 15]] [11 [4.2 22.8]] … [length [x y]]). We then convert it into a hash map, where a length will be our key, and a set of coordinates will be our value. The distance procedure is defined as follows:

(defn distance [[x1 y1] [x2 y2]]
  (m/three-decimal
   (Math/sqrt (+ (Math/pow (- x1 x2) 2)
                 (Math/pow (- y1 y2) 2)))))

Now we finally can cast our rays. First, let’s cast a set of rays and draw those without truncation at the intersection point:

(defn cast-rays [camera]
  (let [ray-count 16
        step (/ fov ray-count)
        ray-start [(:x camera) (:y camera)]]
    (loop [n (dec ray-count)
           degree (:degree (cam/rotate camera (- (/ fov 2.0))))]
      (when (>= n 0)
        (let [ray-end (cam/move-point ray-start degree 5000)]
          (draw-line ray-start ray-end "#ffe680")
          (recur (dec n)
                 (+ degree step)))))))

Now if we call our procedures for drawing rays, camera, and stage like this:

raycasting.core> (draw-stage stages/example-stage)
nil
raycasting.core> (cast-rays @cam/camera)
nil
raycasting.core> (draw-camera @cam/camera)
nil

We should see this result:

Now let’s change this procedure, so it will find ray ends before drawing:

(defn cast-rays [camera stage]
  (let [step (/ fov rayCount)
        ray-start [(:x camera) (:y camera)]]
    (loop [n (dec rayCount)
           degree (:degree (cam/rotate camera (- (/ fov 2.0))))]
      (when (>= n 0)
        (let [ray-end (cam/move-point ray-start degree 5000)]
            ➊ intersections (find-intersections stage [ray-start ray-end])
            ➋ shortest-ray (apply min (keys intersections))
            ➌ ray-end (intersections shortest-ray)
          (draw-line ray-start ray-end "#ffe680")
          (recur (dec n)
                 (+ degree step)))))))

First, we compute a map of intersections ➊, then find the shortest intersection length from the map by applying the min procedure to the list of keys in the map ➋, and lastly get the closest endpoint for given ray ➌.

This way we can find all intersections of the given ray with all walls, but we will draw only the shortest one, like this:

To illustrate this a bit better, let’s create simple animation by making our camera rotate:

Now we can use the cast-rays procedure to make our pseudo-3D image.

Making a 3D view of our scene

We’ll need to modify our cast-rays procedure, so it would return a list of rays instead of drawing it:

➊ (defn angle-between [[[x1 y1] [x2 y2]] [[x3 y3] [x4 y4]]]
     (let [theta1 (Math/atan2 (- y1 y2) (- x1 x2))
           theta2 (Math/atan2 (- y3 y4) (- x3 x4))
           diff (Math/abs (- theta1 theta2))]
       (min diff (Math/abs (- 180 diff)))))

(defn cast-rays [camera stage]
  (let [step (/ fov rayCount)
        ray-start [(:x camera) (:y camera)]]
      ➋ central-ray [ray-start (cam/move-point ray-start (:degree camera) 100)]
    (loop [n (dec rayCount)
           degree (:degree (cam/rotate camera (- (/ fov 2.0))))
           rays ()]
      (if (>= n 0)
        (let [ray-end (cam/move-point ray-start degree 5000)
              intersections (find-intersections stage [ray-start ray-end])
              shortest-ray (apply min (keys intersections))
              ray-end (intersections shortest-ray)]
            ➌ ray-angle (angle-between [ray-start ray-end] central-ray)
          (recur (dec n)
                 (+ degree step)
               ➍ (conj rays [ray-end shortest-ray ray-angle n]))))
      ➎ rays)))

(defn draw-rays [camera rays]
  (let [pos [(:x camera) (:y camera)]]
    (doseq [[ray] rays]
      (draw-line pos ray "#ffe680"))))

First, we’ve defined an angle-between ➊ procedure, which takes two line segments and computes the angle between those in radians. We then added one extra computation before we cast rays - we compute central-ray ➋, a direction where the camera is looking. Then, we compute the angle between the current ray we’re casting and the central ray ➌. After that we’re conjing ➍ vector with endpoint, shortest length, angle, and ray number to a list of rays. Finally, we return a list of rays ➎ to the caller. draw-rays will later use these rays afterward and draw each one ray by ray.

Now, whenever we call this procedure, we get all the useful information that we will later need to produce an image. First, let’s create another procedure, that will render all our elements on screen in a sequence:

(defn render []
  (let [height (. *canvas* -height)
        width (. *canvas* -width)
        camera @cam/camera
        rays (cast-rays camera stage)]
    (. *ctx* clearRect 0 0 width height)
    (draw-rays rays)
    (draw-camera camera)
    (draw-stage stage)))
➊ (. js/window requestAnimationFrame render)

This is a skeleton, not a fully realized procedure. Note that at ➊, we request another frame to be drawn on our canvas. So this is more like a game loop, though not quite. We will use it as our game loop though.

So, what we do here, is we create a set of bindings on each frame, and we dereference our cam/camera to get its position and angle, and then cast rays from the camera on our stage. Later we clear canvas and call draw-rays, draw-camera, and draw-stage.

Calling this procedure should initiate an animation sequence, so if we add (swap! cam/camera cam/rotate 1), at some point we will have an animation of the rotating camera. Now let’s create a 3D view:

(defn draw-3d-stage [rays]
  (let [ray-width (/ (/ (. canvas -width) 2) rayCount)
        height (. canvas -height)
        canvas-width (/ (. canvas -width) 2)])

  ➊ (set! (. ctx -fillStyle) "#333")
    (. ctx fillRect canvas-width 0 canvas-width (/ height 2))
    (set! (. ctx -fillStyle) "#666")
    (. ctx fillRect canvas-width (/ height 2) canvas-width (/ height 2))

  ➋ (loop [rays rays]
      (when (not (empty? rays))
        (let [[_ distance ray-degree n] (first rays)]
            ➌ wall-height (- height distance)
              wall-height (if (< wall-height 0)
                            0
                            wall-height)
            ➍ wall-color wall-height
          (set! (. ctx -fillStyle) (str "rgb("wall-color","wall-color","wall-color")")))
        ➎ (. ctx
             fillRect
             (+ canvas-width (* n ray-width))
             (- (/ height 2) (/ wall-height 2))
             (+ ray-width 1) ;; extra pixel for border
             wall-height)
        (recur (rest rays)))))

This procedure first fills background ➊, then, we loop through each ray, we calculate wall height by simply subtracting canvas height and distance to the wall ➌, and since our canvas is 256 pixels high, we use this value as our color as well ➍. Not really a pretty solution, but will do it for now. Then we fill a rectangle of this height, and width, with an offset of half of the canvas width plus the number of the ray, times its width. Calling this procedure in our render procedure gives us such a view:

Sure this gives us the desired 3d view, but something is not right. When we look at our walls we can see that we get some kind of fish eye effect, which we can see in its full form if we look directly at the wall:

There’s a good reason for this, which we can fix, although it requires a few additional calculations.

Fisheye compensation

The reason for this effect is the method we’re using to calculate wall heights. Here’s how we currently view our would:

This curve is our screen, so if we were to display this on a non-flat screen with the opposite curve, our image would look natural. However our screens are flat, so we need to compensate for this. In order to do this, we need to compute distances while taking into account the number of degrees between camera direction and the ray we currently casting.

First, let’s declare angle-between procedure, that will return the angle between two line segments, one of which will be the direction where the camera is facing, and the other one is the ray we currently casting:

(defn angle-between [[[x1 y1] [x2 y2]] [[x3 y3] [x4 y4]]]
  (let [theta1 (Math/atan2 (- y1 y2) (- x1 x2))
        theta2 (Math/atan2 (- y3 y4) (- x3 x4))
        diff (Math/abs (- theta1 theta2))]
    (min diff (Math/abs (- 180 diff)))))

Now we can use it in our cast-rays procedure:

(defn cast-rays [camera stage]
  (let [step (/ *fov* *ray-count*)
        ray-start [(:x camera) (:y camera)]
        central-ray [ray-start (cam/move-point ray-start (:degree camera) 100)]]
    (loop [n (dec *ray-count*)
           degree (:degree (cam/rotate camera (- (/ *fov* 2.0))))
           rays ()]
      (if (>= n 0)
        (do (let [ray-end (cam/move-point ray-start degree 5000)
                  intersections (find-intersections stage [ray-start ray-end])
                  shortest-ray (apply min (keys intersections))
                  ray-end (intersections shortest-ray)]
                ➊ ray-angle (if *compensate-fisheye*
                              (angle-between [ray-start ray-end] central-ray)
                              0)
              (recur (dec n)
                     (+ degree step)
                   ➋ (conj rays [ray-end shortest-ray ray-angle n]))))
        rays))))

We store calculated angle ➊, and then add it to our ray and conj it to our rays collection. This vector already is quite big, so it would be better to use some associative collection instead. Let’s change it:

(conj rays {:end ray-end :length shortest-ray :angle ray-angle :n n})

Now, that cast-rays returns a list of hash maps, we need to update our other procedures that expected a list of vectors. I’ll omit these steps, as it ain’t much different from what I’ve previously described, and this post is already way longer than I’ve thought, but using hash maps will prove more usable when we will need to incorporate other information into our ray, such as color.

Now we can use angles in draw-3d-scene procedure. We’ll change our distance computation to use Math/cos procedure, to compute corrected distance:

distance (* distance (m/three-decimal (Math/cos ray-degree)))

This should give us the such result:

This looks correct when we face the wall at a 90-degree angle. But if we’re aligned with the wall, we get this:

Which is not right. Wall is curved for some reason.

Note: To be completely honest, up to this point I did everything without using existing raycasting tutorials. But when I applied a seemingly correct fisheye compensation, and it has gone away only partially, I got stuck for a while. So in order to find a correct way to compensate for this fisheye effect, I’ve read this one, but for some reason the formula there didn’t work for me, so I’ve altered it.

So it seems that we’re missing the projection plane. Let’s create one:

(defn projection-distance [width]
  (m/three-decimal (/ (/ *ray-count* 2) (Math/atan (* (/ *fov* 2) cam/radian)))))

It is better to compute this once, but since we can change the ray count, we have to recompute this.

With this distance we can add computation in our wall-height computation process:

(defn draw-3d-stage-example9 [rays]
  (let [ray-width (/ (/ (. *canvas* -width) 2) *ray-count*)
        height (. *canvas* -height)
        canvas-width (/ (. *canvas* -width) 2)
        projection-distance (projection-distance canvas-width)]
    (set! (. *ctx* -fillStyle) "#333")
    (. *ctx* fillRect canvas-width 0 canvas-width (/ height 2))
    (set! (. *ctx* -fillStyle) "#999")
    (. *ctx* fillRect canvas-width (/ height 2) canvas-width (/ height 2))
    (loop [rays (sort (fn [{l1 :length} {l2 :length}] (> l1 l2)) rays)]
      (when-let [ray (first rays)]
        (let [{distance :length ray-degree :angle n :n} ray
              angle-step (/ *fov* *ray-count*)
              distance (if *compensate-fisheye*
                         (* distance (m/three-decimal (Math/cos ray-degree)))
                         distance)
              wall-height (* (/ (/ height *ray-count*) distance) projection-distance (/ *fov* 4))
              wall-height (if (> wall-height height)
                            height
                            wall-height)
              wall-color (+ wall-height 10)]
          (set! (. *ctx* -fillStyle) (str "rgb(" wall-color ", " wall-color "," wall-color ")"))
          (. *ctx*
             fillRect
             (+ canvas-width (* n ray-width))
             (- (/ height 2) (/ wall-height 2))
             (+ ray-width 1) ;; extra pixel for border
             wall-height))
        (recur (rest rays))))))

This looks much better in both examples:

Although walls now appear further. I’ve tried to make up constants that will play nice to make the wall occupy the whole height when we near the wall, so I’ll keep it this way. I’m sure I have some misunderstanding of the algorithm, but it works, so I’m ok with that.

Handling input and focus

Now, when we have our camera working, we can make it move by pressing arrow keys. We already have needed procedures for handling camera position and rotation, so the only thing we really need is input handlers, and a way to focus our canvas, so pressing arrows would not scroll the page.

There are some libraries for handling keyboard input, but I’m a purist, so we’ll implement this without dependencies. All we need is two procedures, that check if a key is pressed, and that it is released. Let’s create raycasting/input.cljs:

(ns raycasting.input)

(defonce key-states (atom {}))
(defonce focus false)

We start by defining another atom for our key states. It will hold a map of keys and their states, like this {"Up" false, "Down" true}, which means that currently the Down key is pressed down. Another one is focus which we will use to determine whether should we handle input or not.

Let’s add these three procedures:

(defn valid-key? [key]
  (or (= key "Escape")
      (= key "Shift")
      (= key "ArrowLeft")
      (= key "ArrowUp")
      (= key "ArrowRight")
      (= key "ArrowDown")))

(defn on-key-press [event]
  (when focus
    (let [event (if event event (. js/window -event))
          key (. event -key)]
      (when (valid-key? key)
        (. event preventDefault)
        (swap! key-states assoc key true)))))

(defn on-key-release [event]
  (when focus
    (let [event (if event event (. js/window -event))
          key (. event -key)]
      (when (valid-key? key)
        (swap! key-states assoc key false)
        (. event preventDefault)))))

We’ll get our keys as strings, and check if this is one of the keys we need. If it is, and we’re focused, we swap! our key state with either true or false, so our key-states atom always holds most recent state. Now we need to assign these procedures to events:

(set! (. js/window -onkeyup) on-key-release)
(set! (. js/window -onkeydown) on-key-press)

We also have these procedures to handle focus:

(defn on-click [event]
  (set! focus true))

(defn release-focus []
  (set! focus false))

But we set these in the initialization code:

(defn ^:export init []
  (set! *canvas* (. js/document getElementById "raycaster"))
  (when *canvas*
    (. *canvas* addEventListener "mousedown" input/on-click)
    (swap! cam/camera cam/set-position 10 10 45)
    (when (. *canvas* -getContext)
      (set! *ctx* (. *canvas* getContext "2d"))
      (render))))

The final step would be to poll our keys on each frame in our render procedure. For this, we create another procedure, but in raycasting.core this time:

(defn move-camera [stage key-states]
  (let [{x :x y :y :as camera} @cam/camera]
    (when (key-states "Escape")
      (input/release-focus)
      (reset! input/key-states {}))

    (when (key-states "ArrowRight")
      (if (key-states "Shift")
        (let [{x' :x y' :y} (cam/strafe camera -1.5)]
          (when (not (detect-collision stage [[x y] [x' y']]))
            (swap! cam/camera cam/strafe -1)))
        (swap! cam/camera cam/rotate -1.5)))

    (when (key-states "ArrowLeft")
      (if (key-states "Shift")
        (let [{x' :x y' :y} (cam/strafe camera 1.5)]
          (when (not (detect-collision stage [[x y] [x' y']]))
            (swap! cam/camera cam/strafe 1)))
        (swap! cam/camera cam/rotate 1.5)))

    (when (key-states "ArrowUp")
      (let [{x' :x y' :y} (cam/move-forward camera 1.5)]
        (when (not (detect-collision stage [[x y] [x' y']]))
          (swap! cam/camera cam/move-forward 1.5))))

    (when (key-states "ArrowDown")
      (let [{x' :x y' :y} (cam/move-forward camera -1.5)]
        (when (not (detect-collision stage [[x y] [x' y']]))
          (swap! cam/camera cam/move-forward -1.5))))))

We then, call this procedure each frame as early as possible. You can notice that we’re calling another procedure detect-collision, it is much like our intersection finding stuff, but it calculates the end position of our camera, and checks if the path intersects with any of our walls. Not very optimal, but works well.

The last thing I want to add is a way to control the amount of rays, and field of view, as well as a fisheye compensation toggle. For that we’ll need these <input> tags:

<div>
  <input type="range" id="rayCountSlider"
         min="10" max="256" step="1"></input>
  <label for="rayCountSlider">Ray Count: </label>
  <output name="rayCountValue" id="rayCountOutput"></output>
</div>
<div>
  <input type="range" id="fovSlider"
         min="10" max="360" step="1"></input>
  <label for="fovSlider">Field of View: </label>
  <output name="fovSliderValue" id="fovSliderOutput"></output>
</div>
<div>
  <input type="checkbox" id="fishEyeCompensation"></input>
  <label for="fishEyeCompensation"> FishEye compensation</label><br>
</div>

And we need a way to control those. For this, let’s add these procedures:

(def max-fov 360)
(def max-compensated-fov 180)

(defn update-ray-count [event]
  (let [value (.. event -target -value)]
    (set! *ray-count* (js/parseInt value))
    (when-let [output (. js/document getElementById "rayCountOutput")]
      (set! (. output -innerHTML) value))))

(defn update-fov [event]
  (let [value (.. event -target -value)]
    (set! *fov* (js/parseInt value))
    (when-let [output (. js/document getElementById "fovSliderOutput")]
      (set! (. output -innerHTML) value))))

(defn update-fish-eye-compensation [event]
  (let [value (.. event -target -checked)]
    (set! *compensate-fisheye* value)
    (when-let [fov-slider (. js/document getElementById "fovSlider")]
      (set! (. fov-slider -max) (if value max-compensated-fov max-fov))
      (when (and value
                 (> *fov* max-compensated-fov))
        (set! *fov* max-compensated-fov)
        (set! (. fov-slider -value) max-compensated-fov)
        (when-let [fov-output (. js/document getElementById "fovSliderOutput")]
          (set! (. fov-output -innerHTML) *fov*))))))

(defn init-inputs []
  (when-let [ray-count-slider (. js/document getElementById "rayCountSlider")]
    (set! (. ray-count-slider -value) *ray-count*)
    (. ray-count-slider addEventListener "input" update-ray-count))
  (when-let [ray-count-output (. js/document getElementById "rayCountOutput")]
    (set! (. ray-count-output -innerHTML) *ray-count*))

  (when-let [fov-slider (. js/document getElementById "fovSlider")]
    (. fov-slider addEventListener "input" update-fov)
    (set! (. fov-slider -max) (if *compensate-fisheye* max-compensated-fov max-fov))
    (set! (. fov-slider -value) *fov*))
  (when-let [ray-count-output (. js/document getElementById "fovSliderOutput")]
    (set! (. ray-count-output -innerHTML) *fov*))

  (when-let [compensate (. js/document getElementById "fishEyeCompensation")]
    (. compensate addEventListener "click" update-fish-eye-compensation)
    (set! (. compensate -value) *compensate-fisheye*)))

In short, these are event handlers, which are called when we’re interacting with these inputs. We’re setting initial values as well, as the handlers in init-input procedure.

Coloring walls

Up until now, we were creating gray walls, which are fine, but boring. And you could notice that we’re drawing our lines in color, so walls have color information. Let’s update our find-intersections procedure to include color information, and use it to color our walls:

(defn find-intersections [stage [origin end :as ray]]
  (->> stage
       (map (fn [[_ _ color :as wall]]
              (if (intersect? ray wall)
                (let [new (intersection ray wall)]
                  [(distance origin new) {:end new :color (or color color "#eeeeee")}])
                [10000000 {:end end :color "#000000"}])))
       (into {})))

Now, we return a map that has length as its key, and another map, which holds endpoint and wall color as a value. We need to update our cast-rays procedure to use this information:

(defn cast-rays [camera stage]
  (let [step (/ *fov* *ray-count*)
        ray-start [(:x camera) (:y camera)]
        central-ray [ray-start (cam/move-point ray-start (:degree camera) 100)]]
    (loop [n (dec *ray-count*)
           degree (:degree (cam/rotate camera (- (/ *fov* 2.0))))
           rays ()]
      (if (>= n 0)
        (do (let [ray-end (cam/move-point ray-start degree 5000)
                  intersections (find-intersections stage [ray-start ray-end])
                  shortest-ray (apply min (keys intersections))]
                ➊ {ray-end :end color :color} (intersections shortest-ray)
                  ray-angle (if *compensate-fisheye*
                              (angle-between [ray-start ray-end] central-ray)
                              0)
              (recur (dec n)
                     (+ degree step)
                     (conj rays {:end ray-end :length shortest-ray :angle ray-angle :n n :color color}))))
        rays))))

We destructure our map ➊, and then use its values when we conj rays. If we use this color in our draw-3d-stage procedure, we’ll finally get results similar to what I showed in the very beginning:

But it would be nice if we keep the effect that more distant walls appear darker. To do that we’ll have to parse color, and dim it by some factor:

(defn dim [color amount]
  (let [dim-factor (Math/pow 1.1 (/ (inc amount) 7))
        color (int (/ color dim-factor))]
    (if (< color 25)
      25
      color)))

(defn dim-color [color distance]
  (let [red (js/parseInt (str "0x" (subs color 1 3)))
        green (js/parseInt (str "0x" (subs color 3 5)))
        blue (js/parseInt (str "0x" (subs color 5)))]
    (str "rgb("
         (dim red distance)
         ", "
         (dim green distance)
         ", "
         (dim blue distance)
         ")")))

These two procedures will dim colors encoded as six-digit hex colors, or #ffffff. We use our distance as the dim factor with some computations to make it look nice. Now we can use it in our draw-3d-stage procedure:

(defn draw-3d-stage [rays]
  (let [ray-width (/ (/ (. *canvas* -width) 2) *ray-count*)
        height (. *canvas* -height)
        canvas-width (/ (. *canvas* -width) 2)
        projection-distance (projection-distance canvas-width)
        gradient (. *ctx* createLinearGradient 0 0 0 height)]
    (doto gradient
      (.addColorStop 0 "#424242")
      (.addColorStop 0.5 "#111111")
      (.addColorStop 1 "#e2e2e2"))
    (set! (. *ctx* -fillStyle) gradient)
    (. *ctx* fillRect canvas-width 0 canvas-width height)
    (loop [rays (sort (fn [{l1 :length} {l2 :length}] (> l1 l2)) rays)]
      (when-let [ray (first rays)]
        (let [{distance :length ray-degree :angle n :n color :color} ray
              angle-step (/ *fov* *ray-count*)
              distance (if *compensate-fisheye*
                         (* distance (m/three-decimal (Math/cos ray-degree)))
                         distance)
              wall-height (* (/ (/ height *ray-count*) distance) projection-distance (/ *fov* 4))
              wall-height (if (> wall-height height)
                            height
                            wall-height)
              color (dim-color color distance)]
          (set! (. *ctx* -fillStyle) color)
          (. *ctx*
             fillRect
             (+ canvas-width (* n ray-width))
             (- (/ height 2) (/ wall-height 2))
             (+ ray-width 1) ;; extra pixel for border
             wall-height))
        (recur (rest rays))))))

I’ve also added a bit more nice gradient for our background color there. This will be our final version of this procedure.

Labyrinth game

Now we can create a small labyrinth game, but we need a way to determine if the goal was reached. But first, we need a stage to play on, as our current one isn’t really a good one. I’ve come up with this:

Our goal is to reach that colored corridor. To check if we succeeded we’ll simply check if our camera is inside the square. To check that we’ll use our raycasting facilities. The algorithm is pretty easy:

We cast rays from our point to the right,
We count with how many walls of a given square we intersect with,
If the amount of intersections is odd then we’re inside.

We can see that this works for us:

Of course, there are special cases, like when a point lies on either of the rectangle sides, but we can’t intersect with walls, because we detect collisions, so we’ll be fine. Here’s the code:

(defn inside-rectangle [camera [[ax ay] [bx by] [cx cy] [dx dy]]]
  (let [walls [[[ax ay] [bx by]]
               [[bx by] [cx cy]]
               [[cx cy] [dx dy]]
               [[dx dy] [ax ay]]]
        {x :x y :y} camera
        {x' :x y' :y} (cam/move-forward {:x x :y y :degree 90} 1000)]
    (->> walls
         (map (fn [wall]
                (if (intersect? [[x y] [x' y']] wall) 1 0)))
         (reduce + 0)
         odd?)))

We receive four points that define our goal and move the camera 90 degrees right to some amount. Then we map intersect? procedure across our walls, returning either 1 or 0 depending on collision detection, and reduce results with +, to finally check if the result is odd? or not.

Though we need some way to extract goals from our stage, I’ll just define it as a constant because I don’t want to make stage code even more complex than it is now, and we’re not going to change stages. So when we’ve reached our goal, we’ll just teleport the camera back to starting point:

(defn render []
  (move-camera stage @input/key-states)
  (when (inside-rectangle @cam/camera stage/goal)
    (swap! cam/camera cam/set-position 12 195 180))
  (let [height (. *canvas* -height)
        width (. *canvas* -width)
        camera @cam/camera
        rays (cast-rays camera stage)]
    (. *ctx* clearRect 0 0 width height)
    (draw-rays camera rays)
    (draw-camera camera)
    (draw-stage stage)
    (draw-3d-stage rays)
    (. js/window requestAnimationFrame render)))

Combining all this stuff should give us this small game:

Ray Count:

Field of View:

FishEye compensation

You can click on this canvas, and use Up, Down, Left, Right to move, you also can strafe to the side while holding Shift, and pressing Esc will return focus to the page so you could scroll it with arrow keys as usual.

What I’ve learned

This project was extremely fun to do in ClojureScript, and Clojure itself is quite an awesome language, although those have some differences. If you’re learning Clojure, I highly recommend Clojure for the Brave and True book, and although I didn’t finish it yet, I’ve borrowed a lot of ideas from there, like using these little Unicode circles (➊) to mark stuff for further explanations. This book has a “Peg Thing” game example, which got me thinking about trying something a bit more complex and real-time with Clojure, but I wasn’t sure how to draw graphics with Java stuff, so I’ve chosen ClojureScript because the canvas was very easy to reach.

After implementing this, I think that while you don’t really need all these class objects like point, line, e.t.c. as long as you’re passing those in meaningful contexts, which I didn’t really do through this post, and I expect that this code will be really hard to read after some point in time. But certainly, maps provide most of what you need from a class or object and are more generic than objects.

The cleaned-up source code for this project can be found here if you’re interested in looking more closely. I hope you’ve enjoyed the read, and got interested in Clojure or Lisp in particular if you’re not a Lisp hacker already.

Comment via email

Andrey Listopadov

Function that can be called a limited amount of times

Wave Function Collapse Algorithm in ClojureScript

The algorithm

Text version of the algorithm

Collapsing cells

Working with images

Drawing the result

A proper demo

Lazy sequences and iterators

Iterators in Lua

Lazy Sequences

More examples

Lazy-seq library

Conclusion

Condition system for Fennel language and Lua runtime

Condition system?

An example

The implementation

The dynamic scope

Constructing dynamic scope for handlers

Implementing control transfer via protected calls

Handling conditions

Condition inheritance

The debugger

Ending thoughts

Condition system in Clojure

Exception-based error handling

Conditions in pure Clojure

Farolero conditions and restarts

Why this might not work for you (but still is an option)

Further reading

PF4J and Clojure

Anatomy of a plugin

Writing Clojure program that uses plugins

Clojure ExtensionPoint implementation

PF4J plugin in Clojure

Some ending notes

Pretty-printing for Fennel Language

Lua tables, and Fennel reader

Cyclic tables

__fennelview metamethod

Comparison to other Lisp pretty-printers

We need to talk about parentheses

Why parentheses?

Scope

Macros

Operator precedence

Fixing the problem inside the language

Using different parentheses

Using fewer parentheses and changing parenthesis semantics

Removing parentheses

Editor support

Coloring and dimming

Formatting

Structural editing

Automatic parenthesis insertion

Parinfer

Being a good programmer

Raymarching with Fennel and LÖVE

Raymarching basics

Distance estimation

Project structure

Scene setup

Creating objects

Marching ray

Shooting rays

Lighting and reflections

User input

Final thoughts

Simple Ray Casting with ClojureScript

Ray casting basics

Project structure

Creating a camera

Moving the camera

Drawing

Creating walls

Casting rays

Making a 3D view of our scene

Fisheye compensation

Clojure `ExtensionPoint` implementation

`__fennelview` metamethod