Joe MarshallVibe coding in Common Lisp

· 17 hours ago

Can you “vibe code” in Common Lisp?

Short answer, no.

I set out to give it a try. The idea behind “vibe coding” is to use an AI to generate the code and to blindly accept everything it generates. You offer some feedback about error messages and whether the code is doing something close to what you want, but you specifically don’t try to analyze and understand the code being generated. You certainly don’t try to debug it and fix it.

A.I. is trained on a lot of open source code. If your language is popular, there is a lot of code to train on. Chances are, if you have a problem, then not only has someone attempted to code it up in Python, but several people have given it a try and someone has ported it to JavaScript. Someone has solved your problem on StackOverflow.

Common Lisp is not a popular language. There is not a lot of code to train on, and most of it is someone’s homework. So for any particular problem, the A.I. doesn’t have a lot to go on. It becomes clear pretty quickly that the A.I. has no understanding of what it is doing, it is just trying to synthesize something that is similiar to what it has seen before, and if it hasn’t seem much, you don’t get much.

So I tried to vibe code in Common Lisp. I decided to try to write a Minesweeper game. That seemed like it had probably been done enough times before that the A.I. might be able to generate some vibe code.

I told it that we were going to write a video game and that it should generate an asd file for the game, and some skeleton code that would be a good start. It generated an asd file and four small files: main.lisp, game.lisp, input.lisp, and graphics.lisp. There was little actual code in the files, just some function stubs, but you could see where the cross-file dependencies were going to be.

The asd file wouldn’t load. The generated files had some minor dependencies upon each other and imported the required symbols from the other files. This imposed an implicit load order because a file couldn’t be loaded until the file it depended on had created the package for the symbols that it referenced. This is an old problem in Common Lisp, and the solution is to set up all the packages before loading anything. But I was vibing, so I told the AI that the forward references of the symbols were causing problems.

The AI added require statements into the files to try get them to load in a working order. It didn’t help. require statements have a whole bunch of issues and aren’t used very much thes days. The modern solution is to make the dependencies explicit in the system definition file. I gave the AI a direct instruction to make sure that the package.lisp file loaded before any other. Rather than edit the asd file, it decided to add even more require statements.

I declared failure at this point and manually edited the package.lisp file to create the packages and import the inital symbols, I added a dependecy on the package.lisp file to every other file, and I removed all the spurious require statements. It was clear the AI was not going to hit upon this solution.

The AI obviously has no model of what the package system is. It doesn’t reason that you need to load it first. It simply knows that it can insert require statements to express a dependency. So it thrashes around added require statements in the hope that it will converge to a solution. It converged to a circular dependency instead.

Joe MarshallThe Obarray

· 30 hours ago

Early Lisps interned all their symbols in a single symbol table called the obarray. Every program you loaded into your Lisp image would share the obarray. Memory was limited, so you usually only ran one program (like Macsyma) at a time.

But as memory got larger and cheaper, people started to want to run multiple Lisp programs, like Macsyma and Emacs, at the same time. The problem was they would collide over the use of the symbols. (In particular, over the property lists.) Someone — I’m not sure who — came up with a hack that would swap out the obarray depending on which program you were loading.

The origin of the package system was "the obarray hack". Packages are first-class named obarrays, with some support for controlling the sharing of symbols among the obarrays, a limited form of inheritance and some code that maintains consistency.

In any but the smallest Lisp project, you need to decide on a symbol and package strategy. Some people keep with the original spirit of the package system and create just a handful of coarse-grained packages that each encompass a logical program. Other people use packages as modules, which gives you a set of many fine-grained packages, one to each module in your system.

I favor the former approach. I either use one package for my entire program, or I break it into just a couple of main packages. I don’t try for a finer grained approched. The package system wasn’t really designed for a fine-grained appoach.

Screwing up your packages can easily make your system unusable. If you dynamically create and link packages as you load your code, you have to be careful about the order in which you load your files. Load a file out of order and you’ll end up with dozens of symbols interned in the wrong package.

When I’m working on a project, I always have a file called package.lisp which defines all the packages in the project in one place. The package.lisp is always the first file loaded. Once I’ve done this, then the order in which the other files are loaded becomes far less important. It saves a lot of headaches.

Joe MarshallCLOS vs. message passing

· 3 days ago

When I was in high school and first getting interested in computers, I heard about the concept of message passing. This struck me as a good idea, although I couldn't articulate why at the time. Now I know a bit more about computers, and I often find that message passing is a good way to structure certain kinds of programs. In particular, it really works well with client/server architectures.

The idea behing message passing is that you have active agents that communicate by sending passive messages amongst themselves. A message is a fairly simple piece of data. It is basically a symbolic token and maybe some parameters. The recipient of the message interprets the meaning of the token and acts accordingly. Conceptually, the interface is narrow: an agent exposes one endpoint and all messages come through that endpoint. This facilitates the creation of strong abstraction barriers.

The standard way of implementing this is to have a reverse proxy within the agent that disatches messages to the appropriate handler within the object. The object has a table of message handlers and it looks up the appropriate handler in the table and calls it.

I wanted to use this paradigm for talking to several heterogeneous servers — a GitHub server, an LDAP server, a CircleCI server, etc. But I got bogged down in the details of how to implement this. It was proving difficult to map the reverse proxy implementation on to CLOS. But then I remembered something: synchronous message passing is isomorphic to simple function calls. I didn't want to implement a message dispatcher in CLOS, I could just use CLOS's built-in method dispatch.

Messages are just the names of generic functions, and parameterized messages are just generic functions that take arguments. The method dispatch table doesn't reside in the object but in the generic function. In fact, very little is left of the object itself. It can often be instance with no slots that only has an identity.

Once I got my head straightened out, the code came together quickly.

Joe MarshallObject Last or First

· 5 days ago

In Java or C#, the first argument to a method call is the object that contains the method. This is built in to the language and it is to some extent an artifact of the mechanism of method dispatch. So when you add a type (class) to the language, you will have a set of methods where the first argument is the object of that type.

In Common Lisp, the first argument to a function is not special. When you add a type, the functions that operate on that type can place the object anywhere in the argument list. The convention in Common Lisp is (mostly) for the object to be the last argument in the argument list. Look at the list and sequence functions for examples of this convention.

The Common Lisp convention reads more like English. (subst new old sequence) reads directly as "substitute new for old in sequence". In Java, the same method would be called like this sequence.subst(old, new), which would have to read as "In sequence, substitute for old, new", which is a bit more awkward.

But I think I prefer the Java convention. In Lisp, this would be (substitute sequence old new). There is no implementation need for the object to be the first argument, but I think there is an advantage to the regularity of the convention. It places the object in the same place in the argument list for all the functions that operate on the object.

The argument that has persuaded me the most is that if the return type of the function is the same type as the object, as it often is, then you can elegantly chain the method calls together with a fold-left. So consider a table object. It might have an insert method that takes a key and value and returns a new table. If the insert method is like this: (insert table key value), then you can insert a bunch of keys and values with a fold-left like this: (fold-left #’insert table ’(key1 key2 ...) ’(value1 value2 ...)).

Note how order of arguments is analagous between the fold-left and the insert method. When the object is the last argument, then you have to insert an intermediate lambda expression to shuffle the arguments around, and the table argument moves from being after the key and value in the insert method to being before the key list and value list in the fold-left method. It is a small thing, but I find it very appealing that in moving from the single argument case to the argument list case we don’t have random changes.

Of course I don’t think we should change Common Lisp to conform to a different convention, but I tend to write my own functions with the object as the first argument rather than the last.

Joe MarshallJust Keep Consing

· 6 days ago

Lisp was the first garbage collected language. But early garbage collectors were painful to use. They had significant overhead and would pause your program for several seconds or even minutes at the worst possible times. People tried to avoid garbage collection by re-using objects, using allocation pools, etc. Many people would run their Lisp programs with the garbage collection turned off. They would reboot their Lisp machines when they ran out of memory. Lisp Machine Inc. had a product called "Picon" which was carefully crafted to avoid any runtime allocation.

Generational garbage collectors began to be adopted in the early 80s. Generational collectors have much less overhead than the earlier "Stop the world" collectors. Memory has gotten much cheaper, so larger heaps are practical. Large heaps have two benefits: garbage collection becomes less frequent, and objects have time to "age" and perhaps become garbage before the next generational collection. Some garbage collection algoriths have no cost overhead for very short-lived objects.

It is no longer necessary to re-use objects or try to avoid allocating memory. Garbage collection pauses are usually short enough to be unnoticeable. You can typically set the heap size nice and large and forget about it. It is certainly possible to encounter a program that has a pathological memory usage pattern, but it is much less common than it used to be.

Because of the way linked lists work, the result of walking down a list usually comes out in the reverse order. In the old days, you would make the effort of trying to accumulate the result in the forward direction by keeping track of the last cell in the answer and mutating it to accumulate the next cell. This is a pain. These days, it you can just accumulate the result in the reverse order and then call reverse when you are done. In practice, this is no slower than accumulating the result in the forward direction, but certainly a lot simpler. It generates more garbage, but it is short-lived garbage with little or no overhead.

Joe MarshallSeries vs. streams

· 7 days ago

A generator is an abstraction of a sequence of values. It is a procedure that returns the next value in the sequence each time it is invoked. The generator can run out of items to return at some point if the sequence is finite, or it can keep generating values if the sequence is ininite.

A generator is decidely non-functional. Each time it is called it has the potential to return a different value. But let's make it functional. Instead of returning a single value, let's return two values: the next value in the sequence and the next state of the generator. The generator can now be pure functional and return the exact same two values each time. The caller will keep track of the current generator will replace the current generator with the next one returned by the call.

We implement generators as a promise that returns a pair of the next value and the next generator. The returned pair is what S&ICP call a stream. In other words, a stream is output of a functional generator that is 180 degrees out of phase of the generator.

Streams are similar to series in that you can write computations that operate on the aggregate stream, but it will be piplined to operate one element at time. But rather than having the compiler perform a code walk to set up an explicit pipeline, the runtime system sets up an implicit pipeline through the constraints of the promises. This makes streams a bit more flexible than series.

Series are more efficient than streams because the compiler can turn the implicit pipeline into an explicit one that is easy to optimize. Streams turn into a series of nested lexical closures with the attendant overhead.

One of the difficulties in using streams is that you often have to pay very careful attention to avoid fencepost errors and generating elements one beyond what is necessary. This isn't just a matter of using up a tad more storage, but it can lead to unexpected infinite loops because you attempt to reach one beyond the base case. Very often you find that you need two versions of each function: one that takes a stream argument, and one that takes a generator argument that you are careful to avoid calling unless necessary.

Streams are lazy by nature. Laziness introduces a need for static types. If you have a computed value, you can examine it to find out its type, but if you have a promise, you cannot tell what type of object it will return without forcing the promise. You cannot do a type dispatch on a promise because you don't know what it will return. A static type would indicate the type of the returned value without forcing the promise.

Series requires that the entire pipeline from source to sink be visible to the compiler. Streams do not have this requirement.

Despite their drawbacks, I rather like streams. I use them in my linear-fractional-transformations package to represent exact real numbers as streams of linear fractional transformations. I also use streams of integers to represent the continued fraction expansion of exact real numbers.

Joe MarshallUniversal Function

· 8 days ago

Lisp was an early language. These days everyone and his brother has a new language, but Lisp was the first of its kind. John McCarthy, mathematician that he was, wanted to prove that his new language was universal. He broke this down into two steps.

First, he showed that S-expressions — the list structure representation of Lisp — could faithfully represent Church’s lambda expressions. This is kind of taken for granted now, but McCarthy made the effort to prove it. Church had already proven that lambda expressions could represent any computable function, so McCarthy had a proof that S-expressions, too, could represent any computable function.

Then, he showed that his language could implement a universal function. A universal function is a function that can emulate any other function. If you have a universal function, you can emulate any other function, so you can compute any computable function. A universal function takes two arguments, a specification of what function to emulate and (a list of) some inputs. It returns the same value as if the function had been called with those inputs.

McCarthy’s universal function took a function specification in the form of a lambda expression and a list of arguments. It binds the arguments to the formal parameters of the lambda expression, the performs a recursive descent evaluation of the body of the body of the lambda expression. McCarthy called his universal function APPLY. By writing APPLY in Lisp, McCarthy showed that Lisp was universal. (EVAL began its existance as a helper function for APPLY).

To tell the truth, this is pretty studly: McCarthy proved that his new language was universal by writing the first meta-circular evaluator in it. These days, people invent languages by throwing together enough features until they have something that looks like a language. It’ll probably be universal — universality turns out to be fairly easy to achieve — but how do you know? If you can write a Lisp interpreter in your language, it’s universal.

Joe MarshallObscure suggestions

· 9 days ago

Suppose you have come up with an elegant recursive algorithm that is easy to understand and implement. This will not do. A true mathematician is judged by how clever he must be to understand his algorithm. To that end, you must make your algorithm as difficult to understand as possible. This is how you prove that you are smarter than your readers. Here are some suggestions:

  • Instead of giving the next state as function of the current state, give the current state as a function of the next state and let your audience invert the function.
  • Split your recursion into two parts, but give one part recursively and the other co-recursively. Your readers will enjoy the fun puzzle of figuring out how to stitch the parts back together.
  • Remove the recursion by replacing it with re-assignment and explicit stack manipulation.
  • Avoid motivating examples.
  • Omit all unnecessary details, and a few of the necessary ones as well.
  • Unicode gives you thousands of single character variable names.
  • Use existance proofs rather than constructive ones. You can prove there is a base case without explicitly stating what it is.
  • Let X refer to a set or an element of a set, depending on context.
  • Depend on the context. A lot.
  • There is no rule that says variable names must be unique.

Take and apply some of these ideas and you can turn your elegant algorithm into something that will humiliate the smartest of your readers.

Joe MarshallDefclass vs. defstruct

· 10 days ago

Common Lisp provides two ways to create new compound data types: defstruct and defclass. Defstruct creates simple cartesian record types, while defclass is part of a full object-oriented programming system. How do you decide which one to use?

It’s easy. Unless you have a compelling reason to use defstruct, just use defclass. Even if you don’t use any other features of CLOS, defclass better supports class redefinition, and this just makes life easier.

If you modify a defstruct and recompile it, the old instances of that struct type become obsolete. They probably won’t work with the new definition. You’ll most likely have to rebuild them. If things get too screwed up, you’ll end up having to restart your Lisp image.

CLOS, on the othe hard, is designed to be dynamic. You can redefine and recompile a class on the fly. You can change the class of an instance. As you develop your code, you’ll be adding and removing slots and changing the class hierarchy. defclass usually handles these sorts of dynamic changes transparently, without having to restart your Lisp image.

CLOS achieves this by adding an extra level of indirection, and perhaps you cannot tolerate the extra overhead. Then by all means use defstruct. But if you are indifferent, defclass is a better choice.

Joe MarshallTip: Alphabetize arbitrary lists

· 11 days ago

Whenever I have a list of items, if there is no other better order for them, I arrange them in alphabetical order. Arbitrary lists have a way of getting large and unweildy over time, but if they are kept in alphabetical order, you can find the entries and spot omissions easier.

If there is a better ordering, then certainly use it. But keeping arbitrary lists alphabetized has two advantages: first, they are easier to use because you can find entries quicker. Second, it is a signal to the reader that the list is in fact in an arbitrary order.

Joe Marshallwith-slots vs. with-accessors

· 12 days ago

Most CLOS objects are implemented as standard-instances. A standard-instance is a collection of storage cells called slots, and the slots are addressed by name. You could imagine an alternative implementation where an instance is a vector that is addressed by an integer, but named slots are more flexible and abstract.

Many object systems map the named fields of an instance into lexically scoped variables. Within a method body, you can just refer to the slot as if it were a variable. Assignment to the variable effectively updates the slot. There are pros and cons to this. On the plus side, it is very convenient to refer to slots as if they were variables. On the minus side, it is difficult to rename a slot, because you have to rename all the references to it, and slot names can collide with lexical variables. It can make the code brittle with regard to slot naming. But CLOS lets you choose if you want to do this or not. The with-slots macro installs a set of symbol macros that let you refer to each slot as if it were a variable.

But the slots of an instance are an implementation detail. You really want an abstract API for your objects. You want logical fields to be accessed by getter and setter functions. The logical field will typically be backed by a slot, but it could be a computed value. Logical fields are more flexible and abstract than slots.

When you define a slot, you can specify a :reader and :accessor function for that slot. This covers the very common use case of a getter/setter pair that is backed by a slot in the instance.

You can also map the logical fields of an instance into lexical variables. The with-accessors macro installs a set of symbol macros that let you refer to each logical field as if it were a lexical varible.

I often see with-slots used where with-accessors would be more appropriate. If you find yourself wanting to use with-slots, consider if you should be using with-accessors instead.

Personally, I prefer to avoid both with-slots and with-accessors. This makes CLOS objects act more like structs. Structs are easier for me to understand than magic lexical variables.

Tip

The accessors for slots are generic. You therefore want them to have generic names. For example, suppose you have a point class with an x and y slot. You don't want to call your accessors point-x and point-y because the names would be inappropriate for subclasses. You want to have names something like get-x and get-y. These functions would naturally work on subclasses of points, but because get-x and get-y are generic, you could also extend them to work on any class that has a meaningful x and y.

Joe MarshallSymbol macros

· 13 days ago

A symbol macro is a symbol that macroexpands into a lisp form. It is similar to a preprocessor macro in C, but it must expand into a syntactically complete expression. Symbol macros are the underlying technology behind the with-slots and with-accessors macros. They allow you to introduce an identifier that appears to be a lexical variable, but actually executes some arbitrary code to compute a value. So we can place the storage for a variable in a vector or in an instance, and use a symbol macro to make it appear to be an ordinary variable.

Gerry Sussman doesn't like symbol macros. They are a lie. It appears that you are just doing an ordinary variable access, which should be a quick and simple operation, but in fact you could be executing arbitrary code. This can lead to some nasty suprises.

But in my opinion, you shouldn't discard a useful tool just because there is a way to misuse it. If your symbol macro is just redirecting a variable to a slot in an instance, there is little harm in that.

Joe MarshallAdvanced CLOS — update-instance-for-changed-class

· 14 days ago

Like most object systems, instances in CLOS have a reference to their class. Unlike most most object systems, CLOS provides a protocol for changing that reference. Normally, this is a pretty insane thing to want to do. It effectively changes the class of the instance and it is pretty unlikely that the instance structure will be compatible with the new class. But there are two situations where you might want to do it anyway:

  • When you edit the class definition, you can arrange for the system to dynamically upgrade existing instances to the new class definition. This means you won't have to restart your lisp and rebuild all the instances from scratch. You can just reload the class definition and the instances will be seamlessly upgraded on the fly. This is much more pleasant experience for the developer.
  • While you normally don't want to change the class of an instance at runtime, there are some rare situations where it can make sense. A good example is the unified table interface. Instances are thin wrappers around a concrete table implementation. It makes sense to change a table instance from one concrete implementation to another. For instance, you might want to change a hash table to a assocation list. You can simply call change-class on the instance.

When the class changes, the representation will be wrong. This is where we add an :after method to update-instance-for-different-class:

(defmethod update-instance-for-different-class :after ((previous alist-table) (current plist-table) &rest initargs)
  (declare (ignore initargs))
  (setf (representation current) (alist-plist (representation previous))))
  
  ...etc...
> (defvar *foo* (make-instance 'alist-table :initial-contents '((:a . 420) (:b . 69))))
#<ALIST-TABLE 2 EQL>

> (representation *foo*)
((:A . 420) (:B . 69))

;; But I'd rather have a plist-table
  
> (change-class *foo* 'plist-table)
#<PLIST-TABLE 2 EQL>

> (representation *foo*)
(:a 420 :b 69)

;; And now I'd like a wttree-table

> (change-class *foo* 'wttree-table)
#<WTTREE-TABLE 2 EQUAL>

> (representation *foo*)
#(2 NIL :A #(1 NIL :B NIL 69) 420)

Naturally, you have to be judicious in your use of this feature of CLOS. You can easily construct nonsense objects. But some times it makes perfect sense,

Joe MarshallUnified table interface

· 15 days ago

On day 16 of the Advent of Code, I make use of a priority queue for Dijkstra's algorithm. I ported Stephen Adams's weight-balanced binary tree implementation from MIT Scheme to Common Lisp. Stephen Adams's implementation (and therefore my port of it) has the MIT license. Weight-balanced binary trees are a way to implement key-value maps with these properties:

  • The trees are immutable. This means that when you add or remove a key, you get a new tree with the change. The old tree is unchanged. This makes the trees easier to reason about and suitable for functional programming. For example, you can iterate over the tree without having to worry about mutating the tree during the iteration.
  • Most operations on the tree, and insertion, lookup, and deletion in particular, are O(log n). While theoretically not as fast as a hash table, n has to be quite large before log n becomes a big factor. In practice, a weight balanced binary tree is competitive with a hash table for any reasonably sized table.
  • Weight-balanced binary trees support set operations such as union, intersection, and difference. These operations run in O(log n) time as well.
  • Keys are stored in sorted order. This makes it easy to iterate from smallest to largest key (or in the direction).

But it occurred to me that I wanted a unified abstract interface to all the various table-like data structures that Common Lisp provides. You should be able to call a generic table/lookup on a property list, association list, hash table, or weight-balanced binary tree and have it do the right thing. I wrote a simple table package that provides this.

https://github.com/jrm-code-project/table

The package is documented in the `README.md` fie.

Joe MarshallAdvent of Code 2024: Day 25

· 16 days ago

On day 25, we are given a set of locks and keys as ascii art. A typical lock looks like this:

.....
.#...
.##.#
.##.#
###.#
#####
#####

and a typical key looks like this:

#####
#####
##.#.
##.#.
##.#.
#..#.
.....

We read the input file with a little state machine that accumulates lines until a blank line or end of file is reached. It decides whether what it read was a lock or a key by looking to see if the first row is all #'s or not. If it is, it's a key, otherwise it's lock.

(defun read-input (pathname)
  (let ((package (find-package "ADVENT2024/DAY25")))
    (with-open-file (stream pathname)
      (let iter ((line (read-line stream nil))
                 (accum '())
                 (locks '())
                 (keys '()))
        (if line
            (let ((char-list (map 'list (lambda (c) (intern (string c) package)) line)))
              (if (null char-list)
                  (let ((item (make-grid (length accum) (length (first accum))
                                         :initial-contents (reverse accum))))
                    (if (every (lambda (s) (eq s '\#)) (first accum))
                        (iter (read-line stream nil)
                              '()
                              locks
                              (cons item keys))
                        (iter (read-line stream nil)
                              '()
                              (cons item locks)
                              keys)))
                  (iter (read-line stream nil)
                        (cons char-list accum)
                        locks
                        keys)))
            (let ((item (make-grid (length accum) (length (first accum))
                                   :initial-contents (reverse accum))))
              (if (every (lambda (s) (eq s '\#)) (first accum))
                  (values (reverse locks) (reverse (cons item keys)))
                  (values (reverse (cons item locks)) (reverse keys)))))))))

A key fits into a lock (but doesn't necessarily open it) if none of the '#'s in the key overlap with the '#'s in the lock. This is easily checked by iterating over the key and lock in parallel and ensuring that at least one of the characters is '.'.

(defun fits? (key lock)
  (collect-and (#M(lambda (k l)
                    (or (eql k '|.|) (eql l '|.|)))
                  (scan 'array key)
                  (scan 'array lock))))

For part 1, we are asked to find the number of key/lock combinations that result in a fit. We use map-product from the alexandria library to map the fits? predicate over the cartesian product of keys and locks. We then count the number of fits.

(defun part-1 ()
  (multiple-value-bind (locks keys) (read-input (input-pathname))
    (count t (map-product #'fits? keys locks))))

There is no part 2 for this problem.


We've arrived at the end of the 2024 Advent of Code. I started this series with two intents: to demonstrate an approach to solving the problems that is more idiomatic to Common Lisp, and to learn more about the series library. I don't claim my solutions are the best. They could all use some improvement, and I'm sure you code golfers can find numerous ways to shave strokes. But I think each solution is fairly reasonable and tries to show off how to effectively use Common Lisp in a number of simple prolems.

For these problems I purposefully avoided the loop macro and tried to use the series library as much as possible. I used named-let for the more complex iterations.

I was ultimately disappointed in series. I like the idea of automatically generating pipelines from a more functional style, but it simply hits the complexity wall far too quickly. For simple iterations, it's great, but for anything even slightly more complex, it becomes difficult to use.

The full source code I wrote is available on GitHub at https://github.com/jrm-code-project/Advent2024 Be aware that I have not included the puzzle input files. The code will not run without them. You can download the puzzle inputs from the Advent of Code website and put them in the appropriate directories, each in a file called input.txt

I'm curious to hear what you think of my solutions. If you have any comments or suggestions, please feel free to contact me via email or by leaving a comment.

Joe MarshallAdvent of Code 2024: Day 24

· 17 days ago

In day 24, we are given a set of equations that decribe some combinatorical logic. The first task is to read the input and parse out the combinatoric circuit and simulate it. To do this, I hijack the lisp reader. I create a readtable this is just like the standard Lisp readtable, but with these differences:

  • Case is not folded.
  • The colon character is no longer a package prefix marker, but rather a terminating macro character that inserts the token :colon into the stream.
  • The newline character is no longer a whitespace character, but rather a terminating macro character that inserts the token :newline into the stream.

These changes to the reader make it esay to parse the input file. We build a labels expression where each named quantity in the circuit (the wires) is a function of zero arguments. Simulating the solution is then just a matter of calling eval on the resulting expression.

(defun get-input (swaps input-pathname)
  (flet ((maybe-swap (symbol)
           (cond ((assoc symbol swaps) (cdr (assoc symbol swaps)))
                 ((rassoc symbol swaps) (car (rassoc symbol swaps)))
                 (t symbol))))

    (let ((*readtable* (copy-readtable nil)))
      (setf (readtable-case *readtable*) :preserve)
      (set-syntax-from-char #\: #\;)
      (set-macro-character #\: (lambda (stream char) (declare (ignore stream char)) :colon))
      (set-macro-character #\newline (lambda (stream char) (declare (ignore stream char)) :newline))

      (with-open-file (stream input-pathname :direction :input)
        (let iter ((token (read stream nil :eof))
                   (line '())
                   (gates '())
                   (wires '())
                   (outputs '()))
        
          (multiple-value-bind (line* gates* wires* outputs*)
              (if (or (eq token :eof) (eq token :newline))
                  (if line
                      (if (member :colon line)
                          (values '()
                                  gates
                                  (cons `(,(third line) () ,(first line)) wires)
                                  outputs)
                          (values '()
                                  (cons `(,(maybe-swap (first line)) ()
                                          (,(ecase (fourth line)
                                              (XOR 'logxor)
                                              (OR 'logior)
                                              (AND 'logand))
                                           ,@(list (list (third line)) (list (fifth line)))))
                                        gates)
                                  wires
                                  (if (and (symbolp token)
                                           (char= (char (symbol-name token) 0) #\z))
                                      (cons `(list ,(list token)) outputs)
                                      outputs)
                                  ))
                      (values '() gates wires outputs))
                  (values (cons token line) gates wires (if (and (symbolp token)
                                                                 (char= (char (symbol-name token) 0) #\z))
                                                            (cons (list token) outputs)
                                                            outputs)))
            (if (eq token :eof)
                `(labels (,@wires*
                          ,@gates*)
                   (fold-left (lambda (acc bit)
                                (+ (* 2 acc) bit))
                              0  (list ,@(sort outputs* #'string-greaterp :key (lambda (term) (symbol-name (car term)))))))
                (iter (read stream nil :eof) line* gates* wires* outputs*))))))))

For part 2, we are told that the circuit is supposed to add two binary numbers. We are also told that the circuit the circuit has four of its wires swapped. We are asked to find the swapped wires.

It is hard to understand what is going on because almost all the wires have random three-letter names. We start by renaming the wires so that they have a bit number prefixed to with them. If a gate has two numbered inputs where the numbers are equal, we propagate the number to the output of the gate.

Once the wires are numbered, we sort the wires by their numbers and print the wire list. The regular pattern of gates is instantly obvious, and the swapped wires are easy to spot. It isn't obvious how to find the swapped wires in the general case, but it is unnecessary to solve the puzzle, so there is no code for this.

Joe MarshallAdvent of Code 2024: Day 23

· 18 days ago

For day 23 we’re going to look for cliques in a graph. A clique is a subset of vertices in a graph such that every pair of vertices in the clique is connected by an edge. In other words, a clique is a complete subgraph of the graph.

The graph is given as a list of edges. The graph is undirected, so the edge (a, b) is the same as the edge (b, a). We represent the graph as a hash table mapping vertices to a list of adjacent vertices.

;;; -*- Lisp -*-

(in-package "ADVENT2024/DAY23")

(defun get-input (input-pathname)
  (let ((neighbor-table (make-hash-table :test #’eql))
        (package (find-package "ADVENT2024/DAY23")))
    (iterate (((left right) (#2M(lambda (line) (values-list (str:split #\- line)))
                                (scan-file input-pathname #’read-line))))
      (let ((left*  (intern (string-upcase left)  package))
            (right* (intern (string-upcase right) package)))
        (push right* (gethash left* neighbor-table ’()))
        (push left* (gethash right* neighbor-table ’()))))
  neighbor-table))

Given a neighbor table, we can get a list of the two vertex cliques by looking at the keys and values of the hash table.

(defun two-vertex-cliques (neighbor-table)
  (collect-append
   (mapping (((vertex neighbors) (scan-hash neighbor-table)))
     (mappend (lambda (neighbor)
                (when (string-lessp (symbol-name vertex) (symbol-name neighbor))
                  (list (list vertex neighbor))))
              neighbors))))

Given a two vertex clique, we can find a three vertex clique by looking for a vertex that is connected to both vertices in the two vertex clique. We find the neighbors of each vertex in the clique and then take the intersection of the two lists of neighbors. We distribute this intersection over the two vertex clique to get the list of three vertex cliques. Note that each three vertex clique will appear three times in the list in different orders.

In Part 1, we count the number of three vertex cliques in the graph where one of the vertices begins with the letter ‘T’. We divide by three because we generate three vertex cliques in triplicate.

(defun part-1 ()
  (/ (count-if (lambda (clique)
                 (find-if (lambda (sym)
                            (char= #\T (char (symbol-name sym) 0)))
                          clique))
               (let ((neighbor-table (get-input (input-pathname))))
                 (mappend (lambda (clique)
                            (let ((left-neighbors (gethash (first clique) neighbor-table))
                                  (right-neighbors (gethash (second clique) neighbor-table)))
                              (map ’list (lambda (common-neighbor) (list* common-neighbor clique))
                                   (intersection left-neighbors right-neighbors))))
                          (two-vertex-cliques neighbor-table))))
     3))

For Part 2, we are to find the largest maximal clique. We use the Bron-Kerbosch algorithm to find the maximal cliques.

(defun bron-kerbosch (graph-vertices clique more-vertices excluded-vertices)
  (if (and (null more-vertices) (null excluded-vertices))
      (list clique)
      (let iter ((answer '())
                 (excluded-vertices excluded-vertices)
                 (more-vertices more-vertices))
        (if (null more-vertices)
            answer
            (let* ((this-vertex (car more-vertices))
                   (more-vertices* (cdr more-vertices))
                   (neighbors (gethash this-vertex graph-vertices)))
              (iter (append (bron-kerbosch graph-vertices
                                           (adjoin this-vertex clique)
                                           (intersection more-vertices* neighbors)
                                           (intersection excluded-vertices neighbors))
                            answer)
                (adjoin this-vertex excluded-vertices)
                more-vertices*))))))

(defun maximal-cliques (graph-vertices)
  (bron-kerbosch graph-vertices ’() (hash-table-keys graph-vertices) ’()))

Once we have found the maximal cliques, we can find the largest clique by sorting the cliques by length and taking the first one. We sort the vertices in the clique and print as a comma separated list.

(defun part-2 ()
  (format
   nil "~{~a~^,~}"
   (sort
    (first
     (sort
      (maximal-cliques (get-input (input-pathname)))
      #’> :key #’length))
    #’string-lessp :key #’symbol-name)))

Joe MarshallAdvent of Code 2024: Day 22

· 19 days ago

On Day 22 we are introduced to a simple pseudo-random number generator (PRNG) that uses this recurrance to generate pseudo-random numbers:

S1 = ((Xn << 6) ⊕ Xn) mod 224
S2 = ((S1 >> 5) ⊕ S1) mod 224
Xn+1 = ((S2 << 11) ⊕ S2) mod 224

We just define this as a simple function, but we are carful to put a check-type on the input to make sure it is a number in the correct range. This gives the compiler enough information to optimize the body of the generator to a sequence of inline fixed-point operations, avoid the overhead of a function call out to the generic arithmetic.

(defun next-pseudorandom (pseudorandom)
  (check-type pseudorandom (integer 0 (16777216)))
  (macrolet ((mix (a b) ‘(logxor ,a ,b))
             (prune (x) ‘(mod ,x 16777216)))
    (let* ((s1 (prune (mix (* pseudorandom 64) pseudorandom)))
           (s2 (prune (mix (floor s1 32) s1)))
           (s3 (prune (mix (* s2 2048) s2))))
      s3)))

We can generate a series of random numbers from a given seed:

(defun scan-pseudorandom (seed)
  (declare (optimizable-series-function))
  (scan-fn '(integer 0 (16777216))
           (lambda () seed)
           #'next-pseudorandom))

The nth pseudorandom number is the nth element in the series, i.e. the result of applying the next-pseudorandom function n times to the seed:

(defun nth-pseudorandom (seed n)
  (collect-nth n (scan-pseudorandom seed)))

Part 1 of the problem is to sum the 2000th pseudorandom numbers generated from seeds given in a file.

(defun part-1 ()
  (collect-sum (#Mnth-pseudorandom (scan-file (input-pathname)) (series 2000))))

For part 2, we're going to be simulating a market. The prices are single digit pseudorandom numbers:

(defun scan-prices (seed)
  (declare (optimizable-series-function))
  (#Mmod (scan-pseudorandom seed) (series 10)))

The bidders in our market are monkeys, and we read them from our input file:

(defun scan-monkeys (input-pathname)
  (declare (optimizable-series-function 2))
  (cotruncate (scan-range :from 0)
              (scan-file input-pathname)))

The seed that we read from the input pathname will be used to create a price series for each monkey.

Each monkey looks for trends in the market by looking at the last four price changes. If the last four prices changes match the trend the monkey looks for, the monkey will make a trade and get a profit of the current price.

For part 2, we assume all the monkeys look for the same trend. Some trend will maximize the total profit of all the monkeys. We want to know what that maximum profit is.

We'll proceed in two steps. First, we make a table that maps trends to profits for each monkey. We'll start with an empty table, then we'll iterate over the monkeys, adding the trend info for that monkey. Once we have the table, we'll iterate over all the possible trends and find the one that maximizes the total profit.

price-deltas is a series of the differences between the prices in the price series. We'll use this to determine the trend.

(defun price-deltas (price-series)
  (declare (optimizable-series-function)
           (off-line-port price-series))
  (mapping (((before after) (chunk 2 1 price-series)))
     (- after before)))

price-trends is a series of trends. The trend is simply a list of the last four price deltas.

(defun price-trends (price-series)
  (declare (optimizable-series-function)
           (off-line-port price-series))
  (mapping (((d1 d2 d3 d4) (chunk 4 1 (price-deltas price-series))))
           (list d1 d2 d3 d4)))

add-trend-info! adds the trend info for a monkey to the table. We'll look at a count of 2000 prices (minus the first four because there aren't enough to establish a trend). The key to an entry in the table will be taken from the price-trends. The value for an entry is the price after that trend. The table maps a trend to an alist that maps monkeys to profits, so once we know the trend, we look to see if an entry for the monkey already exists in the value. If it does, we're done. But if it doesn't, we add an entry for the monkey with the profit.

(defun add-trend-info! (table monkeyid seed)
  (iterate ((count (scan-range :from 4 :below 2001))
            (trend (price-trends (scan-prices seed)))
            (value (subseries (scan-prices seed) 4)))
    (declare (ignore count))
    (unless (assoc monkeyid (gethash trend table '()))
      (push (cons monkeyid value) (gethash trend table '())))))

Once we have added the trend info for all the monkeys, we find the entry in the table that maximizes the total profit.

(defun trend-table-maximum (table)
  (let ((best-score 0)
        (best-key nil))
    (maphash (lambda (key value)
               (let ((score (reduce #'+ (map 'list #'cdr value))))
                 (when (> score best-score)
                   (setq best-key key)
                   (setq best-score score))))
             table)
    (values best-key best-score)))

Finally, we can put it all together in the part-2 function:

(defun part-2 ()
  (multiple-value-bind (best-key best-value)
      (let ((table (make-hash-table :test #'equal)))
        (iterate (((monkeyid seed) (scan-monkeys (input-pathname))))
          (add-trend-info! table monkeyid seed))
        (trend-table-maximum table))
    (declare (ignore best-key))
    best-value))

Joe MarshallCollate / index-list

· 19 days ago

I was talking to Arthur Gleckler last night and he mentioned that he had been making good use of a function he called index-list. This function takes two selector functions and a list of objects. The first selector extracts a key from each object, and the second selector extracts a value. A table is returned that maps the keys to a list of all the values that were associated with that key.

I had to laugh. I had written the same function a few month back. I called it collate.

Here is Arthur’s version in Scheme:

(define (index-list elements table choose-data choose-key)
  "Given a hash table ‘table’, walk a list of ‘elements’ E, using
‘choose-key’ to extract the key K from each E and ‘choose-data’ to
extract a list of data D from each E.  Store each K in ‘table’ along
with a list of all the elements of all the D for that K."
  (do-list (e elements)
    (hash-table-update!/default
     table
     (choose-key e)
     (lambda (previous) (append (choose-data e) previous))
     ’()))
  table)

And here is my version in Common Lisp:

(defun collate (list &key (key #’car) (test #’eql)
                               (merger (merge-adjoin :test #’eql)) (default nil))
  (let ((table (make-hash-table :test test)))
    (dolist (element list table)
      (let ((key (funcall key element)))
        (setf (gethash key table)
              (funcall merger (gethash key table default) element))))))

So how do they differ?

  • Arthur’s version takes the hash table as a parameter. This allows the caller to control the hash table’s properties. My version creates a hash table using the test parameter, which defaults to eql.
  • Arthur’s version uses choose-key to extract the key from each element. My version uses key, which is a keyword parameter defaulting to car. My choice was driven by the convention of Common Lisp sequence functions to take a :key parameter.
  • Arthur’s version uses a default value of ’() for the entries in the hash table. My version uses the :default keyword argument that defaults to ’().
  • Arthur’s version uses choose-data to extract the datum in each element. My version uses the :merger keyword argument to specify how to merge the entire element into the table. If you only want a subfield of the element, you can compose a selector function with a merger function.
  • Arthur’s version uses append to collect the data associated with each element. My version uses a merger function to merge the element into the entry in the hash table. The default merger is merge-adjoin, which uses adjoin to add the element to the list of elements associated with the key. merge-adjoin is paramterized by a test function that defaults to eql. If the test is true, the new data is not merged, so the result of (merge-adjoin #’eql) is a list with no duplicates.
  • If you instead specify a default of 0 and a merger of (lambda (existing new) (+ existing 1)) you get a histogram.
  • Another merger I make use of is merge-unique, which ensures that all copies of the data being merged are the same, raising a warning if they are not.
  • Finally, I occasionally make use of a higher-order merger called merge-list that takes a list of mergers and applies them elementwise to two lists to be merged. This allows you to create a singleton aggregate merged element where the subfields are merged using different strategies.

Like Arthur, I found this to be a very useful function. I was auditing a data set obtained from GitHub. It came in as a flat list of records of users. Each record was a list of GitHub org, GitHub ID, and SAML/SSO login. Many of our users inadvertently have multiple GitHub IDs associated with their accounts. I used my collate function to create a table that mapped SAML/SSO login to a list of all the GitHub IDs associated with that login, and the list of orgs where that mapping applies.

Joe MarshallAdvent of Code 2024: Day 21

· 20 days ago

For day 20, we are entering a combination on a numeric keypad. But we cannot just enter the combination, we have to direct a robot to enter the combination by entering the directions to move the robot. But we cannot enter the directions directly, we have to get another robot to enter the directions to move the first robot. Part 1 of the problem has two layers of robots, but part 2 has a cascade of 25 layers of robots.

The door we need to unlock has a numeric keypad, but each robot has a directional keypad. The A key is an ’enter’ key.

;;; -*- Lisp -*-

(in-package "ADVENT2024/DAY21")

(defparameter *numeric-keypad* #2a(( 7  8  9)
                                   ( 4  5  6)
                                   ( 1  2  3)
                                   (nil 0  A)))

(defparameter *directional-keypad* #2a((nil |^| A)
                                       ( <  |v| >)))

(defun read-input (input-pathname)
  (collect ’list
    (#M(lambda (line)
         (collect ’list
           (#M(lambda (c)
                (or (digit-char-p c)
                    (intern (string c) (find-package "ADVENT2024/DAY21"))))
              (scan ’string line))))
       (scan-file input-pathname #’read-line))))

Given a keypad, we can find the coordinates of a key by scanning for it.

(defun key-coords (keypad key)
  (let ((coords (scan-grid-coords keypad)))
    (collect-first
     (choose
      (#Meql
       (#Mgrid-ref (series keypad) coords)
       (series key))
      coords))))

To move the robot arm, we’ll jog it vertically or horizontally by pressing keys on the directional keypad.

(defun jog-x (dx)
  (make-list (abs dx) :initial-element (if (minusp dx) ’< ’>)))

(defun jog-y (dy)
  (make-list (abs dy) :initial-element (if (minusp dy) ’|^| ’|v|)))

A valid two-dimensional jog must never go over the dead key.

(defun valid-jog? (keypad from jog)
  (let iter ((current from)
             (jog jog))
    (cond ((null (grid-ref keypad current)) nil)
          ((null jog) t)
          (t (iter (ecase (car jog)
                     (|^| (coord-north current))
                     (|v| (coord-south current))
                     (>   (coord-east  current))
                     (<   (coord-west  current)))
               (cdr jog))))))

Given the coords of a from key and a to key on a keypad, we can compute the ways to jog the arm from to to. There may be more than one way, so we return a list of the ways to jog the arm. Zig-zag jogging is never going to be optimal, so we omit that option.

(defun jog-xy (keypad from to)
  (let ((dx (jog-x (- (column to) (column from))))
        (dy (jog-y (- (row to) (row from)))))
    (cond ((null dx) (list dy))
          ((null dy) (list dx))
          (t (let ((column-first (append dx dy))
                   (row-first    (append dy dx)))
               (cond ((and (valid-jog? keypad from column-first)
                           (valid-jog? keypad from row-first))
                      (list column-first row-first))
                     ((valid-jog? keypad from column-first)
                      (list column-first))
                     (t (list row-first))))))))

In the general case, we’ll get a list of two possibilities. Either we move vertically first or we move horizontally first. One of these possibilities will lead to the shortest sequence of inputs. Oftentimes we can prune this to one possibility, e.g. we are keeping in the same row or column, or one possibility would take us over the dead key.

Instead of using coords, we would like to specify the key names.

(defun step-paths (keypad start-key end-key)
  (jog-xy keypad (key-coords keypad start-key) (key-coords keypad end-key)))

Given a target sequence we want a robot to enter into a keypad, we want to compute sequences on the robots directional keypad that we can enter to cause the robot to enter the target sequence. There will be multiple possibilities, and we want any of the shortest ones. Notice that last thing entered in a sequence is the A key, so we can assume the robot is starting from that key having pressed A in the prior sequence.

This is where we insert a memoization cache to control the combinatoric explosion that will occur when we cascade robots.

(defparameter seq-paths-cache (make-hash-table :test #’equal))

(defun seq-paths (keypad sequence)
  (if (eql keypad *numeric-keypad*)
      (seq-paths-1 keypad sequence)
      (let* ((key sequence)
             (probe (gethash sequence seq-paths-cache :not-found)))
        (if (eq probe :not-found)
            (let ((answer (seq-paths-1 keypad sequence)))
              (setf (gethash key seq-paths-cache answer) answer)
              answer)
            probe))))

(defun seq-paths-1 (keypad sequence)
  (cartesian-product-list
   (butlast (maplist (lambda (tail)
                       (cond ((null tail) nil)
                             ((null (cdr tail)) nil)
                             (t (revmap (lambda (jog)
                                          (append jog (list ’a)))
                                        (jog-xy keypad
                                                (key-coords keypad (first tail))
                                                (key-coords keypad (second tail)))))))
                     (cons ’a sequence)))))

Given the ultimate sequence we want to end up typing on the ultimate keypad, we want to move up through the cascade of robots generating meta sequences that drive the robot on the next level down. This produces a combinatoric explosion. But the puzzle doesn’t care about the actual sequence of keys, only that the number of keystrokes, is minimal, so we keep at each level the keystrokes for each target key, but we can ignore the order in which the robot presses the target keys. At each level of the robot cascade, we will know, for example, that we have to enter "move up, press A" some thirty-two times in total. This means that the robot one level up will have thirty-two copies of the "move left, press A, move right, press A" meta-sequence.

The meta sequences can be fragmented at each press of the A key and then we can count each fragment individually. So we only need to know the meta sequence for a handful of fragments to determine the number of keystrokes needed to enter a sequence. This is kept in our memoization table.

But there are multiple meta-sequences that can be expanded from a sequence. If they have different lengths, we want one of the shortest ones, but even among the shortest ones of the same length, the next level of expansion may produce meta-meta-sequences of different lengths. We can use a clever trick to prune the longer meta-meta-sequences. We pre-load the memoization cache to avoid returning alternatives that create large expansions two level up in the cascade. So now when we compute the meta-sequence we won’t compute so many alternative possibilities, but only possibilites that do not expand to longer solutions if run through the computation twice. There are eleven of these:

(defun preload-cache ()
  (clrhash seq-paths-cache)
  (setf 
   (gethash ’(|v| A)     seq-paths-cache) ’(((<  |v| A)   (^ > A)))
   (gethash ’( <  A)     seq-paths-cache) ’(((|v| < < A) (> > ^ A)))

   (gethash ’(|^|  >  A) seq-paths-cache) ’(((< A)     (|v| > A) (^ A)))
   (gethash ’(|v|  >  A) seq-paths-cache) ’(((< |v| A)     (> A) (^ A)))
   (gethash ’( >  |^| A) seq-paths-cache) ’(((|v| A)     (< ^ A) (> A)))
   (gethash ’( <  |^| A) seq-paths-cache) ’(((|v| < < A) (> ^ A) (> A)))
   (gethash ’( <  |v| A) seq-paths-cache) ’(((|v| < < A)   (> A) (^ > A)))

   (gethash ’(|v|  <   <  A) seq-paths-cache) ’(((< |v| A)     (< A)       (A) (> > ^ A)))
   (gethash ’( >   >  |^| A) seq-paths-cache) ’(((|v| A)         (A)   (< ^ A) (> A)))

   (gethash ’( >  |v| |v| |v| A) seq-paths-cache) ’(((|v| A)   (< A) (A)   (A) (^ > A)))
   (gethash ’(|v| |v| |v|  >  A) seq-paths-cache) ’(((< |v| A)   (A) (A) (> A) (^ A)))))

With the cache preloaded with these values, we always generate meta-sequences that have minimal keystrokes, but furthermore, the meta-meta-sequences will also have minimal keystrokes.

The rest of the file generates meta sequences up the cascade of robots.

(defun next-seq-tables (seq-table)
  (remove-duplicates (collapse-seq-tables (next-seq-tables-1 seq-table)) :test #’equal))

(defun collapse-seq-tables (seq-tables)
  (revmap #’collapse-seq-table seq-tables))

(defun symbol-lessp (left right)
  (string-lessp (symbol-name left) (symbol-name right)))

(defun term-lessp (left right)
  (or (and (null left) right)
      (and (null right) nil)
      (symbol-lessp (car left) (car right))
      (and (eql (car left) (car right))
           (term-lessp (cdr left) (cdr right)))))

(defun collapse-seq-table (seq-table)
  (let ((table (make-hash-table :test #’equal)))
    (dolist (entry seq-table)
      (let ((key (car entry))
            (count (cdr entry)))
        (incf (gethash key table 0) count)))
    (sort (hash-table-alist table) #’term-lessp :key #’car)))

(defun next-seq-tables-1 (seq-table)
  (if (null seq-table)
      (list (list))
      (let ((tail-tables (next-seq-tables-1 (cdr seq-table))))
        (extend-seq-tables (car seq-table) tail-tables))))

(defun extend-seq-tables (entry tail-tables)
  (revmappend (lambda (tail-table)
             (extend-seq-table entry tail-table))
           tail-tables))

(defun extend-seq-table (entry tail-table)
  (revmap (lambda (path)
            (extend-with-path path (cdr entry) tail-table))
          (seq-paths *directional-keypad* (car entry))))

(defun extend-with-path (path count tail-table)
  (append (revmap (lambda (term) (cons term count)) path)
          tail-table))

(defun seq-table-length (seq-table)
  (reduce #’+ (map ’list (lambda (entry) (* (length (car entry)) (cdr entry))) seq-table)))

The initial-paths-table takes the target numeric sequence and produces a table of the sequence fragments to enter that sequence. Order is not presevered.

(defun initial-paths-table (numeric-seq)
  (map ’list (lambda (path)
                (let ((table (make-hash-table :test #’equal)))
                  (dolist (term path (hash-table-alist table))
                    (incf (gethash term table 0)))))
       (seq-paths *numeric-keypad* numeric-seq)))

We generate the table for a generation by iteratively calling next-seq-tables until we reach the number of robots in the cascade.

(defun generation-table (n numeric-seq)
  (if (zerop n)
      (initial-paths-table numeric-seq)
      (revmappend #’next-seq-tables (generation-table (1- n) numeric-seq))))

(defun shortest-table (sequence-tables)
  (car (sort sequence-tables #’< :key #’seq-table-length)))

Finally, we can compute the complexity of the sequence by counting the number of keypresses in the shortest sequence and multiplying by the code in the sequence.

(defun complexity (code n-generations)
    (* (seq-table-length (shortest-table (generation-table n-generations code)))
       (fold-left (lambda (acc digit)
                    (if (eql digit ’a)
                        acc
                        (+ (* acc 10) digit)))
                  0
                  code)))

And we can compute the answer to part 1 and part 2 with a cascade of two robots and a cascade of twenty-five robots respectively.

(defun part-1 ()
  (reduce #’+ (map ’list (lambda (input) (complexity input 2)) (read-input (input-pathname)))))

(defun part-2 ()
  (reduce #’+ (map ’list (lambda (input) (complexity input 25)) (read-input (input-pathname)))))

Joe MarshallAdvent of Code 2024: Day 20

· 21 days ago

For day 20, we return to a maze problem. The maze involved, however, is trivial — there are no decision points, it is just a convoluted path.

;;; -*- Lisp -*-

(in-package "ADVENT2024/DAY20")

(defun read-input (input-pathname)
  (read-file-into-grid
    (char-interner #’identity (find-package "ADVENT2024/DAY20"))
     input-pathname))

(defun find-start-and-goal (maze)
  (let ((inverse (invert-grid maze ’|.|)))
    (values (car (gethash ’S inverse))
            (car (gethash ’E inverse)))))

We compute the distance to the goal at all points along the path by walking the path backwards.

(defun compute-distances (maze)
  (let ((distances (make-grid (grid-height maze) (grid-width maze)
                              :initial-element nil)))
    (multiple-value-bind (start goal) (find-start-and-goal maze)
      (declare (ignore start))
      (let iter ((current goal)
                 (distance 0))
        (when current
          (setf (grid-ref distances current) distance)
          (iter (let* ((neighbors (#M2v+ (scan ’list (list +north+ +south+ +east+ +west+))
                                     (series current)))
                       (fill? (#M(lambda (maze neighbor)
                                   (and (on-grid? maze neighbor)
                                        (not (eql (grid-ref maze neighbor) ’\#))
                                        (null (grid-ref distances neighbor))))
                                 (series maze)
                                 neighbors)))
                  (collect-first (choose fill? neighbors)))
                (1+ distance))))
      distances)))

When we run through the maze we are allowed to cheat just once by walking through a wall. For part 1, we can walk just one step through a wall, but for part 2, we can walk up to 20 steps ignoring the walls. We might as well combine the two solutions into a single parameterized function. We will be asked to count the number of cheats that shorten the path by at least 100 steps.

I tried for quite some time to come up with a series oriented way to solve this, but it turned out to be much easier to just write a named-let iterative loop. So much for series.

First, we have a function that finds the cheats for a specific location. We are given a grid of distances to the goal, a coord that we start from, the current distance to the goal, the number of steps we can take through the walls, and the number of steps we have to shave off to count this cheat.

We iterate in a square grid centered at the current location and twice as wide plus one as the cheat steps. Check the locations in the distance grid that fall within the square and this tells us how much closer to the goal we can get by cheating to that location. We have to add in the manhattan distance from the current location to the cheat location to get the total distance. Subtract that from the original distance to the goal and we have the number of steps we save by using this cheat. If it exceeds our threshold, we count it.

(defun scan-square-coords (size)
  (declare (optimizable-series-function))
  (let ((displacement (coord size size)))
    (#M2v- (scan-coords (1+ (* size 2)) (1+ (* size 2)))
           (series displacement))))

(defun count-location-cheats (distances coord distance cheat-steps threshold)
  (collect-sum
   (choose
    (mapping (((cheat-vec) (scan-square-coords cheat-steps)))
      (let ((manhattan-distance (+ (abs (column cheat-vec)) (abs (row cheat-vec))))
            (cheat-coord (2v+ coord cheat-vec)))
        (and (<= manhattan-distance cheat-steps)
             (on-grid? distances cheat-coord)
             (let ((cheat-distance (grid-ref distances cheat-coord)))
               (and cheat-distance
                    (let* ((distance-if-cheating (+ manhattan-distance cheat-distance))
                           (savings (- distance distance-if-cheating)))
                      (and (>= savings threshold)
                           1))))))))))

So then we just iterate over the locations in the distance grid and call this function for each location, summing the results.

(defun count-cheats (distances-grid cheat-steps threshold)
  (collect-sum
   (choose
    (mapping (((coord distance) (scan-grid distances-grid)))
      (and distance
           (count-location-cheats distances-grid coord distance cheat-steps threshold))))))

For part 1, we can only take two steps through a wall.

(defun part-1 ()
  (count-cheats (compute-distances (read-input (input-pathname))) 2 100))

For part 2, we can take up to 20 steps through a wall.

(defun part-2 ()
  (count-cheats (compute-distances (read-input (input-pathname))) 20 100))

Joe MarshallAdvent of Code 2024: Day 19

· 22 days ago

For day 19, we are constructing sequences from fragments. We are first given a list of fragments, separated by commas. For example:

r, wr, b, g, bwu, rb, gb, br

The we are given a series of sequences that we need to construct by concatenating the fragments. For example:

brwrr  = br + wr + r
bggr   = b + g + g + r
;;; -*- Lisp -*-

(in-package "ADVENT2024/DAY19")

(defun read-input (input-pathname)
  (let ((parsed
          (collect 'list
            (#M(lambda (line)
                 (map 'list #'str:trim (str:split #\, line)))
               (scan-file input-pathname #'read-line)))))
    (values (first parsed) (map 'list #'first (rest (rest parsed))))))

Our job is to determine if the sequences can be constructed from the fragments. This is an easy recursive predicate:

(defun can-make-sequence? (fragments sequence)
  (or (zerop (length sequence))
      (some
       (lambda (fragment)
         (multiple-value-bind (prefix? suffix)
             (starts-with-subseq fragment sequence :return-suffix t)
           (and prefix?
                (can-make-sequence? fragments suffix))))
      fragments)))

Part 1 is to determine how many of the sequences can be constructed from the fragments.

(defun part-1 ()
  (multiple-value-bind (fragments sequences) (read-input (input-pathname))
    (count-if (lambda (sequence)
                  (can-make-sequence? fragments sequence))
              sequences)))

Part 2 is to count the number of ways we can construct the sequences from the fragments. Naively, we would just count the number of ways we can construct each sequence using each of the fragments as the first fragment and then sum them.

(defun count-solutions (fragments sequence)
  (if (zerop (length sequence))
      1
      (collect-sum
        (#M(lambda (fragment)
             (multiple-value-bind (prefix? suffix)
                 (starts-with-subseq fragment sequence :return-suffix t)
               (if prefix?
                   (count-solutions fragments suffix)
                   0)))
          (scan 'lists fragments)))))

But the naive approach won’t work for the larger input. The combinatorics grow far too quickly, so we need to be more clever. One possible way to do this is with “dynamic programming”, but most of the times I've seen this used, it involved a table of values and you had to invert your solution to fill in the table from the bottom up. But this is unnecessarily complicated. It turns out that “dynamic programming” is isomorphic to simple memoized recursive calls. So we won't bother with the table and inverting our solution. We'll just add some ad hoc memoization to our recursive count-solutions:

(defparameter *count-solutions-cache* (make-hash-table :test 'equal))

(defun count-solutions (fragments sequence)
  (let ((key (cons fragments sequence)))
    (or (gethash key *count-solutions-cache*)
        (setf (gethash key *count-solutions-cache*)
              (if (zerop (length sequence))
                  1
                  (collect-sum
                    (#M(lambda (fragment)
                         (multiple-value-bind (prefix? suffix)
                             (starts-with-subseq fragment sequence :return-suffix t)
                           (if prefix?
                               (count-solutions fragments suffix)
                               0)))
                      (scan 'list fragments))))))))

(defun part-2 ()
  (multiple-value-bind (fragments sequences) (read-input (input-pathname))
    (collect-sum
     (#M(lambda (sequence)
          (count-solutions fragments sequence))
        (scan ’list sequences)))))

This runs at quite a reasonable speed.

Joe MarshallAdvent of Code 2024: Day 18

· 23 days ago

For day 18, we have a maze again, but this time the input is given as coordinate pairs of where the walls go. The start and goal are the upper left and lower right respectively.

(in-package "ADVENT2024/DAY18")

(defun read-input (file grid n-bytes)
  (iterate ((coord (#M(lambda (line)
                       (apply #’coord (map ’list #’parse-integer (str:split #\, line))))
                      (cotruncate (scan-file file #’read-line)
                                  (scan-range :below n-bytes)))))
    (setf (grid-ref grid coord) ’\#))
  (setf (grid-ref grid (coord 0 0)) ’|S|)
  (setf (grid-ref grid (coord (1- (grid-height grid)) (1- (grid-width grid)))) ’|E|))

(defun sample-input ()
  (let ((grid (make-array (list 7 7) :initial-element ’|.|)))
    (read-input (sample-input-pathname) grid 12)
    grid))

(defun input (n-bytes)
  (let ((grid (make-grid 71 71 :initial-element ’|.|)))
    (read-input (input-pathname) grid n-bytes)
    grid))

The bulk of the solution simply reuses the Dijkstra’s algorithm from day 16. I won’t reproduce the code here. We just adjust the path scorer to not penalize for turns.

For part 1, we load the first 1024 walls and find a shortest path.

(defun part-1 ()
  (let* ((grid (input 1024))
         (solutions (solve-maze grid)))
    (score-path (car solutions))))

For part 2, we want to find the first wall in the list of walls that prevents us from reaching the goal. Binary search time.

(defun total-walls ()
  (collect-length (scan-file (input-pathname) #’read-line)))

(defun binary-search (pass fail)
  (if (= (1+ pass) fail)
      (list pass fail)
      (let* ((mid (floor (+ pass fail) 2))
             (grid (input mid)))
        (let ((solutions (solve-maze grid)))
          (if (null solutions)
              (binary-search pass mid)
              (binary-search mid fail))))))

(defun get-coord (n)
  (collect-nth n (scan-file (input-pathname) #’read-line)))

(defun part-2 ()
  (collect-nth (car (binary-search 1024 (total-walls)))
  (scan-file (input-pathname) #’read-line)))

Neil MunroNingle Tutorial 4: Forms

· 24 days ago

Contents

Introduction

Welcome back, in this tutorial we will look at how to submit data back to our web application, this is typically done using forms. We will start by looking at the most basic way to do it, with templates and using ningle controllers, then we will look into using a package called cl-forms. As we do so we will also look into security concerns, specifically cross site request forgery (csrf) and how to implement it.

I made a small contribution to cl-forms as part of this tutorial, as a result the version required for this tutorial may not yet be available in quicklisp so you may want to consider using git to clone it into your quicklisp/local-projects directory.

If you are uncomfortable with, or would like to review how http messages work, please consult this article on mdn, it will be important to understand how forms in html work.

We will concern ourselves with creating the beginnings of an authentication app, our form will allow a user to submit an email address, and their password twice (once to confirm it's been entered correctly), at the end of this tutorial, you will be able to serve a form and accept the submitted user data back.

We will also consider csrf security tokens, which is a common security practice and it is very important to ensure we take security seriously, even when learning!

Ningle Basic Forms

While we will look into how to use forms in ningle using basic requests, responses, and html here, it is included only as an example, the tutorial project will not use this method, instead using cl-forms.

To begin with, we shall create a html file that will represent our form, in our templates directory, we will create a file called register.html with the following content:

{% extends "base.html" %}

{% block content %}
    <h1>Register for an account</h1>
    <form action="/register" method="POST">
        <label for="username">Username</label>
        <input type="email" name="username" id="username" />

        <label for="password1">Password</label>
        <input type="password" name="password1" id="password1" />

        <label for="password2">Confirm Password</label>
        <input type="password" name="password2" id="password2" />
        
        <input type="submit" value="Register" />
    </form>
{% endblock %}

We will immediately write our ningle controllers to render this form and an view to simply print out the data submitted in the form, there's two ways you can do this, you can handle the GET and POST requests independently, or you can have one controller that does both. I will show both methods, for clarity, with some reasons of why you might pick one over the other, but I will use one controller to handle both GET and POST requests.

You might want to write separate controllers for each method to separate concerns, it may not be obvious from this example, but controllers and processing can get quite complicated, you might want to consider splitting the different logic up. The thing to notice is that there's a slight change to the line to bind a controller to a route, the :method :GET and :method :POST addition, these are required and the default is :method :GET, but in order to enable other http methods you must include any additional methods.

You may find it cleaner to separate out controllers in this manner, at the expense of writing out some extra boiler plate, personally, I quite like this, but I'm very used to the alternative method of combining both into one. I reserve the right to change my mind later!

(setf (ningle:route *app* "/register" :method :GET)
    (lambda (params)
        (djula:render-template* "register.html" nil)))

(setf (ningle:route *app* "/register" :method :POST)
    (lambda (params)
        (format t "Username: ~A~%" (cdr (assoc "username" params :test #'string=)))
        (format t "Password: ~A~%" (cdr (assoc "password1" params :test #'string=)))
        (format t "Confirm: ~A~%" (cdr (assoc "password2" params :test #'string=)))
        (djula:render-template* "register.html" nil)))

The alternative is a little bit less boiler plate, and you can tell ningle to accept multiple http methods with :method '(:GET :POST) (without accepting both it will only take one or the other), the thing we will have to bear in mind is that where previously we could know for certain we only had one type of request and we could write code only to deal with a GET or POST, here we might have to check what the nature of the request is, and conditionally perform some logic. The lack.request package has a method we can use to determine this: (lack.request:request-method ningle:*request*), this will return a string representation of the request method, in our example below "POST". If we detect a POST request we will print out (using format) the values stored in the request body.

(setf (ningle:route *app* "/register" :method '(:GET :POST))
    (lambda (params)
        (when (string= "POST" (lack.request:request-method ningle:*request*))
            (format t "Username: ~A~%" (cdr (assoc "username" params :test #'string=)))
            (format t "Password: ~A~%" (cdr (assoc "password1" params :test #'string=)))
            (format t "Confirm: ~A~%" (cdr (assoc "password2" params :test #'string=))))
        (djula:render-template* "register.html" nil)))

In both examples we have to use this (cdr (assoc "username" params :test #'string=)) (or whatever input field we want) to retrieve the values stored in the form inputs, the params object is used for url information and body parameters.

Using whichever of these methods, you should save, reload, and restart your project access it in your web browser, if you navigate to /register, your form should render. Fill in a username, and the two password fields, when you look at the terminal output, you should see the values printed out.

As impressive as this is, we need to ensure that our application is secure and we must setup "cross site request forgery" (csrf) protection. In a nutshell, this creates a unique string send as a hidden input, and is rendered inside the form, if the application does not receive its csrf token back, it can be assumed that the request has been tampered with and isn't considered safe and the request should be rejected. It's a simple, but effective security measure that you absolutely should implement when rendering forms and accepting data from them.

You can read more about csrf at the OWASP Page.

The first thing to do, we must enable the default lack middleware modules session and csrf, in our lack.builder we must modify it to look like this.

(lack.builder:builder :session
                      :csrf
                      (:static
                        :root (asdf:system-relative-pathname :ningle-tutorial-project "src/static/")
                        :path "/public/")
                      *app*)

The :session middleware module should be loaded prior to :csrf, this is because the csrf module stores information in the session object, which wont exist if the session isn't first initialised. The csrf middleware module gives us a function we can call that will give us a hidden html tag we can render in our template, but of course we must pass it into the template, we must edit the controller like so:

(setf (ningle:route *app* "/register" :method '(:GET :POST))
    (lambda (params)
        (when (eq :POST (lack.request:request-method ningle:*request*))
            (format t "Username: ~A~%" (cdr (assoc "username" params :test #'string=)))
            (format t "Password: ~A~%" (cdr (assoc "password1" params :test #'string=)))
            (format t "Confirm: ~A~%" (cdr (assoc "password2" params :test #'string=))))
        (djula:render-template* "register.html" nil :csrf (lack/middleware/csrf:csrf-html-tag ningle:*session*))))

On the final line, the render-template* function is edited to be passed a csrf keyword argument, there's other functions such as csrf-token, however, the csrf middleware module can be configured to change the name of the token (if that's what you want to do), and so having the csrf-token isn't enough, you'd need to know what it's called internally to send the right name back, rendering the html tag simplifies this.

Finally we will need to update our template to include this tag:

{% extends "base.html" %}

{% block content %}
    <h1>Register for an account</h1>
    <form action="/register" method="POST">
        {{ csrf|safe }}
        <label for="username">Username</label>
        <input type="email" name="username" id="username" />

        <label for="password1">Password</label>
        <input type="password" name="password1" id="password1" />

        <label for="password2">Confirm Password</label>
        <input type="password" name="password2" id="password2" />
        
        <input type="submit" value="Register" />
    </form>
{% endblock %}

We must remember to pipe the csrf data though the safe filter so that it is rendered as html and not simply printed to the browser. This will create a hidden input in our form, it should have the name _csrf_token, it is possible to change this, if you wish, by altering the use of :csrf in the lack.builder line.

(lack.builder:builder :session
                      (:csrf :form-token "csrf-protection-token")
                      (:static
                        :root (asdf:system-relative-pathname :ningle-tutorial-project "src/static/")
                        :path "/public/")
                      *app*)

By changing the csrf middleware setup to a list and adding the :form-token keyword you should be able to see when you restart your project that the hidden input name is now csrf-protection-token.

CL-Forms

Having now seen how forms can be done using just requests, responses, and html, we can look at a package called cl-forms, which will enable us to define what our forms will be in Common Lisp code, it may seem unusual to prepare in the backend what is typically presented by html, however the cl-forms package offers validation and an easier way to retrieve data, as well as handling the csrf for us.

We will be using cl-forms as the default way to handle forms in the tutorial, so while the above section is worth understanding, and may come in helpful under some circumstances, this tutorial will only use cl-forms.

Unlike before where we just started writing html, we need to install and setup cl-forms, it has multiple ways to configure it, and we need to use the ningle backend.

In our project asd file we need to add the following cl-form dependencies:

  1. cl-forms
  2. cl-forms.djula
  3. cl-forms.ningle

The full dependencies section should look like the following:

:depends-on (:clack
               :ningle
               :djula
               :cl-forms
               :cl-forms.djula
               :cl-forms.ningle)

It is not sufficient to just depend on cl-forms, it has multiple packages, and we want to use the djula template system and the ningle backend, so we must also include these else we may end up using the wrong implementations of some methods. The, cl-forms.djula package, for example, includes some djula tags that we will use in rendering our form and we must ensure these are loaded into our project otherwise we will get errors attempting to render the form.

You might also be tempted to enable the csrf middleware while we are editing this file, however cl-forms has its own implementation of csrf tokens and it conflicts with the ningle csrf middleware, so we do not need to implement it, in fact it will break things if we do.

As before, we will begin by editing our register.html file, however the content will be much simpler, all we will do is use a tag to render the form in one line.

{% extends "base.html" %}

{% block content %}
    <h1>Register for an account</h1>
    {% form form %}
{% endblock %}

This is a considerable amount of code we now don't have to write in our frontend templates! The {% form form %} instructs a form object to render its contents using djula (the templating package from the previous tutorial), as mentioned above the form tag is included as part of cl-forms.djula and this is why we had to depend on it.

Instead of declaring all the form fields using html, instead we can write a Lisp class that will be displayed for us, it will also handle the csrf token for us, we do not need to explicitly send it, the cl-forms package will do it for us.

That class will be written to forms.lisp, for now we will just write a basic register form, it will only include an email field, and two password fields (one will be to verify the first).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
(defpackage ningle-tutorial-project/forms
  (:use :cl)
  (:export #:register
           #:email
           #:password
           #:password-verify))

(in-package ningle-tutorial-project/forms)

(cl-forms:defform register (:action "/register" :id "signup" :csrf-protection t :csrf-field-name "csrftoken")
  ((email :email :value "")
   (password :password :value "")
   (password-verify :password :value "")
   (submit :submit :label "Register")))

Declaring a form is very similar to declaring a regular class, as the defform macro provided by cl-forms creates the accessor methods like defclass does. We do need to provide an action (which is where we want the url to send the form data to), and it's possible to pass in html attributes, but there's also the :csrf and :csrf-field-name keyword arguments, these are optional and instruct the form to include a hidden html field, something that we had to do manually using purely html.

Each attribute in the form is laid out similarly to class attributes, however taking the first field as an example (email :email :value "") this sets the form input element to have a name of email (the first item in the list), and it sets the input type to be of email, this is the second argument :email, you can see other form items have :password which maps onto a password input type. The value attribute allows you to set a value on the form input element. It's worth noting that arbitrary attributes such as id, class etc can't be set here, but the name, the type and value are all derived from the Common Lisp form attributes.

We can also set up the fields and a submit button in the defform macro, setting up values etc, there's much more that the defform can do, and I strongly suggest you have a look at the demo, we will explore more uses of defform later in this tutorial series, for now we will just connect up this form to the rest of our application and confirm everything is working first.

With the cl-forms package installed, the form class set up and the html written, there is only one final thing left to do, we need to expand our controller to load the form and send/recieve data.

One thing to remember though, because the form was defined in another file, and indeed in another package, we must either:

  • Use the package
  • Import the exported symbols
  • Explicitly use symbols

I personally choose to import exported symbols, but that's from a almost 20 years of working with Python!

To achieve this, if you want to just use the form package, in the defpackage section at the top:

(defpackage ningle-tutorial-project
  (:use :cl :ningle-tutorial-project/forms)
  (:export #:start
           #:stop))

If you wish to import exported symbols:

(defpackage ningle-tutorial-project
  (:use :cl)
  (:import-from
   :ningle-tutorial-project/forms
   #:register
   #:email
   #:password
   #:password-verify)
  (:export #:start
           #:stop))

If, however, you want to just explicitly use the symbols, we will need to look at as we come to specific areas of code.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(setf (ningle:route *app* "/register" :method '(:GET :POST))
    (lambda (params)
        (let ((form (cl-forms:find-form 'register)))
          (if (string= "GET" (lack.request:request-method ningle:*request*))
            (djula:render-template* "register.html" nil :form form)
            (handler-case
                (progn
                    (cl-forms:handle-request form) ; Can throw an error if CSRF fails
                    (multiple-value-bind (valid errors)
                        (cl-forms:validate-form form)
                      (when errors
                        (format t "Errors: ~A~%" errors))
                      (when valid
                        (cl-forms:with-form-field-values (email password password-verify) form
                            (format t "Testing: email - ~A, password - ~A, password-verify - ~A~%" email password password-verify)))
                    (djula:render-template* "register.html" nil :form form)))

                (simple-error (csrf-error)
                    (setf (lack.response:response-status ningle:*response*) 403)
                    (djula:render-template* "error.html" nil :error csrf-error)))))))

This is quite a lot more code that any of our previous controllers, as discussed in the previous section, on line 1, we must include :method '(:GET :POST) in our routing. This allows the form to be initially rendered in the GET http request and data interpreted on the server with POST http request.

Within our controller, on line 3 we use cl-forms to load the form with find-form (passing in the symbol that references the form), since we will use this form in a number of places. This will represent both the blank form rendered from the GET request and the populated form submitted in the POST request.

Line 4 is a simple check to determine with type of request we are dealing with, if the string "GET" returned by the lack.request:request-method function then the form will just be rendered with djula. With a simple if used in the code here, you might be interested to know that there are in fact 9 http methods:

  1. CONNECT
  2. DELETE
  3. GET
  4. HEAD
  5. OPTIONS
  6. PATCH
  7. POST
  8. PUT
  9. TRACE

If there's so many, why are we only use a simple if? Because of the :method '(:GET :POST)! With that we explicitly define which methods this controller will accept and we don't need to worry about the other 7 methods, and as such, a simple if is all we need in this instance.

Using only this if, line 6 begins the else clause of it, here is where things begin to get interesting! We begin with a handler-case, if you have used other languages that take advantage of Exception Handling, it's analogous to that, and you may want to skip the explaination.

If not, expand this for more details on handler-case!
    handler-case is a Common Lisp macro that, in simple terms, allows us to attempt to execute a block of code, on the understanding that it may fail, and if that happens, depending on the nature of the failure, we might want to run some other code to handle the error.

    Let's look at a simple example:
    
    (defun div (a b)
        (/ a b))

    (div 1 2)
A very simple function here "div" takes an "a" and a "b" and attempts to divide them, everything should work fine for the first call, returning 1/2 (0.5, 50%), however if you call it with the second number being 0, the interpreter signals a DIVISION-BY-ZERO error, which is correct, without wanting to go down a mathematical tangent, computers generally can't divide by zero, so throwing an error is a logical thing to do. So how can we recover from this situation? We don't want to drop into the debugger and manually handle things every time there's an error! This is what handler-case allows us to do. We start with what we want to do, in this case (/ a b), this is the first form we pass to handler-case, but we also pass in 0 or more "error-clauses".
    (defun div (a b)
        (handler-case (/ a b)
        (division-by-zero (e)
            (format nil "Can't divide by zero"))))

    (div 1 2)
    (div 1 0)
We pass in an "error-clause" that captures the condition type, in this case a division-by-zero, "error-clauses" take a condition name (remembering exceptions are a type of condition) and the condition object (which I called "e"), and perform some other code, since the original intended functionality cannot be completed. When we pass "0" in as the second argument, we now get the string "Can't divide by zero" returned from the function, which is much better, but what if I pass in something that isn't even a number?
    (div 1 "a")
Well, this time I get a new exception signalled, a type-error, which with a small modification:
    (defun div (a b)
        (handler-case (/ a b)
        (type-error (e)
            (format nil "Something isn't a number"))

        (division-by-zero (e)
            (format nil "Can't divide by zero"))))

    (div 1 2)
    (div 1 0)
    (div 1 "a")
With the new "error-clause" added, this function can now handle some exceptional circumstances! Something to bear in mind however is that the initial form to handler-case expects a single form, which is why we may have to use a progn to wrap multiple expressions in one form. Of course a let would work just as well, but in my code there's nothing to bind in the let, so a progn would do.

If the csrf token does not match the handle-request function will signal an error condition and the code in the error-clause will run (lines 18-20), the http status code will be set to 403 Forbidden and our error template will be rendered with the error object being passed to the template.

Assuming the csrf token has not been tampered with and no error is signalled, our code will run through lines 7-16, the progn will enclose all of our logic and the handle-request will bind the field values the user entered to the form object, which will then enable us to validate the form.

To validate the form we must call the validate-form function in cl-forms package. According to the documentation it returns the result of a call to values and returns two, a generalized boolean representing if the form is valid or not, and a list of errors. Typically if the form is valid there shouldn't be any errors and vice versa.

To take advantage of the multiple values returned from validate-form we should use a multiple-value-bind form.

For a recap of values and multiple-value-bind, click here!
    Sometimes you want a function to return multiple values, in some languages (like Python), this basically is returning an implicit tuple that is unpacked, in Common Lisp it is different, and more nuanced. The function values returns a special type of object that, if accessed only returns the first value, however there are other values that may be useful, but perhaps not always.
    
    A simple example is using the floor division if we try to divide 1 by 2, we end up with 0 and 1 remainder. Therefor (floor 1 2) will give 0, except it doesn't! It actually returns 0, 1, the 0 and the 1 remainder.
    
    Proving that, however, the 0 is returned by default, we can do the following:
    
    
(+ 4 (floor 1 2))
Which will give us the value of 4, since the result of (floor 1 2) is a special kind of object that holds multiple values but only gives you the first one, we basically have 4 + 0 here, which is quite correct. You might be wondering then, if we only ever get the first value... how do we get the rest? Enter multiple-value-bind! multiple-value-bind is a macro that allows us to capture all values and use them.

    (multiple-value-bind (quotient remainer)
        (floor 1 2)
      (format t "Dividing 1 by 2 gives ~A with ~A remaining!~%" quotient remainder))
Here, with our floor division example from above, we capture the quotient (how many times a number can be wholly divided) and remainder (how much remains that cannot be evenly divided) in the first form that multiple-value-bind takes, the next form must be the expression that returns a values list, it is very important to note that ALL of the returned values are listed in the first form, even if you won't be using them! Once this binding has been done, you may have as many expressions as you like inside the multiple-values-bind after the second form, all subsequent expressions are wrapped in an implicity progn.

Using the multiple-value-bind we are able to capture the valid and errors values returned from (cl:forms:validate-form form) call on line 10.

At this point in the tutorial we don't have any way for a html form to be invalid so errors won't be captured, however this is something we will come back to, so the line lines 11-12 are there to display any errors we will receive later in this tutorial, although do remember all we are doing with this tutorial is displaying messages in the terminal!

Given there's no errors to be signalled (yet) the form can be assumed to be valid and we will simply display a string in the terminal with the values the form received on lines 13-15. One thing to note is that similarly to the multiple-value-bind macro, cl-forms provides a with-form-field-values macro that given a list of fields and a form, it will bind the values of the fields of the form and allow you to access the user submitted data.

The fields must be known to the package and is why I was clear earlier about needing to import or use the form package. You could, of course access the members directly, but this is a lot of typing ('ningle-tutorial-project/forms:email instead of email for example). In Common Lisp you are of course free to construct your packages as you see fit, so if another way of arranging your code works for you by all means use that!

Finally, we render the template on line 16, as before!

If we start this application and navigate to /register then we should see the form we have defined in forms.lisp being rendered as expected. If you fill in the form, you should find that if you attempt to put something other than an email into the email field you will get the browser informing you that an email field must contain an email, which is good! This tells us that our form is being rendered as we wanted it to, using the correct html form elements! To continue, if you fill in the form and submit it, looking into the terminal should show us the data you entered, and if so, congratulations!

Now, about those lack of errors... it's possible to enter pathetic passwords into our form and we should be taking security seriously, we must talk about form validation!

A distinct advantage that using cl-forms over writing your own html forms is that while it is possible to validate the form on the client side (the web browser) if someone were to bypass the client and send data directly to your web server, it could be valid data, but it could also be invalid data (possibly a problem), or even malicious (definitely a problem!), having client side validation is no substitute for validating in the backend. A common adage in computer science "never trust user input", so we mustn't. I could attempt to convince you instead I'll just embed this.

XKCD comic titled Exploits of a mom

Never trust incoming data.

So, given the password fields allow for weak passwords, what can we do about it?

Clavier is a validation library that cl-forms depends on and we can use to validate the form data. It's a pretty low level validation library, but since cl-forms is designed to use it, integrating it is rather easy. We already wrote some code in our controller to handle errors, should they occur, so the only thing we need to do is edit our form to put our validation constraints in place. Clavier comes with individual validators and ways to combine them (&& and || for and-ing and or-ing, for example), the library has all the basic building blocks of validation that I could think of wanting.

To integrate it into our form, we must provide a ":constraints" keyword argument, which must be a list of each specific constraint we want to use, and since we are validating our password, we need to use this twice so I chose to store it as a variable.

In this example, I'm going to ensure a password:

  1. Can't be blank
  2. Is a string
  3. Is at least 8 characters long

We could also add some checks for upper and lower case letters, numbers, and special characters, and there is a regex validator that we can use to achieve that, but that's an exercise for another tutorial!

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(defpackage ningle-tutorial-project/forms
  (:use :cl)
  (:export #:register
           #:email
           #:password
           #:password-verify
           #:*password-validator*))

(in-package ningle-tutorial-project/forms)

(defparameter *password-validator* (list (clavier:not-blank)
                                         (clavier:is-a-string)
                                         (clavier:len :min 8)))

(cl-forms:defform register (:action "/register" :id "signup" :csrf-protection t :csrf-field-name "csrftoken")
  ((email :email :value "")
   (password :password :value "" :constraints *password-validator*)
   (password-verify :password :value "" :constraints *password-validator*)
   (submit :submit :label "Register")))

This is the complete listing of the forms.lisp file, as mentioned above, the only real change is creating a list of the validators we might want to use and passing them as the keyword argument. If you save all of this and start the project, you can experiment with submitting the register form with valid data, in which case you will get the information printed in the terminal. Or if you submit the form with invalid data you will see the error printed in the terminal, but you will also have the errors displayed in the web browser as seen below.

Image of register page with validation errors shown

You might be wondering, if this screenshot appears automatically for us, why we might also want to log errors, in this small example it doesn't make much sense, but in production you certainly might want to know if repeated attempts to create user accounts are failing, it could be some sort of cyber attack, or some other malicious actor probing your application and you would certainly want to know about that!

And with that, we come to the end of this tutorial, I hope you have found this helpful and are enjoying this tutorial series.

Conclusion

To recap, after working your way though this tutorial you should be able to:

  • Use html to render a form
  • Use cl-forms to render a form
  • Explain what http messages are, specifically get and post
  • Explain why cl-forms is a better choice than html
  • Explain what Cross Site Request Forgery (csrf) tokens are and how they help security
  • Use csrf tokens to prevent a csrf vulnerability
  • Handle submitting a form using html
  • Handle submitting a form using cl-forms
  • Use clavier to validate a form
  • Handle errors signalled from clavier

Github

The link for this tutorial code is available here.

Resources

Joe MarshallAdvent of Code 2024: Day 17

· 24 days ago

For day 17, we are emulating a small processor. The processor has 4 registers, a, b, and c, and a program counter. The program is an array of instructions, each of which is an integer.

;;; -*- Lisp -*-

(in-package "ADVENT2024/DAY17")

(defstruct (machine
            (:type vector)
            (:conc-name machine/))
  (pc 0)
  a
  b
  c
  (program (vector) :read-only t))

To read a machine from the input file, we build a keyword argument list for the MAKE-MACHINE function and then apply the function:

(defun read-machine (filename)
  (apply #’make-machine
         (collect-append
          (choose
           (#M(lambda (line)
                (cond ((str:starts-with? "Register A:" line)
                       (list :a (parse-integer (subseq line 11))))
                      ((str:starts-with? "Register B:" line)
                       (list :b (parse-integer (subseq line 11))))
                      ((str:starts-with? "Register C:" line)
                       (list :c (parse-integer (subseq line 11))))
                      ((str:starts-with? "Program:" line)
                       (list :program (collect ’vector
                                        (choose
                                         (#Mdigit-char-p
                                          (scan ’string (subseq line 9)))))))
                      (t nil)))
              (scan-file filename #’read-line))))))

To run the machine, we sit in a loop, reading the instruction at the program counter, and then using an ECASE to dispatch to the appropriate operation. We symbol-macrolet the parts of an instruction so that instructions appear to be simple assignments.

(defun run-machine (machine)
  (symbol-macrolet ((a  (machine/a machine))
                    (b  (machine/b machine))
                    (c  (machine/c machine))
                    (pc (machine/pc machine))
                    (program (machine/program machine))
                    (immediate (svref program (1+ pc)))
                    (argument (ecase immediate
                                (0 0)
                                (1 1)
                                (2 2)
                                (3 3)
                                (4 a)
                                (5 b)
                                (6 c)))
                    (next-instruction (progn (incf pc 2)
                                             (iter))))

    (let ((output ’()))
      (let iter ()
        (if (>= pc (length program))
            (reverse output)
            (ecase (svref program pc)
              (0 (setf a (truncate a (expt 2 argument))) next-instruction)
              (1 (setf b (logxor b immediate))           next-instruction)
              (2 (setf b (mod argument 8))               next-instruction)

              (3
               (if (zerop a)
                   next-instruction
                   (progn
                     (setf pc immediate)
                     (iter))))

              (4 (setf b (logxor b c))                   next-instruction)
              (5 (push (mod argument 8) output)          next-instruction)
              (6 (setf b (truncate a (expt 2 argument))) next-instruction)
              (7 (setf c (truncate a (expt 2 argument))) next-instruction)))))))

For part 1, we simply run the machine as given in the input file and print the output as comma separated integers:

(defun part-1 ()
  (format nil "~{~d~^,~}" 
    (run-machine (read-machine (input-pathname)))))

For part 2, we seek an initial value of the A register that will cause the machine to output its own program. We search for the value of A one digit at a time:

(defun get-machine-state (machine)
  (list (machine/pc machine)
        (machine/a machine)
        (machine/b machine)
        (machine/c machine)))

(defun set-machine-state! (machine state)
  (setf (machine/pc machine) (first state)
        (machine/a machine) (second state)
        (machine/b machine) (third state)
        (machine/c machine) (fourth state)))

(defun try-machine (machine state input-a)
  (set-machine-state! machine state)
  (setf (machine/a machine) input-a)
  (run-machine machine))

(defun pad-terms (terms size)
  (revappend (make-list (- size (length terms)) :initial-element 0) terms))

(defun from-octal (octal-digits)
  (fold-left (lambda (n digit) (+ (* n 8) digit)) 0 (reverse octal-digits)))

(defun part-2 ()
  (let* ((machine (read-machine (input-pathname)))
         (initial-state (get-machine-state machine))
         (target (machine/program machine)))
    (let term-loop ((terms ’())
                    (index (1- (length target))))
      (if (= index -1)
          (from-octal terms)
          (let digit-loop ((digit 0))
            (if (> digit 7)
                (error "No solution")
                (let* ((padded (pad-terms (cons digit terms) (length target)))
                       (output (try-machine machine initial-state (from-octal padded))))
                  (if (and (= (length output) (length target))
                           (= (elt output index) (svref target index)))
                      (term-loop (cons digit terms) (1- index))
                      (digit-loop (1+ digit))))))))))

The outer iteration in part-2 is over the program instructions. If the index is -1, we have found the solution. Otherwise, we iterate over the digits 0-7, trying each one in turn. We pad the terms with zeros to make an octal input number, run the machine, and check the output. If the output matches the target, we move to the next term. Otherwise, we increment the digit.

Joe MarshallAdvent of Code 2024: Day 16

· 25 days ago

For day 16, we are solving a maze. We want to find the lowest cost path from the start to the end. Taking a step straight ahead costs 1, but turning left or right costs 1000.

This puzzle was the most vexing of all the puzzles. The solution is straightforward but the devil is the details. I found myself constantly mired in the CARs and CDRs of the path data structure, descending too far or not far enough. I tried several different representations for a path, each one with its own set of problems. Trying to keep track of the direction of the steps in the path turned out to be an exercise in frustration.

The algorithm is a variant of Dijkstra’s algorithm, which finds the shortest weighted path in a graph. In our case, the graph is derived from the maze. The vertices of the graph are the locations in the maze with three or more paths leading out of them. The edges in the graph are the steps between the vertices. But you cannot compute the cost of a path by summing the weights of the edges, as the final edge in the path may be reached either by proceeding straight through the prior vertex, or by turing left or right at the prior vertex. Thus I modified Dijkstra's algorithm to be edge-oriented rather than vertex-oriented. This turned out to be a key to solving the problem. With the vertex-oriented solutions, I had to keep track of the orientation of the path as it entered and left the vertex, and annotating the steps along the path with their orientation turned into a bookkeeping nightmare. With the edge-oriented solution, I could discard the orientation information as I advanced the algorithm and reconstruct the orientation information only after I had generated a candidate path. This greatly simplified the bookkeeping.

The algorithm uses a pure functional weight-balanced binary tree as a priority queue for the paths. The tree is kept in order of increasing path score, so the lowest scoring path is always the leftmost path in the tree. In my original implementation, I punted and used a linear priority queue. This is simple, and it works, but is far too slow. The weight-balanced binary tree was cribbed from MIT-Scheme.

;;; -*- Lisp -*-

(in-package "ADVENT2024/DAY16")

(defun read-input (input-pathname)
  (read-file-into-grid
    (char-interner #’identity (find-package "ADVENT2024/DAY16"))
     input-pathname))

(defun start-and-goal (maze)
  (let ((inverse (invert-grid maze ’|.|)))
    (values (first (gethash ’S inverse))
            (first (gethash ’E inverse)))))

Since Dijkstra’s algorithm is a graph algorithm, we need to represent the maze as a graph. We simplify the graph by flooding the dead ends.

(defun dead-end? (maze coord)
  (and (on-grid? maze coord)
       (eql (grid-ref maze coord) ’|.|)
       (let ((n (coord-north coord))
             (s (coord-south coord))
             (e (coord-east coord))
             (w (coord-west coord)))
         (let ((n* (or (not (on-grid? maze n))
                       (eql (grid-ref maze n) ’\#)))
               (s* (or (not (on-grid? maze s))
                       (eql (grid-ref maze s) ’\#)))
               (e* (or (not (on-grid? maze e))
                       (eql (grid-ref maze e) ’\#)))
               (w* (or (not (on-grid? maze w))
                       (eql (grid-ref maze w) ’\#))))
           (or (and n* e* w*)
               (and e* n* s*)
               (and s* e* w*)
               (and w* n* s*))))))

(defun flood-dead-end! (maze coord)
  (when (dead-end? maze coord)
    (setf (grid-ref maze coord) ’\#)
    (flood-dead-end! maze (coord-north coord))
    (flood-dead-end! maze (coord-south coord))
    (flood-dead-end! maze (coord-east coord))
    (flood-dead-end! maze (coord-west coord))))

(defun flood-dead-ends! (maze)
  (iterate ((coord (scan-grid-coords maze)))
    (flood-dead-end! maze coord)))

We then mark the vertices of the graph by looking for locations with three or more paths leading out of them.

(defun vertex? (maze coord)
  (and (on-grid? maze coord)
       (eql (grid-ref maze coord) ’|.|)
       (let ((n (coord-north coord))
             (s (coord-south coord))
             (e (coord-east coord))
             (w (coord-west coord)))
         (let ((n* (and (on-grid? maze n) (member (grid-ref maze n) ’(\. + S E))))
               (s* (and (on-grid? maze s) (member (grid-ref maze s) ’(\. + S E))))
               (e* (and (on-grid? maze e) (member (grid-ref maze e) ’(\. + S E))))
               (w* (and (on-grid? maze w) (member (grid-ref maze w) ’(\. + S E)))))
           (or (and n* e* w*)
               (and e* n* s*)
               (and s* e* w*)
               (and w* n* s*))))))

(defun mark-vertices! (maze)
  (let ((vertices ’()))
    (iterate ((coord (scan-grid-coords maze)))
      (when (vertex? maze coord)
        (setf (grid-ref maze coord) ’+)
        (push coord vertices)))
    vertices))

After flooding the dead ends and marking the vertices, all the edges begin and end at a vertex.

It isn’t necessary for the solution, but it helps to be able to visualize the maze. The show-maze procedure will print the maze to the standard output. The show-maze procedure takes an optional list of coords to highlight in the maze.

(defun show-maze (maze &optional highlight)
  (format t "~&")
  (dotimes (row (grid-height maze))
    (format t "~%")
    (dotimes (col (grid-width maze))
      (cond ((eql (grid-ref maze (coord col row)) ’\#)
             (format t "#"))
            ((member (coord col row) highlight :test #’equal)
             (format t "O"))
            ((eql (grid-ref maze (coord col row)) ’|S|)
             (format t "S"))
            ((eql (grid-ref maze (coord col row)) ’|E|)
             (format t "E"))
            ((eql (grid-ref maze (coord col row)) ’+)
             (format t "+"))
            (t
             (format t "."))))))

Between the vertices, we have the edges of the graph. An edge is simply the a list of coordinates between two vertices. The first and last coordinates of the edge are vertices. To find all the coordinates between two vertices, we walk the edge from the start until we reach another vertex. We don’t maintain direction. Instead, we just make sure that the new coordinate isn’t the last one in the edge we are walking so that we move forward.

(defun walk-edge (maze coord edge)
  (let ((n (coord-north coord))
        (s (coord-south coord))
        (e (coord-east coord))
        (w (coord-west coord)))
    (cond ((and (on-grid? maze n)
                (not (equal n (first edge)))
                (eql (grid-ref maze n) ’|.|))
           (walk-edge maze n (cons coord edge)))
          ((and (on-grid? maze n)
                (not (equal n (first edge)))
                (member (grid-ref maze n) ’(+ S E)))
           (list* n coord edge))
          ((and (on-grid? maze e)
                (not (equal e (first edge)))
                (eql (grid-ref maze e) ’|.|))
           (walk-edge maze e (cons coord edge)))
          ((and (on-grid? maze e)
                (not (equal e (first edge)))
                (member (grid-ref maze e) ’(+ S E)))
           (list* e coord edge))
          ((and (on-grid? maze s)
                (not (equal s (first edge)))
                (eql (grid-ref maze s) ’|.|))
           (walk-edge maze s (cons coord edge)))
          ((and (on-grid? maze s)
                (not (equal s (first edge)))
                (member (grid-ref maze s) ’(+ S E)))
           (list* s coord edge))
          ((and (on-grid? maze w)
                (not (equal w (first edge)))
                (eql (grid-ref maze w) ’|.|))
           (walk-edge maze w (cons coord edge)))
          ((and (on-grid? maze w)
                (not (equal w (first edge)))
                (member (grid-ref maze w) ’(+ S E)))
           (list* w coord edge)))))

Given a vertex, we can find all the edges that lead out of that vertex.

(defun vertex-edges (maze vertex)
  (let ((n (coord-north vertex))
        (s (coord-south vertex))
        (e (coord-east vertex))
        (w (coord-west vertex))
        (edges ’()))
    (when (and (on-grid? maze n) (member (grid-ref maze n) ’(|.| + S E)))
      (push (walk-edge maze n (list vertex)) edges))
    (when (and (on-grid? maze s) (member (grid-ref maze s) ’(|.| + S E)))
      (push (walk-edge maze s (list vertex)) edges))
    (when (and (on-grid? maze e) (member (grid-ref maze e) ’(|.| + S E)))
      (push (walk-edge maze e (list vertex)) edges))
    (when (and (on-grid? maze w) (member (grid-ref maze w) ’(|.| + S E)))
      (push (walk-edge maze w (list vertex)) edges))
    edges))

Given the ordered list of coords in a path through the maze, we need to be able to score it. There is a cost of 1 for every step, and a cost of 1000 for every turn. We calculate these separately.

To find the directions of the steps in the path, we examine adjacent coords. If the columns are the same, the direction is north/south. If the rows are the same, the direction is east/west. The very first direction is east/west because the start is always facing east. Once we have a sequence of the directions, we examine adjacent directions to see if they are the same. If they are, we went straight, otherwise we turned.

(defun count-turns (coord-list)
  (multiple-value-bind (bs as)
      (chunk 2 1 (multiple-value-bind (ls rs) (chunk 2 1 (scan ’list coord-list))
                   (catenate (#M(lambda (l r)
                                  (cond ((= (column l) (column r)) ’ns)
                                        ((= (row l) (row r)) ’ew)
                                        (t (error "Funky coord-list."))))
                                ls
                                rs)
                             (scan ’list (list ’ew)))))
    (collect-length (choose (#Mnot (#Meq bs as))))))

(defun score-coord-list (coord-list)
  (1- (+ (length coord-list)
         (* 1000 (count-turns coord-list)))))

We represent a path as a list of edges. Given a list of edges, we need to stitch them together to create a list of coords in order to score the path. We cannot simply append the edges together, as the vertices between the edges will be duplicated. Instead, we drop the last coord (the ending vertex) from each edge except the first.

(defun at-goal? (path goal)
  (equal (first (first path)) goal))

(defun path->coord-list (path)
  (if (null (rest path))
      (first path)
      (append (butlast (first path)) (path->coord-list (rest path)))))

Given a path, we can extend it by finding the edges that lead out of the last vertex in the path. We discard the edge that came into the vertex, as we don’t want to backtrack.

(defun path-extensions (maze path)
  (let* ((latest-edge (first path))
         (latest-vertex (first latest-edge))
         (back-edge (reverse latest-edge))
         (outgoing-edges (remove back-edge (vertex-edges maze latest-vertex) :test #’equal)))
    (map ’list (lambda (edge) (cons edge path)) outgoing-edges)))

As I mentioned earlier, we use a weight-balanced binary tree as a priority queue. I didn’t bother trying to abstract this. I’m just manipulate the raw nodes of the tree. Each node has a key, which is the score, and a value, which is a list of paths that have that score. We compare keys with the < function. Weight-balanced binary trees are pure functional — adding or popping the queue returns a new queue rather than side effecting the existing one.

(defun make-priority-queue ()
  wtree::empty)

(defun pq-insert (pq entry score)
  (let* ((probe (wtree::node/find #’< pq score)))
    (wtree::node/add #’< pq score (cons entry (and probe (wtree::node/v probe))))))

(defun pq-pop (pq)
  (let* ((node (wtree::node/min pq))
         (score (wtree::node/k node))
         (value-list (wtree::node/v node))
         (value (car value-list))
         (tail (cdr value-list)))
    (if (null tail)
        (values value score (wtree::node/delmin pq))
        (values value score (wtree::node/add #’< (wtree::node/delmin pq) score tail)))))

We finally arrive at the solve-maze procedure. This proceeds in three parts. First, we prepare the maze by flooding the dead ends and marking the vertices. We initialize visited-edges which is a hash table mapping an edge to the lowest score that has been found for a path ending in that edge. We initialize predecessor-edges which is a hash table mapping an edge to the edge that came before it in the lowest scoring path. The initial edges are the ones leading out of the start vertex, and the initial paths are the paths each containing one of the initial edges.

The second part is the main iteration. The outer iteration pops the lowest scoring path so far from the priority queue. If the path ends at the goal, we have found one solution and we proceed to part three where we collect other solutions that with the same score that end at the goal. Otherwise, we enter an inner loop over all ways we can extend the path by one edge. For each extension, we score the extension and look up the most recent edge in the visited-edges.

If we have not visited the edge before, we store the edge in visited-edges and store its predecessor in predecessor-edges. If we have visited the edge before, we have three cases. If the score of the extension is greater that the score we have seen before, we discard the extension. If the score of the extension is equal to the score we have see before, we add the edge preceeding the final edge to the predecessor-edges, but do not pursue this path further. If the score of the extension is less than the score we have previously found, we update the visited-edges with the new lower score and update the predecessor-edges so that this path is the only path leading to the final edge.

When we find a path that ends at the goal, we enter the third part of the procedure. We pop paths from the priority queue collecting any other paths that have also reached the goal with the same score. Finally, we return the list of shortest paths.

(defun solve-maze (maze)
  (flood-dead-ends! maze)
  (mark-vertices! maze)
  (multiple-value-bind (start goal)
      (start-and-goal maze)
    (let* ((visited-edges     (make-hash-table :test ’equal))
           (predecessor-edges (make-hash-table :test ’equal))
           ;; The initial edges are the ones that start at the start vertex.
           (initial-edges (vertex-edges maze start))
           ;; A path is a list of edges.  An initial path is a list of one edge starting at the start vertex.
           (initial-paths (map ’list #’list initial-edges)))

      (dolist (edge initial-edges)
        (setf (gethash edge visited-edges) (score-path (list edge))))

      ;; Main loop, iteratively extend the lowest scoring path.
      (let iter ((scored-paths (do ((pq (make-priority-queue) (pq-insert pq (car initial-paths) (score-path (car initial-paths))))
                                    (initial-paths initial-paths (cdr initial-paths)))
                                   ((null initial-paths) pq))))
        (unless (wtree::empty? scored-paths)
          (multiple-value-bind (path path-score next-scored-paths) (pq-pop scored-paths)
            (if (at-goal? path goal)
                ;; Reached the goal.  Keep popping until we have all solutions.
                (let solution-iter ((solutions (list path))
                                    (next-scored-paths next-scored-paths))
                  (if (wtree::empty? next-scored-paths)
                      solutions
                      (multiple-value-bind (other-path other-path-score next-scored-paths) (pq-pop next-scored-paths)
                        (if (= other-path-score path-score)
                            (solution-iter (if (at-goal? other-path goal)
                                               (cons other-path solutions)
                                               solutions)
                                           next-scored-paths)
                            (values solutions predecessor-edges)))))
                (let iter1 ((extensions (path-extensions maze path))
                            (next-scored-paths next-scored-paths))
                  (if (null extensions)
                      (iter next-scored-paths)
                      (let* ((extension (first extensions))
                             (extension-score (score-path extension))
                             (latest-edge (first extension))
                             (predecessor (second extension))
                             (prior-score (gethash latest-edge visited-edges)))
                        (cond ((null prior-score)
                               (setf (gethash latest-edge visited-edges) extension-score
                                     (gethash latest-edge predecessor-edges) (list predecessor))
                               (iter1 (rest extensions)
                                      (pq-insert next-scored-paths extension extension-score)))
                              ;; If we have found an extension with a worse score, we ignore it.
                              ((> extension-score prior-score)
                               (iter1 (rest extensions) next-scored-paths))
                              ;; If we have found an extension with an equal score, we add the predecessor,
                              ;; but do not pursue it further.
                              ((= extension-score prior-score)
                               (push predecessor (gethash latest-edge predecessor-edges))
                               (iter1 (rest extensions) next-scored-paths))
                              ;; If we have found an extension with a better score, we replace the prior extension.
                              ((< extension-score prior-score)
                               (setf (gethash latest-edge visited-edges) extension-score
                                     (gethash latest-edge predecessor-edges) (list predecessor))
                               (iter1 (rest extensions)
                                      (pq-insert next-scored-paths extension extension-score))))))))))))))

Of note is how the inner and outer iterations interact. The inner iteration is initialized with one of the loop variables of the outer loop. When the inner loop is done, it tail calls the outer loop with the loop variable it originally got from the outer loop. This gives the effect of the inner loop sharing a loop variable with the outer loop.

collect-minimum-coords collects all the coords along all minimal paths that lead through edges on the edge list.

(defun collect-minimum-coords (edge-list predecessor-table)
  (fold-left (lambda (coords edge)
               (union coords
                      (union edge (collect-minimum-coords (gethash edge predecessor-table) predecessor-table)
                             :test #’equal)
                      :test #’equal))
             ’()
             edge-list))

For part 1 of the puzzle, we solve the maze and return the score of a shortest path.

(defun part-1 ()
  (let ((maze (read-input (input-pathname))))
    (multiple-value-bind (paths predecessor-table) (solve-maze maze)
      (declare (ignore predecessor-table))
      (score-path (first paths)))))

For part 2 of the puzzle, we solve the maze and collect the coords of all the minimal paths that lead through the edges of the shortest paths.

(defun part-2 ()
  (let ((maze (read-input (input-pathname))))
    (multiple-value-bind (paths predecessor-table) (solve-maze maze)
      (let ((minimum-coords (collect-minimum-coords (map ’list #’first paths) predecessor-table)))
        (length minimum-coords)))))

vindarelThese years in Common Lisp: 2023-2024 in review

· 35 days ago

This is a personal pick of the most interesting projects, tools, libraries and articles that popped-up in Common Lisp land in the last two years.

Newcomers might not realize how the Common Lisp ecosystem, though stable in many ways, actually evolves, sharpens, tries new solutions, proposes new tools, ships new libraries, revives projects. And everyone might enjoy a refresher.

Here’s my previous overview for 2022.

The same warnings hold: I picked the most important links, in my view, but this list is by no means a compilation of all new CL projects or articles published on the topic. Look for yourself on Reddit, Quicklisp releases, GitHub, and use your favourite search engine.

There are too many great news and achievements to pick 3. I love what’s happening around SBCL (and ECL, and Clozure’s revival), I love everything that got included into Lem and the work on all other editors, I love the webviews and I love the scripting tools that are emerging. What are your top picks?

OK, there’s a news I want to put at the forefront: HackerNews now runs on top of SBCL ;)


If you are discovering the ecosystem, my recommendaton is to not miss these two resources:

  • Awesome-cl - a curated list of libraries (there might be more than you think)
    • if you are looking for a list of recommended libraries on each topic, look here.
  • the CL Cookbook

Now let’s dive in and thanks to everyone involved.

The OpusModus music composition software.

Table of Contents

Community

We could start with some reddit stats: 2025 - a New Year for an old programming language! (numbers are up).

The ELS team kept organizing the conference. We have a date and place for 2025: European Lisp Symposium 2025 in Zürich, May 1920

We saw new and regular Lisp Ireland meetups.

Here’s one of their videos: Lisp Ireland, February 2024 Meetup - Lisp & Hardware Verification with ACL2

@djha-skin ran a survey, which is not an established practice in the community, and analysed the results: Common Lisp Community Survey 2024 Results .

@shinmera (Yukari), the author of many useful libraries and an active member of the ELS, and even the host of the next one, opened a Patreon. “If you’d like to help me continue my full-time open source Lisp work, please consider supporting me.”. Sponsoring Yukari is money well spent. She is on GH sponsors and ko-fi too.

The community is on reddit, Discord, Mastodon, LinkedIn... and also on XMPP.

Documentation

The CL Cookbook is a collaborative resource with new contributors each year: new Cookbook EPUB and PDF release: 2025-01.

We got a great contribution: Cookbook: Building Dynamic Libraries with SBCL-Librarian · by em7

PAIP is a classic, now available on the web: Peter Norvig: Paradigms of Artificial Intelligence Programming, Case Studies in Common Lisp (web version).

New resource: Web Apps in Lisp: Know-how: I wanted a resource specialized for web development in Common Lisp. I mean to continuously extend it from now on.

I’ll include a couple general videos in this section. More videos and more documentation improvements are to be found in their respective sections.

FreeCodeCamp released an extensive Common Lisp course on Youtube: Lisp Programming Language - Full Course for Beginners - freeCodeCamp.org - Youtube.

David Botton of CLOG fame released more beginner material, among which Common Lisp - The Tutorial - Fast, Fun and Practical (with CLOG).

I carry on the work on my Common Lisp course in videos, on the Udemy platform. Lately, I worked on a CLOS tutorial: I published 9 videos (1h 22min) on my course. You’ll know enough to read the sources of Hunchentoot or the Kandria game 🎥 comments. The course is comprised of more than 7 hours of short videos, with a code first approach, divided in 9 chapters. We see some basics but we quickly dive into more advanced Common Lisp topics. You can learn more about it here on GitHub. Students can send me an email for a free link.

Here’s the feedback of redditors:

I can vouch for the Udemy course. From the very first lesson, just firing up the REPL and Emacs/SLIME I was taught something new. It’s a great course.

fuzzmonkey35, January 2025 (reddit)

It is an amazing tutorial. What is really strange is I thought CLOS was complicated. I guess it can be but Vincent is amazing at explaining everything and demystifying it.

intergallactic_llama, January 2025 (reddit)

;)

Implementations

Great times for Common Lisp implementations.

SBCL

SBCL ships monthly releases. You really should look at and appreciate all the activity and the continous improvements.

One noticeable addition: its new garbage collector. SBCL: merge of the mark-region GC.

More improvements include:

  • “the mark-region parallel garbage collector can be enabled on arm64. (Thanks to Hayley Patton)”,
  • new contrib module sb-perf, “a performance-analysing tool for Linux. (thanks to Luke Gorrie and Philipp Marek)”
  • support for cross-compiling the system to Android has been added (thanks to Gleefre)
  • “support for memory allocation arenas is now available on the arm64 platform.”
  • haiku support
  • sb-simd improvements

More good stuff with SBCL:

SBCL on the Nintendo Switch

There are open bounties to improve SBCL:

ABCL

New release: ABCL 1.9.1 “never use a dot oh”: CFFI compatibilities, Java virtual threads, ASDF 3.3.6, fixed loading of Fricas0 and Maxima...

New release ABCL 1.9.2.

New tool: Announcing the First Release of abcl-memory-compiler - Now Available!

CCL

Clozure was a bit active, but rather dormant.

Great news: Clozure is back

Clozure CL 1.13 released.

Allegro

Allegro Common Lisp 11.0 from Franz Inc.

LispWorks

I didn’t spot a patch release (they had a major release in 2022), so let’s link to a discussion: is LispWorks worth it? you might learn some things about LW’s feature set.

ECL

Embeddable, targetting WASM... is it the future?

CLASP

CLASP targets C++ on LLVM.

Release: Clasp v2.5.0

They realeased Clasp v2.7.0 in January, 2025.

For context:

SICL - the new, portable and modular implementation

The SICL implementation is very active.

SICL is a new implementation of Common Lisp. It is intentionally divided into many implementation-independent modules that are written in a totally or near-totally portable way, so as to allow other implementations to incorporate these modules from SICL, rather than having to maintain their own, perhaps implementation-specific versions.

SICL’s components are used, for example, in the CLASP implementation.

Related, the second-climacs editor shows good activity too. Watch this demo, showing on-the-fly code parsing and feedback, it looks pretty cool. Here too, each achievement is extracted into its own component. So the second-climacs’ codebase actualy shrinks with time.

If you want to hack on CL, those are good places.

New implementations

Historical: Medley Interlisp

We can run the Medley Interlisp Lisp machine in a browser O_o The work achieved by this group is phenomenal, look:

I suggest to follow @interlisp@fosstodon.org on Mastodon.

Companies and jobs

Yes, some companies still choose Common Lisp today, and some hire with a public job posting.

It’s of course the visible top of the iceberg. If you dream of a Lisp job, I suggest to be active and make yourself visible, you might be contacted by someone without a proper job announce. This could be for an open-source project with funding (happened to me), for a university, etc.

We knew these companies since awesome-lisp-companies -it’s only a list of companies we know about, nothing offical. Additions welcome.

Discussions on the topic:

Projects

Editors

Please check out the Cookbook: editors for a list of good editors for Common Lisp. You migth be surprised.

Let’s highlight a new editor in town: Neomacs: Structural Lisp IDE/computing environment . Mariano integrated it in his moldable web desktop: Integrating Neomacs into my CLOG-powered desktop.

About Emacs

About VSCode

About Lem and Rooms pair programming environment

  • Lem 2.0.0 released
    • released in May 2023, this version added the SDL2 frontend, adding mouse support, graphic capabilities, and Windows support.
    • it brought the possibility to draw images and shapes at any location on a buffer or window.
    • addition of many base16 color themes (180), by @lukpank.
  • Lem 2.1.0 released, with many new contributors. Lem 2.0 definitely caught the eyes of many developers IMO.
    • this is when Lem got its website: https://lem-project.github.io/
    • @sasanidas worked on supporting other implementations: “ECL and CCL should work fairly well”, “ABCL and Clasp are still work in progress, working but with minor bugs.”.
    • I added project-aware commands, find-file-recursively
    • @cxxxr added (among everything else) great Lisp mode additions (just look at the release notes and the screenshots)
    • added a sidebar / filer
    • and much more. Just look at the release.
  • then came out Lem 2.2.0
    • the release notes are less organized ;)
    • added libvterm integration
    • this is when I added the interactive git mode.

Unfortunately these latest releases do not ship a readily usable executable. But the installation recipes have been greatly simplified and use Qlot instead of Roswell. There’s a one-liner shell command to install Lem on Unixes.

Lem’s creator cxxxr is now on GitHub sponsors.

He is also working on Rooms, aka Lem on the cloud: it’s a Lem-based “pair programming environment where you can share your coding sessions”. Only the client is open-source, so far at least.

Demo: https://www.youtube.com/watch?v=IMN7feOQOak

Those are the Lem related articles that popped up:

Lem's Legit Git interface.

About LispWorks

About the Jetbrains plugin

About Jupyter

Other tools

Coalton

Coalton is

the implementation of a static type system beyond Haskell 95. Full multiparameter type classes, functional dependencies, some persistent data structures, type-oriented optimization (including specialization and monomorphization). All integrated and native to CL without external tools.

And used in production for years in the quantum industry. See quilc.

I found Coalton-related projects:

E. Fukamachi added Coalton support for Lem: https://lem-project.github.io/modes/coalton-lang/. This adds completion, syntax highlighting, interactive compilation and more inside “coalton-toplevel” forms.

Package managers

Quicklisp had a one year hiatus, because it relies on one man. It finally got an update after 1 year: Quicklisp libraries were updated 2024-10-12. Despite a call for collaboration, we don’t really know how we can help.

But Quicklisp isn’t the only library manager anymore.

Also:

Gamedev

The Kandria game was released: https://kandria.com/

If you are into game dev, this is a paper you cannot miss: Kandria: experience report, presented at the ELS 2023.

Great articles:

and more:

I almost forgot the Lisp Game Jams and the new cool little games. For example: Nano Towers

a simple tower defense game written in Common Lisp with the EON framework based on Raylib, submitted for the Spring Lisp Game Jam 2024.

Links to the jams:

GUI

Many solutions exist. Disclaimer: the perfect GUI library doesn’t exist. Please see the Cookbook/gui and awesome-cl. Also don’t miss the web views available today.

releases:

As always, we might not highlight the work achieved on existing libraries that didn’t get a proper announce. There are more GUI libraries for CL.

demos:

Web

CLOG appeared in 2022 and is kicking. Its API has been stable for 4 years.

You know Hacker News, the website, right? Hacker News now runs on top of SBCL

HN runs on top of Arc, the language. Arc was implemented on top of Racket (-> MzScheme). A new, faster / more efficient, implementation of Arc in SBCL was in the works by a Hacker News site maintainer for some time: called Clarc. Its source code has not been published. Since [late september, 2024], the official Hacker News site runs using Clarc and SBCL.

Here’s (again) my new resource for web development in Common Lisp: Web Apps in Lisp: Know-how.

Now the links:

  • CLOG CLOG 2.0 - Now with a complete Common Lisp IDE and GUI Builder (with or w/o emacs)
  • CLOG OS shell
CLOG shell

Projects built with CLOG:

moldable desktop

Weblocks (continued in the Reblocks project):

More:

Articles:

videos:

libraries:

The web views I mentioned: Electron is a thing, but today we have bindings to webview.h and webUI:

Nyxt 4.0 pre-realease - now on Electron

Nyxt 4.0-pre-release-1 was published in late 2024.

They are publishing a Flatpak featuring the legacy WebKitGTK port and a new Electron one.

Electron has better performance and opens the door for macOS and Windows support.

More libraries

Data structures:

Language extensions, core libraries:

Iteration:

Developer tools:

Threads, actors:

Documentation builders:

Databases:

relational database and first order logic:

Numerical and scientific:

Plotting:

Bindings and interfaces:

Serialization:

Date and time:

Utilities:

Bindings and interfaces to other software:

Networking:

Scripting

(I love what’s being done here)

Software releases

Other articles

Videos

Demos:

Web:

More from the ELS (see their Youtube channel):

Learning:

Aaaand that’s it for the tour of the last couple years. Tell me if I missed something. I’ll keep updating this post for a few days.

Happy lisping and show us what you build!

Tim BradshawThe modern real programmer

· 52 days ago

This is adapted from an email from my friend Zyni, used with her permission. Don’t take it too seriously.

Real programmers do not write programs like this. If a real programmer has to deal with a collection of particles, they do not have some silly object which represents a particle, perhaps made up of other objects representing physical vectors, and then some array of pointers to these particle objects. That is a bourgeois fantasy and the people who do that will not long survive the revolution. They will die due to excessive pointer-chasing; many of them have already died of quiche.

Real programmers do today as they have always done: if they have some particles to simulate a galaxy they make an array of floating point numbers, in which the particles live.

This is how it has always been done, and how it always will be done, by people who care about performance.

And this is why Lisp is so superb. Because you can write this:

(for* ((i1 (in-particle-vector-indices pv))
       (i2 (in-particle-vector-indices pv i1)))
  (declare (type particle-vector-index i1 i2))
  (with-particle-at (i1 pv :name p1)
    (with-particle-at (i2 pv :name p2)
      (let/fpv ((rx (- p2-x p1-x))
                (ry ...)
                ...)
        ... compute interactions ...))))

And this is:

  • very fast1, because it all turns into optimized loops over suitable (simple-array double-float (*)) with no silly objects or consing;
  • relatively easy for a human to read, since you can see, for instance what (for ((i (in-particle-vector-indices v))) ...) is doing and do not have to second-guess some idiot loop form which will be full of obscure bugs;
  • quiche-compatible: you can easily write a function particle-at which will construct a particle object from a particle vector entry (such a function will later be excised as it has no callers, of course);
  • perhaps most important it is possible for a program to take this code and to look at it and to say, ‘OK, this is an iteration over a particle vector - it is not some stupid hard-to-parse (loop for ... oh I have no idea what this is ...) as used by the quiche people, it is (for ((i (in-particle-vector-indices v))) ...) and it is very easy to see what this is - and there are things I can do with that’ and generate Fortran which can be easily (or, less difficultly — is ‘difficultly’ a word? English is so hard) be made to run well on proper machines with sensible numbers of processors.

And this is the thing they still do not see. You write your program which uses the only useful data structure, but you also write your program in a language you have built designed so that both a human and another program can understand it, and do useful things with it, because your program says what it means. Every construct in your program should be designed so that this other program can get semantic information from that construct to turn it into something else.

And this is why Lisp is so uniquely useful for real orogrammers. Lisp has only one interesting feature today: it is a language not for writing programs, but for writing languages.

That is what real programmers do: they build languages to solve their problems. The real programmer understands only two things:

  • the only data structure worth knowing about is the array;
  • her job as a programmer is to write languages which will make writing programs to manipulate arrays easy for a human to understand;
  • and her other job is to write other programs which will take these programs and turn them into Fortran;
  • and when that is done she can go and ride her lovely cob to the fair.

Real programmers also can count only to two.


  1. I (Tim, not Zyni, who would use a cleverer integrator) wrote a mindless program to integrate systems of gravitating particles to test some of the things we’ve written that are mentioned in this email. On an Apple M1 it sustains well over 1 double precision GFLOP. Without using the GPU I think this is about what the processor can do. 

Neil MunroNingle Tutorial 3: Static Files Middleware

· 53 days ago

Contents

Introduction

Welcome back to this tutorial series, in this chapter we will be looking at the topic of static files, before we begin, we need to come to an understanding on just what static files are. Static files are files that do not need to be further processed by your application; images, videos, css, JavaScript files all generally do not need to be processed by your web applications, and thus can simply be served as is. Files that must be processed by your web application (like the templates from the previous tutorial) typically need further processing by your web application and thus are not static files, and could be called dynamic files (although this term isn't really used).

While developing an application there's often a requirement to de-couple these static files from the main application code, you might want to serve these separately in production and many web servers help you do this for performance reasons (in fact NGINX is very good at this), however you might not need the scalability locally while you are working on your application, and so Ningle has a middleware module to serve these static files when you don't need a dedicated static file server.

Another, more practical consideration of serving static files is that if you don't have a way to serve these files for you, you would have to write a controller for every image, or css file in your application, this wont scale well at all, and you'll spend most of the time writing code to serve files rather than building your application. Static file management allows you to serve a directory of files and reference them by path, but you must set it up correctly in the first place.

Note: We will be using djula, as we did before, however as of 2025-01-15 this has not yet been merged into quicklisp, you may need to clone the latest djula from github into your quicklisp/local-projects directory to gain access to the latest version needed for this tutorial.

Introducing Middleware

In reality Ningle deligates the responsibility of serving static files to the underlying lack package by way of the lack middleware. There are a number of different lack middleware modules available by default and throughout this tutorial we will look at most (if not all) of them.

In most web frameworks (Ningle included) middleware runs between the request being accepted and the code in your controller running. It is similar to a controller in that it has access to the request and response objects, and it may pass its response onto the next middleware function or a controller, it depends on what the middleware function is written to do.

In the case of static files here, the end goal will be that a request for a file will come to your webserver, and the static middleware module will run before any controllers, and if the static resource is found, the middleware function will return a response and with our not-found method, if the url couldn't be found, our not-found method runs instead.

Simple Middleware Example

To illustrate how this works in practice, we will write a piece of custom middleware that will add a new variable to the request environment, which we will then extract in a controller and display in a template, we'll use a number that gets incremented each time the middleware is run. In effect we will implement a hit counter in middleware!

Please note: This will not actually be used in the tutorial overall and serves only as a guide for how to write custom middleware generally, please follow this section to complete your understanding and feel free to include it (if you wish), but it will not be featured in the accompanying github code or used anywhere else in this tutorial.

In our main application code we define an app objects, under this we will define a new variable to track our count.

(defvar *app* (make-instance 'ningle:app))
(defvar *count* 0)

Now in order to take advantage of using middleware we must restructure how we built the ningle app, you may recall writing a start function that looked like the following.

(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
    (clack:clackup
     *app*
     :server server
     :address address
     :port port))

We will need to edit this and introduce the idea of a lack builder. This is a way of building an application with more capabilities. Instead of simply passing our *app* object to the clackup function, we instead wrap our *app* object in the lack builder function which allows us to plug in middleware.

(clack:clackup
     (lack.builder:builder *app*)
     :server server
     :address address
     :port port)

It may not be immediately obvious, but where previously the first argument to clackup was our *app* object, we instead call lack.builder.builder passing in *app*, it is in this builder call that we will hook in our middleware. Before we can do that however, we must write some middleware!

Above our start function I will write our middleware function:

(defun hit-counter-middleware (app)
  (lambda (env)
    (setf (getf env :hit-counter) (incf *count*))
    (funcall app env)))

This is all it needs, we need to define a function that first accepts a ningle application object, and it returns a function (a lambda in this instance) that accepts the env (the request environment), because there may be a chain of middleware functions that potentially terminate with our controller, the lambda must return the result of calling the next middleware function with the app and environment.

Within the body of the lambda, however, we are free to begin doing whatever we want!

In this example, we only do one thing, we add a new entry into the environment and assign it to be the incremented (incf) value of *count* with this line (setf (getf env :hit-counter) (incf *count*)).

We next must edit the controller to retrieve this stored value and render it into the template (which means we'll also need to edit the template).

Thankfully editing our controller is easy, we need only add a new keyword argument to the render-template* function.

(setf (ningle:route *app* "/")
      (lambda (params)
        (let ((user  (list :username "NMunro"))
              (posts (list (list :author (list :username "Bob")  :content "Experimenting with Dylan" :created-at "2025-01-24 @ 13:34")
                           (list :author (list :username "Jane") :content "Wrote in my diary today" :created-at "2025-01-24 @ 13:23"))))
          (djula:render-template* "index.html" nil :title "Home"
                                                   :user user
                                                   :posts posts
                                                   :hit-counter (getf (lack/request:request-env ningle:*request*) :hit-counter)))))

The only addition is the :hit counter (getf (lack/request:request-env ningle:*request*) :hit-counter) line. This will retrieve the :hit-counter value from the request environment.

In our index.html template, in the div with the class="container", we will add the following:

    <div class="row">
        <div class="col-12">
            <h4>Hits</h4>
            <p>{{ hit-counter }}</p>
        </div>
    </div>

The last thing we must do is return to the lack.builder section of our start function and hook the middleware into the app.

(lack.builder:builder #'hit-counter-middleware *app*)

It must be included before *app* as the hit-counter-middleware will be wrapping our application and run before anything in our app does. As this tutorial (and your own applications) grow, this line and the different middleware modules will change as requirements do.

If you save and load the project, you should see that there is a div in your template that updates a count every time the page is refreshed. At this point you may notice that the counter is incremented by 2 each time, this is not a mistake, this is because your web browser will request the page itself, and a favicon.ico file (and hit the not-found controller).

For clarity here is the edited main.lisp file:

(defpackage ningle-tutorial-project
  (:use :cl)
  (:export #:start
           #:stop))

(in-package ningle-tutorial-project)

(defvar *app* (make-instance 'ningle:app))
(defvar *count* 0)

(setf (ningle:route *app* "/")
      (lambda (params)
        (let ((user  (list :username "NMunro"))
              (posts (list (list :author (list :username "Bob")  :content "Experimenting with Dylan" :created-at "2025-01-24 @ 13:34")
                           (list :author (list :username "Jane") :content "Wrote in my diary today" :created-at "2025-01-24 @ 13:23"))))
          (djula:render-template* "index.html" nil :title "Home"
                                                   :user user
                                                   :posts posts
                                                   :hit-counter (getf (lack/request:request-env ningle:*request*) :hit-counter)))))

(defmethod ningle:not-found ((app ningle:<app>))
    (declare (ignore app))
    (setf (lack.response:response-status ningle:*response*) 404)
    (djula:render-template* "error.html" nil :error "Not Found"))

(defun hit-counter-middleware (app)
  (lambda (env)
    (setf (getf env :hit-counter) (incf *count*))
    (funcall app env)))

(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
    (djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
    (clack:clackup
        (lack.builder:builder #'hit-counter-middleware *app*)
     :server server
     :address address
     :port port))

(defun stop (instance)
    (clack:stop instance))

Understanding how to write custom middleware is very important, and I hope that this has served as a good foundation, however, as mentioned at the beginning of this section we will not be using this piece of custom middleware in our application. You are free to include it if you wish, but it will not feature in the companion code in github.

Aceesslog Middleware

Now that we have discussed what middleware is, work it does, how it works, and how to implement it, we will look at some of the middleware modules included in lack which ningle therefore has access to.

We will start with what is known as accesslog middleware, it's a very simple piece of middleware that just logs requests as they come in.

As we did in the previous section, we must adjust the lack.builder line, however, this time we do not need to write any function, the middleware that comes with lack uses some simplified syntax.

(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
    (djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
    (clack:clackup
        (lack.builder:builder :accesslog *app*)
     :server server
     :address address
     :port port))

If you recompile and run your application, and view the terminal output, you will see information about the incoming requests to the web server.

This is a simple example, but it highlights an important distinction that the bundled lack middleware isn't a reference to a function, it's a keyword, as we will see in the next section, they can be a little more complicated than just a keyword, but this particular piece of middleware, it is just a keyword to turn it on. Other pieces of middleware may be a list that include configuration options, if needed.

Static Files Middleware

What we would like to do, when we write our templates is to be able to tell our template that a file is a static file and must be served from the static location. We will need to use a special djula tag to inform our templates that a file is a static file, which may seem a little counter intuitive, however, if for some reason we need to change where static files are served from (for example we may initially host them locally, but then switch to s3 or cloudflare or something), we'd have to go through all our templates changing the url, whereas using static file middleware, we'd set up a base once, and if we need to change it, we change it in one place and then our templates wouldn't need to change at all.

While this sounds like a lot of work, remarkably, it isn't!

There's only really three steps to setting up static file handling in Ningle!

As we are using djula (and a reminder quicklisp may not yet have the latest version of djula, you may need to use git to clone it into your quicklisp/local-projects), we must configure djula to be aware of where our static files will be mounted. So, just as we added a template directory, we must also add a static directory, in our example this is in the start function:

(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")

This second line is the one we have added, when we use the static tag later on, it will know to use "/public/" as our static path.

NOTE: Be mindful to ensure there's a trailing slash when calling set-static-url!

The second thing we must do is hook into the lack static middleware.

(lack.builder:builder :accesslog
                      (:static
                       :root (asdf:system-relative-pathname :ningle-tutorial-project "src/static/")
                       :path "/public/")
                      *app*)

Mentioned previously, some middleware setup will be lists, in this instance, a list where the first item is a keyword naming the lack middleware module to use (this will be a common pattern with other lack middleware) and then any arguments that the middleware module uses. In this case, we need to define where on our host file system we will be storing our static files, this is the :root argument and we specify that relative to our project, static files will be stored in /src/static and we need to have these mounted on a path which is exactly what the :path argument does, we will hide the physical location of our static files (good security) and state that they're available behind "/public/".

For clarity, this is what the start function should look like:

(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
    (djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
    (djula:set-static-url "/public/")
    (clack:clackup
      (lack.builder:builder :accesslog
                            (:static
                             :root (asdf:system-relative-pathname :ningle-tutorial-project "src/static/")
                             :path "/public/")
                            *app*)
     :server server
     :address address
     :port port))

The final thing we need to do is, in our templates, use the static tag to load a given static file. In the base.html file, you might want to display an image. You can use whatever image you like, but if you want to use the one I've created, you can use this.

You should put this file (or the image of your choice) in the src/static/images/ directory (and create it, if you have not), I have called the image logo.jpg and have stored it in src/static/logo.jpg. This will exposed it as /public/images/logo.jpg and from here we can place these into our templates.

<img src='{% static "images/logo.jpg" %}' alt='Logo'>

If you save, reload, and view this project in your web browser, you should see the image rendered as you might expect. Inspecting the page you will see that the src attribute will be src="/public/images/logo.jpg". The image is being served without writing having to write a controller, and is served from the root you defined.

Tidying Up

Now that we have the ability to serve images, css etc, we might want to take this time to writing some css (although I personally hate writing CSS), and making the site look good. Although it is beyond this tutorial to teach bootstrap or other css frameworks (although I will use bootstrap), I will be using bootstrap to make my site look a little nicer, you can refer to the github code to see exactly what I have done regarding frontend styling.

There is something I will do to help our application look a little better...

I will create a nicer looking error page that will take advantage of our new staticfiles middleware, so the contents of src/templates/error.html will be:

{% extends "base.html" %}

{% block content %}
    <div class="container">
        <div class="row">
            <div class="col-12">
                <h1>{{ error }}</h1>
                <img src="{% static "images/lua.jpg" %}" alt="A picture of a dog looking sad and confused" class="error-404">
            </div>
        </div>
    </div>
{% endcontent %}

I will save this photo to src/static/images/lua.jpg.

And in the main.lisp file, I will modify the not-found method:

(defmethod ningle:not-found ((app ningle:<app>))
    (declare (ignore app))
    (setf (lack.response:response-status ningle:*response*) 404)
    (djula:render-template* "error.html" nil :error "Not Found"))

I have also edited the controller for the index page:

(setf (ningle:route *app* "/")
      (lambda (params)
        (let ((user  (list :username "NMunro"))
              (posts (list (list :author (list :username "Bob")  :content "Experimenting with Dylan" :created-at "2025-01-24 @ 13:34")
                           (list :author (list :username "Jane") :content "Wrote in my diary today" :created-at "2025-01-24 @ 13:23"))))
          (djula:render-template* "index.html" nil :title "Home"
                                                   :user user
                                                   :posts posts))))

In my frontend I have edited the html to include a created-at attribute to the posts and included it as we did before with the post author and content:

<h5 class="card-title">{{ post.author.username }}</h5>
<p class="card-text">{{ post.content }}</p>
<p class="text-muted small">Posted on: {{ post.created-at }}</p>

The exact styling I leave up to you, but I wanted to be clear that there is a small content change to the html.

Conclusion

To recap, after working your way though this tutorial you should be able to:

  • Describe what static files are.
  • Describe what application middleware is.
  • Explain why it is advantagous to handle static files differently.
  • Explain how middleware works.
  • Create and use simple middleware functions.
  • Incorporate lack static middleware into your application.
  • Incorporate djula static tags in your html templates to serve static content.

Github

The link for this tutorial is available here.

Resources

Zach BeaneMaxima in the browser with ECL and wasm

· 56 days ago

Via Raymond Toy on the ecl mailing list, Maxima in the browser.


For older items, see the Planet Lisp Archives.


Last updated: 2025-03-24 07:00