Showing posts with label CLOS. Show all posts
Showing posts with label CLOS. Show all posts

Saturday, September 5, 2026

Githack: A Persistent Object Store for Lisp Based on Git

Git has a built-in persistent store for objects based on Merkle trees. It is tailored to store files and directories, but these are just specializations of trees of blobs. There is no reason it couldn't be used to store Lisp objects.

Githack is a Lisp object store that uses Git as its backend. It is a simple library that provides persistent objects for Lisp and a transactional interface for manipulating them. Simple atomic objects are stored as blobs and composite objects are stored as trees. Standard composite Lisp objects, such as lists, vectors, and hash tables, are supported. Custom composite objects can be created through DEFINE-PERSISTENT-STRUCT or DEFCLASS with a :STANDARD-PERSISTENT-METACLASS.

WITH-REPOSITORY is used to specify which repository to use for storing objects. WITH-TRANSACTION sets up a transaction for manipulating objects and retrieves the root object. You use standard slot accessors to walk the object tree. When you are done, you commit the transaction, and modifications are atomically written to the repository with a new root object being placed in a Git branch.

By placing the database in an orphan Git branch, you can store it right beside your source code without tangling the histories. You can use Git to manage the history of the database, branch it, and share it with others. Githack even stores object docstrings as README.md files inside the repository trees, so the stored objects are natively self-documenting in the Git web UI.

Githack comes with example code and an example database living on its own orphan branch, so if you clone the repository, you'll clone the working example database as well.


Friday, September 4, 2026

Will it DEFMACRO?

Why write boilerplate code when you can ask an LLM can do it for you? But even LLMs will avoid boilerplate if they can. I recently vibe coded a rogue-like game in Common Lisp. While I gave the model specific directions at certain points, I mostly let the model generate the code as it saw fit. I found some interesting suprises in the generated code.

One feature of these sorts of games is that there is a lot of varied `stuff` you can encounter. This keeps the game interesting and maintains the novelty and sense of discovery as it takes a long time for the player to discover everything about the game. While it is fun to think of all of the different things to put in the game, it is a bit tedious to actually implement them all. You want a large variety of things, they should all be different in more than just their description, and the effect of encountering and using an item should be appropriate to the kind of item it is. It would be boring if every food item simply retored 5 health, but much more entertaining if some food restored health, some restored stamina, some made the player stronger, etc., and even better if it were spinach that restored strength, an elixir that restored health, and an energy drink that restored stamina.

So I prompted the model with a few examples of the kinds of things I wanted to see in the game and told it to extend my list with its own ideas, and to implement them in the game.

Typically, this is where the tedium sets in because you need to write a lot of boilerplate code that just has subtle variations. LLMs are good at boilerplate, so I expected to find that. But an experienced Common Lisp programmer would write a macro to generate the boilerplate based on a few customization parameters. I was pleasently surprised to see that the model did exactly this.

(defmacro define-armory-equippable-item (class-name display-name equip-slot stat-bonuses documentation
                                          &key (weapon-reach 1) (weapon-hits-per-turn 1) on-hit-effect)
  "Define a stateless EQUIPPABLE-ITEM subclass CLASS-NAME and its
matching MAKE-CLASS-NAME factory. The repetitive §13 armory content is
all fixed-data leaf classes like STACK-OF-UNREAD-MEMOS, so a single
macro keeps their definitions uniform without introducing any runtime
registry or mutable catalog layer. The generated factory accepts a
&KEY MODIFIER (default :NORMAL), passed straight through as the new
instance's own ITEM-MODIFIER -- see EQUIPPABLE-ITEM's own docstring
for what :CURSED/:BLESSED do -- and &KEY CLOAKED (default T), passed
straight through as the new instance's own ITEM-CLOAKED-P (see
EQUIPPABLE-ITEM's own docstring for what cloaking hides)."
  (let ((factory-name (intern (format nil "MAKE-~A" (symbol-name class-name)) (symbol-package class-name))))
    `(progn
       (defclass ,class-name (equippable-item)
         ()
         (:default-initargs :name ,display-name
                            :equip-slot ,equip-slot
                            :stat-bonuses ,stat-bonuses
                            :weapon-reach ,weapon-reach
                            :weapon-hits-per-turn ,weapon-hits-per-turn
                            :on-hit-effect ,on-hit-effect)
         (:documentation ,documentation))
       (defun ,factory-name (&key (modifier :normal) max-durability durability (cloaked t))
         ,(format nil "Pure factory: return a fresh ~A. MODIFIER (default :NORMAL) is passed
straight through as the new instance's own ITEM-MODIFIER. CLOAKED
(default T) is passed straight through as the new instance's own
ITEM-CLOAKED-P (see EQUIPPABLE-ITEM's own class
docstring). MAX-DURABILITY/DURABILITY (default NIL, meaning \"use
EQUIPPABLE-ITEM's own class default/derive from MAX-DURABILITY\" --
see its class docstring) are only forwarded to MAKE-INSTANCE when
explicitly supplied, so a direct/test call keeps this item's usual
deterministic *RDESCENT-DEFAULT-ITEM-DURABILITY*." display-name)
         (apply #'make-instance ',class-name :modifier modifier :cloaked cloaked
                (append (when max-durability (list :max-durability max-durability))
                        (when durability (list :durability durability))))))))

This macro generates the class definition for the item and a factory function to create instances of the item. The required arguments are common to all equippable items, and the optional arguments are modifiers that are only relevant to certain items. This macro is used to define each item that can be equipped by the player.

(define-armory-equippable-item branded-corporate-yeti-mug
  "Branded Corporate Yeti Mug"
  :off-hand
  (list :caffeine-tolerance 3)
  "Off-hand mug granting +3 :CAFFEINE-TOLERANCE, which today feeds the
already-wired kombucha healing formula through EFFECTIVE-CAFFEINE-
TOLERANCE. Its planned refill/drain-rate behavior is deliberately
deferred because no passive CAFFEINE-TOLERANCE depletion system exists
yet."
  )

(define-armory-equippable-item lanyard-of-the-vip
  "Lanyard of the VIP"
  :head
  (list :seniority 2)
  "Neck-flavored accessory implemented in the shared :HEAD slot, with a
real +2 :SENIORITY bonus feeding deflection/detection formulas. Its
planned \"SecOps Auditor aggro radius to zero\" behavior is deliberately
deferred because that monster/archetype-specific aggro mechanic does
not exist yet."
  )

Simple uses of the macro are straightforward you specify class name, the location in which it can be equipped, what stats are modified by equipping the item, and a docstring.

 (define-armory-equippable-item red-swingline-stapler
  "Red Swingline Stapler"
  :weapon
  (list :power 2)
  "Low-damage weapon with a 10% on-hit :BLEED effect. :BLEED is wired
for real as a small damage-over-time effect via STATUS-EFFECT's own
MAGNITUDE slot; the plan text's additional \"panic the target\" rider
is deliberately deferred because the current AI has no temporary panic
status that can cleanly override disposition/pathing."
  :on-hit-effect (list :kind :bleed :turns *rdescent-bleed-ticks*
                       :magnitude *rdescent-bleed-damage-per-tick* :chance 0.10))

This item has a special effect that is applied when it hits an enemy. The optional argument to the macro allows you to specify the effect. Note that the model understood the semantic context of the weapon (staples puncture, punctures bleed) and it invented the `:bleed` effect on its own and implemented the mechanics of it within the game.

(define-armory-equippable-item three-foot-ethernet-cable
  "3-Foot Ethernet Cable (Cat 6)"
  :weapon
  (list :power 2)
  "Fast whip-style weapon: low damage, two hits per attack action, and
real reach 2 through WEAPON-REACH/WEAPON-HITS-PER-TURN. The plan text's
crowd-control flavor is therefore approximated through the existing
combat scheduler rather than a new knockback or entangling subsystem."
  :weapon-reach 2
  :weapon-hits-per-turn 2)

This weapon uses the optional arguments to specify a longer reach and faster attack speed than standard weapons. Again, note that this is appropriate for the item.

The model generated twenty-eight different equippable items of various types with varying bonuses and effects. This illustrates the model's ability to effectively use macros to reduce the boilerplate code that would otherwise be necessary to implement items. It also illustrates that the model understands both the theme of the game and the nature of the items being implemented.

Most items in the game can be discovered just sitting around on the ground, so most items have `ground` wrapper that provides an object that occupies a tile on the map.

(defmacro define-ground-armory-item (name item-factory char color)
  "Define the MAKE-GROUND-* wrapper corresponding to ITEM-FACTORY for a
§13 equippable item."
  (let* ((item-name (symbol-name item-factory))
         (prefix-length (length "MAKE-"))
         (suffix (subseq item-name prefix-length))
         (ground-name (intern (format nil "MAKE-GROUND-~A" suffix) (symbol-package item-factory))))
    `(defun ,ground-name (x y level)
       ,(format nil "Pure factory: return a fresh GROUND-ITEM wrapping ~A." name)
       (make-ground-equippable-item x y level ,char ,name ,color (,item-factory)))))

(define-ground-armory-item "Red Swingline Stapler" make-red-swingline-stapler #\) "#d08770")
(define-ground-armory-item "3-Foot Ethernet Cable (Cat 6)" make-three-foot-ethernet-cable #\) "#d08770")
(define-ground-armory-item "Lanyard of the VIP" make-lanyard-of-the-vip #\] "#b48ead")
(define-ground-armory-item "Branded Corporate Yeti Mug" make-branded-corporate-yeti-mug
  *rdescent-corporate-trinket-char* "#8fbcbb")

This macro generates the function name for the ground item based on the name of the factory function for the item. So if `make-red-swingline-stapler` is the factory for the stapler, then `make-ground-red-swingline-stapler` is the factory for the ground item that wraps the stapler. The macro also generates a docstring for the function.

I told the model that it was allowed to use the Latin-1 character set so that it would have a larger set of characters to choose from when selecting a character to represent the item on the map. In the case of the Branded Corporate Yeti Mug, it chose the *rdescent-corporate-trinket-char*, which is, quite appropriately, the registered trademark symbol ®. Again this indicates that the model understood the theme of the game.

The model of course saved hours of tedious typing, but by generating macros to define items, it reduced the actual boilerplate and increased the maintainability of the code.


Thursday, September 3, 2026

Recursive Descent: Vibe Coded Rogue-like in Common Lisp

I was talking with Amit Patel of Red Blob Games the other day and he mentioned that he had been participating in a programming endeavor where people were creating variations of rogue-like games based on a tutorial. He had just begun experimenting with vibe coding and figuring out how to do it and what works for him. This sounded like an interesting idea, so I decided to try it out myself. I began with the basic tutorial, but since I'm a Lisp programmer, I decided to vibe code the game in Common Lisp. I had a few goals in mind:

  • I wanted to see if I (actually the LLM) could code up a rogue-like game in the browser
  • I wanted to see what sort of interesting code the LLM would produce: Would it be a good design? Would it use macros? Would it use CLOS? Would it get overly complex and "hit the wall" at some point?
  • How would it handle being told to work with functional programming style given that this sort of game is traditionally written in stateful, object-encapsulated style?

I mostly vibe coded this, but I did step in and make adjustments here and there. For example, I specifically requested that the LLM use a functional programming style, and I asked it to refactor large files into smaller ones.

Beginning

Getting started was tricky. I basically wanted a simple terminal emulator in the browser that would would display a fixed-width grid of characters that the back end could update. I wanted to be able to send keypresses to the back end and have it update the display. I didn't have a clear idea about how to do this, so I experimented a bit and came up with something relatively easy. The front end is a simple HTML page with a <div> is expected to contain the grid of characters. The front-end runs some JavaScript opens a WebSocket connection to the back end and sits in a loop waiting for messages. The back end sends messages to the front end that contain a block of html that the front end just inserts into the <div>. The front end also listens for keypresses and sends them to the back end. I didn't expect that this would be a very efficient way to do it, but I figured that a modern browser and reasonably good internet connection would be able to handle a modest refresh rate.

As coding progressed, the LLM extended the front end to include multiple <div>s, including pop-up modals. The LLM also augmented the front end to reconnect to the back end if the connection was lost, and direct focus to the playing area with the page was displayed. Othewise, the front end is a relatively thin client that mostly displays exactly what the back end sends it.

Real time back end

I started out with the standard rogue-like game loop, which is a synchronous, turn-based loop. The back end would wait for a keypress, then update the game state and send the new display to the front end. This works, but I remembered how the developers of Diablo said that when they decided to make it real-time it completely changed the game. I decided to make the back end real-time, but with a slow enough tick rate that I wasn't overwhelming the connection or the browser. Eventually I decided on a tick rate of 20Hz. Most of the effects in the game are timed around a 0.1 second interval (the rate at which the keyboard repeats when you hold down a key) and 20Hz is the Nyquist frequency to avoid aliasing (which would make the game stutter weirdly if you tried to run by holding down an arrow key). This makes the game feel responsive enough without it needing to refresh at CRT rates. Since the game is based on a grid of ascii characters rather than a bitmap, I guessed that the bandwidth requirements would be modest enough that this would work.

The first few hours vibe coding were spent getting a player character to run around a procedurally generated dungeon. Once I had that working, I asked the LLM to refactor the back end into a functional core with a stateful wrapper. The functional core is a pure function that takes the current game state and a message from the front end (typically a keypress) and returns the new game state. The stateful wrapper manages the WebSocket connection and the game loop. Once the back-end had been refactored into a functional core, the LLM generally continued to keep side effects out of the code, although it did introduce some reasonable side effects to manage a LRU cache of game state in order to save on recalculations.

Every action in the game is modeled as a pure reducer function. `MOVE-PLAYER`, `DRINK-POTION`, `PROCESS-ENEMY-TURNS`, etc. all follow the same signature: they take the current `GAME-STATE` plus some inputs, and return a freshly allocated `GAME-STATE` representing the world one tick later.

To achieve this without writing thousands of lines of boilerplate copy constructors, the engine heavily leverages Common Lisp's Meta-Object Protocol (MOP). The `copy-instance` and `update-entity` helpers dynamically iterate over a class's slots at runtime. When an Orc takes 5 damage, the engine doesn't mutate the Orc; it uses the MOP to spin up a brand new Orc with identical properties, except for a modified HP slot, and substitutes it into the new `GAME-STATE`'s entity list.

Decoupled I/O State

To avoid locking as much as possible, the engine decouples the I/O state from the game state. When the Hunchensocket WebSocket read-thread receives a JSON packet from a client, it does exactly two things: it parses the JSON into an immutable RDESCENT-COMMAND CLOS object (like move-command or drink-command), and it dumps that command into a thread-safe SB-CONCURRENCY:QUEUE. It never touches the game state.

Meanwhile, a single, dedicated game-loop thread acts as the heartbeat. Once every 50ms, the TICK-ALL-CLIENTS function wakes up, drains the input queues for every connected client, and folds those commands over that client's GAME-STATE using the pure ADVANCE-GAME-STATE reducer. This means a player mashing the keyboard at 100 APM can never cause a race condition or force the engine to lock the state tree. The I/O is asynchronous, but the game logic is predictably synchronous.

Because the game runs in real-time, it needs a way to blend the fast-paced player inputs with slower, methodical monster AI. This is handled via an Energy accrual system.

Every tick, every entity (players and monsters alike) accrues `ENERGY` equal to their `SPEED` stat. Actions have flat energy costs. The game loop refuses to process an action for an entity until its energy balance can afford it. This allows the engine to support speed-altering buffs and debuffs simply by tweaking the energy thresholds or accrual rates, without needing a bespoke cooldown-timer subsystem.

Procedural Dungeon Caching

Dungeon generation in `Recursive Descent` is deterministic, seeded by a hash of the dungeon level. This means GENERATE-DUNGEON will always carve the exact same rooms and corridors for Level 5, every time. The engine doesn't need to store the entire dungeon in memory for every player; it can simply regenerate the same layout on demand.

Because the generation is deterministic, and the GAME-MAP geometry (the TILE array) is strictly immutable, the architecture introduces a *DUNGEON-CACHE*. When a player drops down to Level 5, the engine checks the cache. If the geometry is already there, it just hands a pointer to the existing immutable map to the player's GAME-STATE. Multiple players on the same tier and level share the same physical memory space for the dungeon walls and floors, reducing the memory footprint of the server.

Save Games Stored on the Client

Instead of maintaining a massive, clustered database to store player progression, the server is entirely stateless across sessions. When a player hits the Save button, the Lisp server serializes their entire immutable GAME-STATE (including all visited levels, dropped items, and explored fog-of-war bit-vectors) into an association list. It then zlib-compresses it, signs it with an HMAC-SHA256 hash using a server-side secret key, base64 encodes it, and sends it back to the client over the WebSocket.

The client's browser stores the save blob in localStorage. When the player reconnects, they hand the blob back. The server verifies the signature, decompresses it, and resurrects the CLOS objects. Thus we offloaded the database hosting to the user's hard drive.

Client Registry

Tracking connected users in a multithreaded web server usually involves wrapping a global list in a heavy mutex, which creates a bottleneck every time the game loop iterates over it.

To solve this, server.lisp isolates the *RDESCENT-CLIENTS* list inside a dedicated background actor thread (RDESCENT-CLIENTS-REGISTRY-LOOP). No other thread is allowed to touch it. When Hunchensocket receives a new connection or a disconnect, it drops a simple (:CONNECT client) or (:DISCONNECT client) message into the actor's mailbox. When the game loop needs the list of players for the next tick, it sends a (:SNAPSHOT) message and waits for the actor to reply with the current list. This guarantees that the client roster is never mutated out from under an active iteration, cleanly sidestepping deadlocks.

Fat Base Class

Modern game development typically uses Entity-Component-System (ECS) architectures to avoid massive inheritance trees. `Recursive Descent` ignores this trend. The base ENTITY class is deliberately "fat." It holds everything: spatial coordinates (X, Y), rendering data (CHAR, RENDER-ORDER), combat stats (HP, POWER, DEFENSE), inventory, equipment, and all seven RPG Stats (Strength, Dexterity, Charisma, etc.).

In a mutable OOP design, a fat base class is a maintenance nightmare. In a purely functional CLOS architecture, it is an advantage. Because state mutation is handled entirely by a Meta-Object Protocol (MOP) helper (COPY-INSTANCE / UPDATE-ENTITY) that dynamically walks the class slots to clone the object, having a wide, flat property list is functionally cheap. You don't need complex component-querying logic; you just ask the entity for its DOMAIN-KNOWLEDGE and move on.

Interestingly, there is no PLAYER class. The player is simply a baseline ENTITY instance that happens to be bound to the PLAYER slot of the GAME-STATE. It uses the exact same combat resolution, inventory handling, and stat scaling as any monster.

Entity Subclasses

Instead of overriding methods to change behavior, the ENTITY subclasses primarily exist to provide specific :DEFAULT-INITARGS and to act as dispatch targets for generic functions.

  • ENEMY — Adds no new slots. It simply provides an :AFTER initialization method to guarantee an enemy defaults to a :HOSTILE disposition and derives its XP value from its HP.
  • AUTO-PICKUP-ITEM — Represents a scavenger hunt collectible. It defaults IS-ALIVE to NIL and BLOCKS-MOVEMENT to NIL, keeping it out of the AI processing loop and allowing the player to freely walk over it.

Fixture Hierarchy

Fixtures represent stationary, non-hostile map objects (shrines, vendors, NPCs) that the player interacts with via a dedicated command rather than by bumping into them. The base FIXTURE class defaults IS-ALIVE to NIL (excluding it from the enemy AI turn loop) and BLOCKS-MOVEMENT to NIL (allowing the player to stand on it).

The hierarchy branches out based on internal state requirements:

  • SHRINE-FIXTURE — Adds a `USE-COUNT` slot to track finite activations.
  • VENDOR-FIXTURE — Stateless beyond its base properties. Its "stock" is derived globally, and it requires no mutable inventory of its own.
  • NPC-FIXTURE — Likewise stateless. Quest progress is stored in the player's GAME-STATE flags rather than on the NPC, ensuring the NPC remains purely shared, immutable geometry.
  • TRAP-FIXTURE — Adds a HIDDEN-P slot to dictate rendering visibility, flipping to NIL once triggered or spotted.

Command Pattern

RDESCENT-COMMAND input handling relies on a polymorphic Command Pattern. The WebSocket read thread parses raw JSON into a concrete subclass of RDESCENT-COMMAND (MOVE-COMMAND, USE-ITEM-COMMAND, EQUIP-COMMAND, etc.).

Instead of a massive COND statement checking command types, the engine uses CLOS generic functions (EXECUTE-QUEUED-COMMAND). Each command class has a specific method that invokes the appropriate state reducer (e.g., the DRINK-COMMAND method calls DRINK-POTION). This makes extending the engine's vocabulary trivial: adding a new command means defining a tiny data class and writing exactly one generic method for it.

State Containers

GAME-MAP: Holds the TILES array. A TILE contains purely static, shared geometry (walls, floors, room-type tags). Because this never mutates based on player action, a GAME-MAP can be safely memoized and shared across multiple players on the same depth via the *DUNGEON-CACHE*. GAME-STATE: The server-authoritative snapshot for a specific player. It holds the PLAYER entity, the list of other ENTITIES on the floor, the field-of-view EXPLORED bit-vector, and the LEVELS FSET map (which archives DUNGEON-LEVEL-SNAPSHOTs of previously visited floors).

The Imperative Shell: RDESCENT-CLIENT Sitting at the very top of the stack is RDESCENT-CLIENT, a subclass of Hunchensocket's WEBSOCKET-CLIENT. This is the only place where mutability is permitted. It acts as the anchor, holding the connection's thread-safe INPUT-QUEUE for incoming commands, and the mutable pointer to the current immutable GAME-STATE. This is where the game state is updated with the new game state.

Conclusion

The LLM did a good job of vibe coding a rogue-like game in the browser. At one point I simply sat down and brainstormed a list of features that I wanted to add to the game. Then I told the LLM to design an architecture that would be amenable to adding those features. Then I told the LLM to implement the architecture. When it was done, I told the LLM to prioritize the features I wanted to add suggest an implementation order. Then I told the LLM to implement each feature in turn.

At a couple of points, the LLM was letting a monolithic file get out of hand, so I explicitly told it to refactor the code into smaller files I also made an explicit pass to make sure that the compile was giving no warnings. The LLM had a tendency to use large etypecase statements to dispatch on the type of an object. I explicitly told it to use CLOS generic functions instead, and it did so. OTher than that, I basically left the LLM to generate code how it saw fit.

If you want to try out the game, you can run it in your browser at https://jrm-code-project.com/rdescent.html. If you just want to peruse the source code, you can find it at https://github.com/jrm-code-project/jrm-code-public/tree/main/rdescent, but try the game before you look at the code because the code contains spoilers. No guarantees it will work on your browser. Mine has a fairly big display and a reasonably high bandwidth connection, but I don't know about yours. No way this would work on a phone.


Sunday, June 28, 2026

New chatbot

Lately I've been playing with writing a chatbot library in Common Lisp.

My previous gemini bindings were getting unweildy. I wanted to add the ability to run LLMs on my local machine but it turned out to be really kind of kludgy, so I decided to start from scratch with multiple back ends in mind.

I've got it to the point where in supports multiple back ends, so now I can prompt local LLMs from Lisp.

Recently I added the ability to recursively launch chatbots that can call each other. Since the chatbots do not share their contexts, this greatly reduces the context bloat of thet main chat because it can spawn off subtasks to a minion and not pollute the main context. This also allows you to create a federation of chatbots, each of which specializes in some topic and is overseen by a controlling chatbot that talks to the user.

Chatbots can be serialized and checkpointed, so if one is carrying out an agentic task and Lisp crashes, when we restart the agentic tasks are restarted as well and pick up where they left off.

IT turns out that recursive chats are a useful abstraction once you figure out how to use them. Basically any prompt you may issue may also want to be issued by an llm and this enables that to happen. It allows you to run subprocesses that would otherwise put junk in your context, for example reading the contents of a lange number of files. If you put that into a rocursive chatbot, it could slurp up the files into its context without adding tokens to the parent chat.

You can use a recursive chat as a `smart component'. The recursive chat can have a specialized system instruction and can preload its context with relevant information specific to it. It's context doesn't get diluted by the caller's context


Thursday, June 25, 2026

Anecdote or data point

I saw that there was some argument over how much slower slot access is than struct access, so I just decided to measure it naively. I made a two slot sruct and a CLOS version of a CONS cell with car and cdr slots and I ran LTAK using regular lists, `lists' made from CLOS conses, and `lists' made from structs. Here are the results:

D:\repositories\clos-benchmark>sbcl --script run-benchmarks.lisp
Benchmark: ltak over native cons cells, CLOS my-cons nodes, and my-cons-struct nodes
Inputs: x=15 y=9 z=4 repeats=35

Scenario                   min-ms     mean-ms      max-ms      ratio
--------------------------------------------------------------------
native standard               0.129      0.146      0.186
clos standard                 1.346      1.365      1.475       9.37x
struct standard               0.172      0.175      0.179       1.20x
native optimized              0.068      0.069      0.073
clos optimized                0.411      0.414      0.419       6.04x
struct optimized              0.068      0.069      0.073       1.01x

In this naive use case, structs are same as native cons cells, but CLOS objects are one ninth the speed of a struct or cons cell if you just use it unoptimized, and one sixth the speed if optimizations are turned on.

But the CLOS instance is more functional than the cons cell in mimics. For instance, I could add a slot to the class and all the instances would be lazily updated with the new slot. I can also subclass the CLOS class and the selector functions will continue to work. Finally, I can redefine the CLOS closs while I'm developing it and all the instances will be uppdated. THe machinery to keep all this running is costing us our factor of 9.

But this might be worth the cost if we are running on a network where the bulk of the time will be transmitting the answer down the pipe once it is computed. Taking a few extra milliseconds to compute the answer might be worth the convenience features of CLOS.


Sunday, May 31, 2026

CLRHack: Meta-object Protocol

Metaobject Protocol (MOP) Implementation in CLRHack

The Metaobject Protocol in CLRHack is a high-performance implementation of the Common Lisp Object System (CLOS) integrated into the .NET 8.0 Common Language Runtime (CLR). It provides a complete meta-compilation pipeline that bridges the gap between dynamic Lisp semantics and the static CIL (Common Intermediate Language) execution model.

Core Architecture

The MOP is implemented through three primary layers:

  1. The Metaobject Hierarchy (C#): A set of foundational classes in LispBase representing classes, methods, generic functions, and slot definitions.
  2. The Runtime Engine (MopRuntime): A centralized orchestrator that manages class finalization, method combination, dispatch caching, and instance allocation.
  3. The Compiler Bridge (Lisp): Transformations in ast.lisp that translate high-level CLOS forms (defclass, defmethod) into optimized runtime calls.

Instance Representation

Because the CLR type system is strictly single-inheritance and statically defined, CLRHack decouples Lisp-level inheritance from C# inheritance. All CLOS instances are represented by the StandardObjectInstance class, which contains:

  • A reference to its ClassMetaobject.
  • A private object[] storage array for instance slots, indexed by locations calculated during class finalization.

The Dispatch Pipeline

Generic function invocation is the most complex part of the implementation. When a generic function is called:

  1. Cache Lookup: The DiscriminatingFunction first checks a thread-safe dispatchCache using an InvocationCacheKey (a stack-allocated struct) to find a previously computed effective method.
  2. Applicability & Precedence: If the cache misses, the runtime computes all applicable methods and sorts them based on specializer specificity and the Class Precedence List (CPL).
  3. Method Combination: The ComputeEffectiveMethod logic builds a nested execution chain following the Standard Method Combination rules:
    • :around methods are called first, with call-next-method progressing to the next around method or the main chain.
    • The main chain executes all :before methods, the primary method, and finally all :after methods in reverse order.
  4. Fast Invocation: The resulting effective method is compiled into a Func<object[], object> that uses direct delegate invocation to minimize overhead.

Challenges and Solutions

1. Thread-Safe Non-Local Exits (call-next-method)

Challenge: call-next-method and next-method-p require access to the current invocation's state (the remaining methods and original arguments). Passing this state through every function call would break compatibility with standard Lisp function signatures.

Solution: CLRHack utilizes [ThreadStatic] fields in MopRuntime to store the currentNextMethods and currentArguments. This ensures that even in highly concurrent environments (like a web server), each OS thread has its own isolated invocation context, allowing call-next-method to function correctly without state leakage.

2. Forward References and Lazy Finalization

Challenge: Lisp allows classes to refer to superclasses that haven't been defined yet. The runtime must handle these "zombie" classes without crashing the JIT compiler.

Solution: The system implements a ForwardReferencedClassMetaobject. When a class is defined, it is automatically finalized (computing its CPL and slot layout). If a superclass is missing, a forward reference is created. The EnsureFinalized protocol ensures that inheritance is resolved and slot locations are assigned the moment the class is first instantiated or used in dispatch.

3. Performance Overhead of the "MOP Bridge"

Challenge: A naive implementation of slot-value or generic dispatch using C# reflection or linear searches is orders of magnitude slower than native C# member access.

Solution: Three distinct optimizations were applied:

  • O(1) Slot Access: Each ClassMetaobject maintains a SlotDictionary. Slot names are mapped to physical array indices during finalization, allowing slot-value to perform a direct array access after a single dictionary lookup.
  • Compiler Primitives: The compiler identifies SLOT-VALUE and MAKE-INSTANCE calls and emits direct CIL call instructions to optimized Lisp.MopRuntime methods, bypassing the general Funcall path.
  • Zero-Allocation Cache Hits: By making InvocationCacheKey a readonly struct and avoiding the cloning of the argument array during cache probes, the hot-path for generic function dispatch generates zero garbage for the .NET Collector.

4. Bootstrapping the COMMON-LISP Package

Challenge: Core CLOS functions like make-instance must be available as symbols in the COMMON-LISP package before user code runs, but they rely on the MOP runtime being fully initialized.

Solution: A MopRuntime.Initialize() method is injected into the entry point (Main) of every generated assembly. This method interns the necessary symbols and binds them to GenericFunctionClosureAdapter objects, ensuring that the MOP is "alive" before the first line of Lisp code executes.


Vibe coding the MOP basically involved feeding chapters 4 and 5 of the Art of the Meta-Object Protocol into the LLM and telling it to make an implementation plan. It came up with a twenty-step plan to bootstrap CLOS. I then spent the rest of the day instructing an agent to take on each task of the twenty-step plan in sequential order. At the end of the day, I had a working MOP

This is the end of my series of posts on CLRHack.


Monday, March 31, 2025

Avoiding Stringly Typed Code

It can be tempting to implement certain objects by their printed representation. This is especially true when you call out to other programs and pass the parameters in command line arguments and get a result back through the stdout stream. If an object is implemented by its printed representation, then serialization and deserialization of the object across program boundaries is trivial.

Objects implemented by their printed representation are jokingly referred to as “stringly typed”. The type information is lost so it is possible to pass strings representing objects of the wrong type and get nonsense answers. There are no useful predicates on arbitrary strings, so you cannot do type checking or type dispatch. This becomes a big problem for objects created from other utilities. When you call out to a bash script, you usually get the response as stream or string.

The solution? Slap a type on it right away. For any kind of string we get back from another program, we at least define a CLOS class with a single slot that holds a string. I define two Lisp bindings for any program implemented by a shell script. The one with a % prefix is the program that takes and returns strings. Without the % it takes and returns Lisp objects that are marshaled to and from strings before the % version is called. The % version obviously cannot do type checking, but the non-% entry point can and does enforce the runtime type.


Friday, March 21, 2025

CLOS vs. message passing

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.


Friday, March 14, 2025

Defclass vs. defstruct

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.


Wednesday, March 12, 2025

with-slots vs. with-accessors

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.


Monday, March 10, 2025

Advanced CLOS — update-instance-for-changed-class

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,


Saturday, May 25, 2024

ECS in CLOS

Object systems make a natural fit for the game programming domain, but over time people have found that the object-oriented model provided by their favorite language doesn't always fit the use case. So developers have come up with “entity-component systems” (ECS) of varying complexity to fill the gap.

The basic idea is that a game object, called an “entity”, contains or refers to a set of “components” that define its behavior. Entities are too varied to be captured by a single class hierarchy, so we abandon inheritance in favor of composition. An entity that can be displayed on the screen has a “sprite” component, an entity that can move has “position” and “velocity” components, an entity that you can attack has a “hitbox” component and a “health” component. A entity that can attack you has an “attackbox” component. You can play mix and match the components to customize the behavior of the entity. We don't have a hierachy of components because each component can be added more or less independently of the others.

An ECS is an alternative or an augmentation to the built-in object system of a language, but it is an admission that the built-in object is insufficient.

CLOS provides an elegent way to implement an ECS without abandoning CLOS's built-in object system. We define a component as a “mixin” class that can be inherited from using multiple inheritance. We define mixin classes for each component, and then we define entity classes that inherit from the mixin classes. We would define a “sprite” mixin class, a “position” mixin class, etc. So the class of enemy entities would inherit from “sprite”, “position”, “velocity”, “hitbox”, “health”, and “attackbox” classes. A trap entity would inherit from “sprite”, “position”, and “attackbox” classes. A container entity that you could smash open would inherit from “sprite”, “position”, and “hitbox” classes. Etc.

Mixin classes aren't intended to be instantiated on their own, but instead provide slots to the classes that inherits from them. Furthermore, methods can be specialized on mixin classes so that instances derived from the mixin will respond to the method. This allows you to inherit from a mixin providing the particular desired behavior. For example, the “health” mixin class would provide a slot containing the entity's health and a “damage” method to decrease the health. Any entity inheriting from the “health” mixin will react to the damage method. Mixin classes can provide functionality similar to interfaces.

Mixin classes are an exception to Liskov's Substitution Principle, but they are a useful exception. Entities that inherit from a mixin do not have a “is-a” relationship with the mixin, but rather a “has-behavior-of” relationship. An entity inheriting from the “health” mixin is not a “health”, but it has the “health” behavior.

One feature of an ECS is that you can dynamically change the components of an object. For example, once an enemy is defeated, you can remove the “health” and “attackbox” components and add a “corpse” component. Is CLOS you could accomplish this by changing the class of the entity object to a class that doesn't have those mixins.

Of course care must be taken or you will end up with CLOS “soup”. But if you are careful, CLOS can provide a powerful and flexible system for implementing an ECS.


Monday, May 6, 2024

Motion without Integration

A game where things move around has equations of motion that describe how objects move. We need to solve these to produce the locations of the objects as a function of time, and we have to do it in lock step real time. Fortunately, we usually don’t need highly realistic models or highly accurate results. Game phyiscs, while inspired by real world physics, can be crude approximations.

If the velocity of an object changes over time, we need to integrate the velocity to determine the position. This is typically done with forward Euler integration: the current velocity is multiplied by a small Δt and this is added to the current position. In other words, we assume the object moves linearly over the amount of time represented by Δt. If Δt is small enough, the linear segments of motion will approximate the actual curve of motion.

In a game, we use the game loop, which runs every few milliseconds, as our source of time. We subtract the current time from the previous time the game loop was run to obtain our Δt. We update each object’s state using forward Euler integration over Δt.

Our game loop keeps track of the last time it was run and subtracts that from the current time. It runs entity-step! on each entity in the game, passing in dticks.

(let ((start-tick (sdl2:get-ticks)))
  (let ((last-tick start-tick))
    (loop
      (let* ((tick (- (sdl2:get-ticks) start-tick))
             (dticks (- tick last-tick)))
        (map nil (lambda (entity)
                   (entity-step! entity dticks))
                 entities)
        (setq last-tick tick)))))

entity-step! performs our forward Euler integration:

(defun entity-step! (entity dticks)
  (incf (position entity) (* (velocity entity) dticks)))

Assuming the game loop runs reasonably frequently, the position of the entity will be a reasonable approximation of the integral of the velocity. If the game loop gets delayed for some reason, e.g. garbage collection, the corresponding increase in the value of dticks will make up for it.

But sometimes we have the fortune of having a closed form solution to the time integral. If this is the case, we can compute the entity’s state directly and we don’t need to integrate the state changes on every iteration of the game loop. Let me give two examples.

In the platformer game, there are potions that the player can take to restore his health. A potion appears as a vial that floats above the ground. A “bobbing” effect is achieved by changing the height above the ground in a time varying manner. Now we could implement this by having the game loop modify the y position of the potion on each iteration, but there is a closed form solution. We can compute the y position at any time by adding a constant base y position to a factor of the sine of the current time. This is easily done by specializing the get-y method on potions:

;;; Make potions bob up and down.
(defmethod get-y ((object potion))
  (+ (call-next-method)
     (* 5 (sin (* 2 pi (/ (sdl2:get-ticks) 1000))))))

call-next-method invokes the next most specific method — in this case, the get-y method of the entity class, which returns the base y position. We add a sine wave based on the current time.

This is only thing we need to modify to make a potion bob up and down. Values dependent on the y position, such as the attackbox, will bob up and down with the potion because it uses the get-y method to determine what the potion is.

A second example is cannonball motion. Cannonballs travel linearly away from the cannon at a constant velocity. Rather than stepping the cannonball by adding its velocity to its position on each update, we specialize the get-x method on cannonballs

(defmethod get-x ((cannonball cannonball))
  (+ (call-next-method)
     (* (get-speed cannonball)
        (- (sdl2:get-ticks) (get-start-tick cannonball)))))

If we specialize both the get-x and get-y methods we can easily get objects to trace out any desired parametric curve, like a Lissajous figure.


Thursday, April 25, 2024

State Machines

One of the things you do when writing a game is to write little state machines for objects that have non-trivial behaviors. A game loop runs frequently (dozens to hundreds of times a second) and iterates over all the state machines and advances each of them by one state. The state machines will appear to run in parallel with each other. However, there is no guarantee of what order the state machines are advanced, so care must be taken if a machine reads or modifies another machine’s state.

CLOS provides a particularly elegant way to code up a state machine. The generic function step! takes a state machine and its current state as arguments. We represent the state as a keyword. An eql specialized method for each state is written.

(defclass my-state-machine ()
  ((state :initarg :initial-state :accessor state)))

(defgeneric step! (state-machine state))

(defmethod step! ((machine my-state-machine) (state (eql :idle)))  
  (when (key-pressed?)
    (setf (state machine) :keydown)))

(defmethod step! ((machine my-state-machine) (state (eql :keydown)))
  (unless (key-pressed?)
    (setf (state machine) :idle)))

The state variables of the state machine would be held in other slots in the CLOS instance.

One advantage we find here is that we can write an :after method on (setf state) that is eql specialized on the new state. For instance, in a game the :after method could start a new animation for an object.

(defmethod (setf state) :after ((new-state (eql :idle)) (machine my-state-machine))
  (begin-idle-animation! my-state-machine))

Now the code that does the state transition no longer has to worry about managing the animations as well. They’ll be taken care of when we assign the new state.

Because we’re using CLOS dispatch, the state can be a class instance instead of a keyword. This allows us to create parameterized states. For example, we could have a delay-until state that contained a timestamp. The step! method would compare the current time to the timestamp and go to the next state only if the time has expired.

(defclass delay-until ()
  ((timestamp :initarg :timestamp :reader timestamp)))

(defmethod step! ((machine my-state-machine) (state delay-until))
  (when (> (get-universal-time) (timestamp state))
    (setf (state machine) :active)))

Variations

Each step! method will typically have some sort of conditional followed by an assignment of the state slot. Rather that having our state methods work by side effect, we could make them purely functional by having them return the next state of the machine. The game loop would perform the assignment:

(defun game-loop (game)
  (loop
    (dolist (machine (all-state-machines game))
      (setf (state machine) (step machine (state machine))))))

(defmethod step ((machine my-state-machine) (state (eql :idle)))  
  (if (key-pressed?)
      :keydown
      :idle))

I suppose you could have state machines that inherit from other state machines and override some of the state transition methods from the superclass, but I would avoid writing such CLOS spaghetti. For any object you’ll usually want exactly one state transition method per state. With one state transition method per state, we could dispense with the keyword and use the state transition function itself to represent the state.

(defun game-loop (game)
  (loop
    (dolist (machine (all-state-machines game))
      (setf (state machine) (funcall (state machine) machine)))))

(defun my-machine/state-idle (machine)
  (if (key-pressed?)
      (progn
         (incf (kestroke-count machine))
         #'my-machine/state-keydown)
      #'my-machine/state-idle))

(defun my-machine/state-keydown (machine)
  (if (key-pressed?)
      #'my-machine/state-keydown
      #'my-machine/state-idle))

The disadvantage of this doing it this way is that states are no longer keywords. They don’t print nicely or compare easily. An advantage of doing it this way is that we no longer have to do a CLOS generic function dispatch on each state transition. We directly call the state transition function.

The game-loop function can be seen as a multiplexed trampoline. It sits in a loop and calls what was returned from last time around the loop. The state transition function, by returning the next state transition function, is instructing the trampoline to make the call. Essentially, each state transition function is tail calling the next state via this trampoline.

State machines without side effects

The state transition function can be a pure function, but we can remove the side effect in game-loop as well.

We keep parallel lists of machines and their states (represented as state transition functions).

(defun game-loop (machines states)
  (game-loop machines (map 'list #'funcall states machines)))

Now we have state machines and a driver loop that are pure functional.


Monday, April 1, 2024

You May Not Need That :around Method

I’ve seen this “anti-pattern” a few times in CLOS code. A superclass ’super will have a subclass ’sub and there will be a primary method specialized to the superclass.

(defmethod foo ((instance super) arg)
  (format t "~&Foo called on ~s." arg))

Then I’ll see an :around method defined on the subclass:

(defmethod foo :around ((instance sub) arg)
  (format t "~&Start foo...~%")
  (call-next-method)
  (format t "~&End foo.~%"))
The intent here is clearly that code in the method specialized on the subclass is invoked “around” the call to the method specialized on the superclass.

But the :around qualifier is not necessary and probably doesn’t do what is intended. If we remove the :around qualifier, then the most specific primary method will be the foo method specialized on ’sub. And the (call-next-method) invokation will chain up to the foo method specialized on ’super. It will work as was likely intended.

:around methods are useful when the superclass wants to run a method “around” the subclass. :around methods are combined from least specific to most specific — the opposite order of primary methods — so that the superclass can wrap the call to the subclass. An good example of where an :around method would be handy is when you need to sieze a lock around the call to the method. The superclass would sieze the lock in an :around method that would run before any of the subclass primary methods ran.

Ordinary chaining of methods doesn’t need the :around qualifier. Just chain the methods.


Tuesday, March 19, 2024

Porting a Game from Java

I decided to learn about games, so I followed along with a tutorial by Kaarin Gaming. His tutorial was written in Java, but of course I used Common Lisp. I made no attempt to faithfully replicate his design, but I followed it closely in some places, less so in others. The resulting program was more or less a port of the Java program to Common Lisp, so it not very remarkable in and of itself. Certainly I don’t expect many people to be interested in reading beyond this point.

It’s known that Java is wordy language and it shows in the end result. The tutorial had 3712 lines of Java code in 39 files and the equivalent Common Lisp was 2255 lines in 21 files. A typical Common Lisp file would contain more code than a typical Java file. It was often the case that a Common Lisp file would contain multiple classes.

Both versions used separate render and game mechanics threads. The render thread ran at about 60 frames per second where the game mechanics ran at 200 steps per second. The threads were mostly independent, but the game mechanics would occasionally have to query the render thread to find out whether an animation had completed or what frame the animation was on in order to synchronize attacks with reactions.

There were a couple of notable differences in the two implementations. The Java implementation would advance animation frames imperatively by incrementing the animation frame counter every few rendering cycles. The Common Lisp implementation would instead compute the animation frame functionally by subtracting the current time from the animation start time and dividing by the ticks per animation frame. In Common Lisp, different animation effects could be achieved by changing how the animation frame was computed. If you computed the frame number modulo the number of frames in the animation, you’d get an animation loop. If you clamped the frame number, you get a one-shot animation.

CLOS made some things easier. An :after method on the (setf get-state) of an entity would set the animation. The get-y method on some objects would (call-next-method) to get the actual y position and then add a time varying offset to make the object “float” in mid air. The get-x method on projectiles would would (call-next-method) to get the starting x position and then add a factor of the current ticks. This causes projectiles to travel uniformly horizontally across the screen. I often used the ability of CLOS to specialize on some argument other than the first one just to make the methods more readable.

The Common Lisp code is at http://github.com/jrm-code-project/Platformer, while the Java code is at https://github.com/KaarinGaming/PlatformerTutorial. Being a simple port of the Java code, the Common Lisp code is not exemplary, and since I didn’t know what I was doing, it is kludgy in places. The Common Lisp code would be improved by a rewrite, but I’m not going to. I was unable to find a sound library for Common Lisp that could play .wav files without a noticable delay, so adding sound effects to the game is sort of a non-starter. I think I’ve gotten what I can out of this exercise, so I’ll likely abandon it now.


Thursday, January 25, 2024

Roll Your Own Linear Fractional Transformations

Looking for a fun weekend project? Allow me to suggest linear fractional transformations.

A linear fractional transformation (LFT), also known as a Möbius transformation or a homographic function, is a function of the form

(lambda (x)
  (/ (+ (* A x) B)
     (+ (* C x) D)))
You could just close over the coefficients,
(defun make-lft (A B C D)
  (lambda (x)
    (/ (+ (* A x) B)
       (+ (* C x) D))))
but you’ll want access to A, B, C, and D. If you implement LFTs as funcallable CLOS instances, you can read out the coefficients from slot values.

Constructor

The coefficients A, B, C, and D could in theory be any complex number, but we can restrict them to being integers and retain a lot of the functionality. If we multiply all the coefficients by the same factor, it doesn't change the output of the LFT. If you have a rational coefficient instead of an integer, you can multiply all the coefficients by the denominator of the rational. If there is a common divisor among the coefficients, you can divide it out to reduce to lowest form. (In practice, the common divisor will likely be 2 if anything, so if the coefficients are all even, divide them all by 2.) We can also canonicalize the sign of the coefficients by multiplying all the coefficients by -1 if necessary.

(defun canonicalize-lft-coefficients (a b
                                      c d receiver)
  (cond ((or (minusp c)
             (and (zerop c)
                  (minusp d)))
         ;; canonicalize sign
         (canonicalize-lft-coefficients (- a) (- b)
                                        (- c) (- d) receiver))
        ((and (evenp a)
              (evenp b)
              (evenp c)
              (evenp d))
         ;; reduce if possible
         (canonicalize-lft-coefficients (/ a 2) (/ b 2)
                                        (/ c 2) (/ d 2) receiver))
        (t (funcall receiver
                    a b
                    c d))))
  
(defun %make-lft (a b c d)
  ;; Constructor used when we know A, B, C, and D are integers.
  (canonicalize-lft-coefficients
   a b
   c d
   (lambda (a* b*
            c* d*)
     (make-instance 'lft
                    :a a* :b b*
                    :c c* :d d*))))

(defun make-lft (a b c d)
  (etypecase a
    (float (make-lft (rational a) b c d))
    (integer
     (etypecase b
       (float (make-lft a (rational b) c d))
       (integer
        (etypecase c
          (float (make-lft a b (rational c) d))
          (integer
           (etypecase d
             (float (make-lft a b c (rational d)))
             (integer (%make-lft a b
                                 c d))
             (rational (make-lft (* a (denominator d)) (* b (denominator d))
                                 (* c (denominator d)) (numerator d)))))
          (rational (make-lft (* a (denominator c)) (* b (denominator c))
                              (numerator c)         (* d (denominator c))))))
       (rational (make-lft (* a (denominator b)) (numerator b)
                           (* c (denominator b)) (* d (denominator b))))))
    (rational (make-lft (numerator a)         (* b (denominator a))
                        (* c (denominator a)) (* d (denominator a))))))

Printer

One advantage of making LFTs be funcallable CLOS objects is that you can define a print-object method on them. For my LFTs, I defined print-object to print the LFT in algabraic form. This will take a couple of hours to write because of all the edge cases, but it enhances the use of LFTs.

> (make-lft 3 2 4 -3)
#<LFT (3x + 2)/(4x - 3)>

Cases where some of the coefficients are 1 or 0.

> (make-lft 1 0 3 -2)
#<LFT x/(3x - 2)>

> (make-lft 2 7 0 1)
#<LFT 2x + 7>

> (make-lft 3 1 1 0)
#<LFT 3 + 1/x>

Application

The most mundane way to use a LFT is to apply it to a number.

> (defvar *my-lft* (make-lft 3 2 4 3))
*MY-LFT*
    
> (funcall *my-lft* 1/5)
13/19

Dividing by zero

In general, LFTs approach the limit A/C as the input x grows without bound. We can make our funcallable CLOS instance behave this way when called on the special symbol ’infinity.

> (funcall *my-lft* ’infinity)
3/4

In general, LFTs have a pole when the value of x is -D/C, which makes the denominator of the LFT zero. Rather than throwing an error, we’ll make the LFT return ’infinity

> (funcall *my-lft* -3/4))
INFINITY

Inverse LFTs

Another advantage of using a funcallable CLOS instance is that we can find the inverse of a LFT. You can compute the inverse of a LFT by swapping A and D and toggling the signs of B and C.

(defun inverse-lft (lft)
  (make-lft (slot-value lft ’d)
            (- (slot-value lft ’b))
            (- (slot-value lft ’c))
            (slot-value lft ’a)))

Composing LFTs

LFTs are closed under functional composition — if you pipe the output of one LFT into the input of another, the composite function is equivalent to another LFT. The coefficients of the composite LFT are the matrix multiply of the coefficients of the separate terms.

> (compose (make-lft 2 3 5 7) (make-lft 11 13 17 19))
#<LFT (73x + 83)/(174x + 198)>

Using LFTs as linear functions

A LFT can obviously be used as the simple linear function it is. For instance, the “multiply by 3” function is (make-lft 3 0 0 1) and the “subtract 7” function is (make-lft 1 -7 0 1). (make-lft 0 1 1 0) takes the reciprocal of its argument, and (make-lft 1 0 0 1) is just the identity function.

Using LFTs as ranges

LFTs are monotonic except for the pole. If the pole of the LFT is non-positive, and the input is non-negative, then the output of the LFT is somewhere in the range [A/C, B/D]. We can use those LFTs with a non-positive pole to represent ranges of rational numbers. The limits of the range are the LFT evaluated at zero and ’infinity.

We can apply simple linear functions to ranges by composing the LFT that represents the linear function with the LFT that represents the range. The output will be a LFT that represents the modified range. For example, the LFT (make-lft 3 2 4 3) represents the range [2/3, 3/4]. We add 7 to this range by composing the LFT (make-lft 1 7 0 1).

> (compose (make-lft 1 7 0 1) (make-lft 3 2 4 3))
#<LFT (31x + 23)/(4x + 3)>

Application (redux)

It makes sense to define what it means to funcall a LFT on another LFT as being the composition of the LFTs.

> (defvar *add-seven* (make-lft 1 7 0 1))
*ADD-SEVEN*

> (funcall *add-seven* 4)
11

> (funcall *add-seven* (make-lft 4 13 1 2))
#<LFT (11x + 27)/(x + 2)>

> (funcall * ’infinity)
11

Conclusion

This should be enough information for you to implement LFTs in a couple of hours. If you don’t want to implement them yourself, just crib my code from https://github.com/jrm-code-project/homographic/blob/main/lisp/lft.lisp


Wednesday, August 17, 2022

Playing with graphics

I wanted to play with some graphics. I don't know much about graphics, so I wanted to start with the basics. I played around with a couple of demos and I found that easiest to get reliably working was SDL2.

After downloading the SDL binary library and installing the FFI bindings with Quicklisp, I was off and running. You can find numerous SDL demos and tutorials on line and I tried a number of them. After I felt confident I decided to try something simple.

One thing I've noticed about graphics programs is the ubiquity of mutable state. Everything seems mutable and is freely modified and global variables abound. As a mostly functional programmer, I am alarmed by this. I wanted to see where we'd get if we tried to be more functional in our approach and avoid mutable data structures where practical.

Now the pixels on the screen had best be mutable, and I'm not trying to put a functional abstraction over the drawing primitives. We'll encapsulate the rest of the state in a state machine that is driven by the SDL event loop. The state machine will keep track of time and the current world. The current world is simply an immutable list of immutable objects. The state machine can transition through a render! phase, where it renders all the objects in the current world to a fresh frame. It attempts to do this about 75 times a second. The state machine can also transition through a next-world phase, where the current world and a delta-t are used to compute a new version of the world.

Our run program will take the initial list of objects. We'll start by initializing SDL, creating a window, and allocating a renderer for that window:

(defun run (initial-world)
  (sdl2:with-init (:video)
    (sdl2:with-window (window
                       :h +window-height+
                       :w +window-width+
                       :flags '(:shown))
      (sdl2:with-renderer (renderer window :index -1 :flags '())
        ... )))

Now we need the event loop state. last-ticks records the value from sdl2:get-ticks from the last time we processed the :idle event. This will be used to compute the elapsed time in ticks. render-ticker will record how many ticks have elapsed since the last time we rendered a frame to the screen. When render-ticker exceeds a certain amount, we'll call (render! current-world) and reset the ticker to zero. title-ticker will record how many ticks have occurred since the last time the window title was updated. When title-ticker exceeds a certain amount, we'll call sdl2:set-window-title to update the window title with some stats. sim-count is simply the number of times we've iterated next-world and frame-count is the number of times we've called render!. These are reset to zero every time we refresh the window title, so we'll have the frames per second and the world steps per second in the window title.

        (let ((last-ticks 0)
              (render-ticker 0)
              (title-ticker 0)
              (sim-count 0)
              (frame-count 0)
              (world initial-world))

          (flet ((title-tick! (dticks)
                   (incf title-ticker dticks)
                   (when (>= title-ticker 1000)
                     (decf title-ticker 1000)
                     (sdl2:set-window-title window (format nil "Sim rate: ~d, Frame rate: ~d" sim-count frame-count))
                     (setq sim-count 0)
                     (setq frame-count 0)))

                 (world-tick! (dticks)
                   (incf sim-count)
                   (setq world (next-world world (/ dticks 1000))))

                 (render-tick! (dticks)
                   (incf render-ticker dticks)
                   (when (>= render-ticker 13)
                     (incf frame-count)
                     (decf render-ticker 13)
                     (render-world! renderer world))))

Now we can run the event loop. The idle event is where the action happens:

          (sdl2:with-event-loop (:method :poll)

              (:idle ()
                     (let ((this-ticks (sdl2:get-ticks)))
                       (if (= this-ticks last-ticks)
                           (sdl2:delay 1)
                           (let ((dticks (- this-ticks last-ticks)))
                             (setq last-ticks this-ticks)
                             (title-tick! dticks)
                             (world-tick! dticks)
                             (render-tick! dticks)))))

              (:keydown (:keysym keysym)
                        (case (sdl2:scancode keysym)
                          (:scancode-escape (sdl2:push-quit-event))
                          (:scancode-x      (sdl2:push-quit-event))))

              (:quit () t))

Now that's a bunch of state, but it's more or less under control because what we have is a state machine and the state variables aren't accessible to anything.

render-world! is straightforward. It clears the renderer, calls render! on every object in the world, and presents the renderer for display.

(defun render-world! (renderer world)
  (sdl2:set-render-draw-color renderer #x00 #x00 #x00 #xFF)
  (sdl2:render-clear renderer)
  (mapc (lambda (object) (render! renderer object)) world)
  (sdl2:render-present renderer)
  )

next-world is a function that maps the current world to the next. It basically calls next on each object in the world and accumulate the results. We want objects to be able to go away, so if (next object) returns nil, we don't accumulate anything in the new world. If next returns the object unchanged, it will be accumulated unchanged in the next world. (next object) returns a new version of an object to simulate an update to the object. We want to be able to increase the amount of objects, so we allow (next object) to return a list of objects to be accumulated.

(defun next-world (previous-world dt)
  (fold-left
   (lambda (items item)
     (let ((more (next item dt)))
       (cond ((null more) items)
             ((consp more) (append more items))
             (t (cons more items)))))
   '()
   previous-world))

We'll start with a user-controlled player.

(defclass player ()
  ((x :initarg :x
      :reader get-x)
   (y :initarg :y
      :reader get-y)))

Everything that is to be displayed needs a render! method. This one just draws a little green triangle facing up.

(defmethod render! (renderer (player player))
  (let ((x (floor (get-x player)))
        (y (floor (get-y player))))
    (sdl2:set-render-draw-color renderer #x00 #xFF #x00 #xFF)
    (sdl2:render-draw-line renderer (- x 8) (+ y 8) (+ x 8) (+ y 8))
    (sdl2:render-draw-line renderer (- x 8) (+ y 8) (- x 1) (- y 16))
    (sdl2:render-draw-line renderer (+ x 8) (+ y 8) x (- y 16))
    (sdl2:render-draw-point renderer x y)
    ))

The next method computes the player in the next world:


(defun x-input ()
  (- (if (sdl2:keyboard-state-p :scancode-right)
         1
         0)
     (if (sdl2:keyboard-state-p :scancode-left)
         1
         0)))

(defun y-input ()
  (- (if (sdl2:keyboard-state-p :scancode-down)
         1
         0)
     (if (sdl2:keyboard-state-p :scancode-up)
         1
         0)))

(defparameter +player-speed+ 200.0) ;; pixels per second

(defmethod next ((player player) dt)
  (let ((new-x (max 8  (min (- +window-width+ 8)
                            (+ (get-x player)
                               (* (x-input) +player-speed+ dt)))))
        (new-y (max 16 (min (- +window-height+ 8)
                            (+ (get-y player)
                               (* (y-input) +player-speed+ dt))))))
    (make-instance 'player :x new-x :y new-y)))

Once we've defined a render! method and a next method, we're ready to go. If we call run on a list containing a player object, we'll have our little player on the screen controllable with the arrow keys.

An enemy ship can be defined.

(defclass enemy ()
  ((x :initarg :x :reader get-x)
   (y :initarg :y :reader get-y)
   (dx :initarg :dx :reader get-dx)
   (dy :initarg :dy :reader get-dy)))

(defmethod next ((enemy enemy) dt)
  (let ((new-x (+ (get-x enemy) (* (get-dx enemy) dt)))
        (new-y (+ (get-y enemy) (* (get-dy enemy) dt))))
    (when (and (>= new-x 8)
               (< new-x (+ +window-width+ 8))
               (>= new-y 8)
               (< new-y (- +window-height+ 16)))
      (make-instance 'enemy
                     :x new-x
                     :y new-y
                     :dx (get-dx enemy)
                     :dy (get-dy enemy)))))

;;; Render method omitted

As given, enemy ships will drift at constant speed until they run off the screen. We'd like to replenish the supply, so we'll make an enemy spawner:

(defclass enemy-spawner ()
  ((timer :initarg :timer :initform 0 :reader get-timer)))

(defmethod next ((spawner enemy-spawner) dt)
  (let ((new-time (- (get-timer spawner) dt)))
    (if (> new-time 0)
        (make-instance 'enemy-spawner :timer new-time)
        (list (make-instance 'enemy-spawner :timer (+ 1 (random 4)))
              (make-instance 'enemy :x (random (+ (- +window-width+ 32) 16))
                                    :y 16
                                    :dx (- 25 (random 50))
                                    :dy (+ (random 100) 50))))))

(defmethod render! (renderer (enemy-spawner enemy-spawner))
  nil)
The render! method doesn't do anything so a spawner doesn't have an image. It simply has a timer. To compute the next spawner, we subtract dt and create a new spawner with the reduced amount of time. If that's not a positive amount of time, though, we create two objects: a new spawner with somewhere between 1 and 5 seconds time and a new enemy ship.

We'll modify our player to allow him to shoot at the enemy:

(defclass player ()
  ((x :initarg :x
      :reader get-x)
   (y :initarg :y
      :reader get-y)
   (fire-cycle :initarg :fire-cycle
               :initform 0
               :reader get-fire-cycle)))

(defmethod next ((player player) dt)
  (let ((new-x (limit 8 (- +window-width+ 8) (+ (get-x player) (* (x-input) +player-speed+ dt))))
        (new-y (limit 16 (- +window-height+ 8) (+ (get-y player) (* (y-input) +player-speed+ dt))))
        (next-fire-cycle (- (get-fire-cycle player) dt)))
    (if (and (sdl2:keyboard-state-p :scancode-space)
             (< next-fire-cycle 0))
        (list
         (make-instance 'player
                        :x new-x
                        :y new-y
                        :fire-cycle .1)
         (make-instance 'bullet
                               :x (- (get-x player) 8)
                               :y (- (get-y player) 16)
                               :dx 0
                               :dy (- +bullet-speed+))
         (make-instance 'bullet
                               :x (+ (get-x player) 8)
                               :y (- (get-y player) 16)
                               :dx 0
                               :dy (- +bullet-speed+)))
        (make-instance 'player
                       :x new-x
                       :y new-y
                       :fire-cycle next-fire-cycle))))

A bullet is a simple moving object:

(defclass bullet ()
  ((x :initarg :x :reader get-x)
   (y :initarg :y :reader get-y)
   (dx :initarg :dx :reader get-dx)
   (dy :initarg :dy :reader get-dy)))

(defmethod next ((bullet bullet) dt)
  (let ((new-x (+ (get-x bullet) (* (get-dx bullet) dt)))
        (new-y (+ (get-y bullet) (* (get-dy bullet) dt))))
    (when (and (>= new-x 0)
               (< new-x +window-width+)
               (>= new-y 0)
               (< new-y +window-height+))
      (make-instance 'bullet
                     :x new-x
                     :y new-y
                     :dx (get-dx bullet)
                     :dy (get-dy bullet)))))

At this point we can move around the screen and shoot at enemies that spawn periodically. The problem is that the bullets go right through the enemy. We need to handle object collisions. We'll modify the next-world function. As it loops over the objects in the world, it will perform an inner loop that checks for collisions with other objects. If two objects collide, a function is called to get the collision results and those results are added to the list of objects in the world. If an object doesn't collide with anything, the next method is called to get the next version of the object.

(defun next-world (previous-world dt)
  (let outer ((tail previous-world)
              (next-world '()))
    (cond ((consp tail)
           (let ((this (car tail)))
             (let inner ((those (cdr tail)))
               (cond ((consp those)
                      (let ((that (car those))
                            (others (cdr those)))
                        (if (collides? this that)
                            (outer (append (collide this that) (delete that (cdr tail)))
                                   next-world)
                            (inner others))))
                     ((null those)
                      (outer (cdr tail)
                             (let ((more (next this dt)))
                               (cond ((consp more) (append more next-world))
                                     ((null more) next-world)
                                     (t (cons more next-world))))))
                     (t (error "Bad list."))))))
          ((null tail) next-world)
          (t (error "Bad list.")))))

We define collides? as a generic function that returns nil by default

(defgeneric collides? (this that)
  (:method ((this t) (that t)) nil)
  )
so that most objects don't collide. In the case where something does collide, we'll define collide as a generic function that returns nil by default
(defgeneric collide (this that)
  (:method ((this t) (that t)) nil)
  )
so when two objects collide, they simply disappear.

collides? will be called on pairs of objects in no particular order, so method pairs will be needed to handle both orders. We'll define collides? methods on bullets and enemies that checks if the bullet is within the bounding box of the enemy:

(defmethod collides? ((this bullet) (that enemy))
  (and (> (get-x this) (- (get-x that) 8))
       (< (get-x this) (+ (get-x that) 8))
       (> (get-y this) (- (get-y that) 8))
       (< (get-y this) (+ (get-y that) 8))))

(defmethod collides? ((this enemy) (that bullet))
  (collides? that this))

At this point, we can shoot enemy ships. The default method for collide between an enemy and a bullet returns nil so the enemy and the bullet simply disappear. If we were fancy, we could arrange for it to return an explosion object or several debris objects.

It would be nice to keep a tally of the number of enemy ships we have shot. We don't have to add any extra machinery for this. We create a score class and a point class:

(defclass score ()
  ((value :initarg :value
          :reader get-value)))

(defmethod next ((score score) dt) score)

;;; Render method prints score on screen.

(defclass point ()
  ((value :initarg :value
          :reader get-value)))

(defmethod next ((point point) dt) point)

(defmethod render! (renderer (point point)) nil)
Scores and points are immutable objects without positions, but we'll define methods so that when a score and a point collide, the result is a higher score.
(defmethod collides? ((this point) (that score)) t)
(defmethod collides? ((this score) (that point)) t)

(defmethod collide ((this point) (that score))
  (list (make-instance 'score
                       :font (get-font that)
                       :value (+ (get-value this) (get-value that)))))

(defmethod collide ((this score) (that point))
  (collide that this))
Now we'll define a bullet colliding with an enemy to produce a point:
(defmethod collide ((this bullet) (that enemy))
  (list (make-instance 'point :value 1)
        ;; add explosion object here
        ))

(defmethod collide ((this enemy) (that bullet))
  (collide that this))
So when you shoot an enemy, the bullet and enemy disappear to be replaced by a point. On the next update, the point will collide with the score to be replaced with an updated score.

At this point we've got a little demo game where we can fly a ship around and shoot enemies and a running score is kept. The world model is immutable and worlds are functions of previous worlds. I'll call it a successful proof of concept.

But did this buy us anything? We don't have mutable state per se, but we've kind of cheated. When we create new versions of an object, each version is immutable, but the sequence of versions taken as a whole seem to be evolving over time. For example, consider the score. At each time step, there is an immutable score object, but over time what is considered the current score changes. We've eliminated the direct problems of mutation, but we've introduced the problem of keeping track of what series of immutable versions correspond to a single evolving instance.

In this small example, we're not keeping track of the evolving objects. For instance, each bullet, as it is updated from step to step, is actually created anew at its new position on each step. The old bullet instance is dropped and the new instance really has no idea how it got there. Bullets are such simple objects that this doesn't matter, but the current score is different. It makes sense for there to be a singleton score object that increases over time, but we haven't built that in to our model. Instead, we've designed a set of collision interactions that drive the score.

We've eliminated the direct mutable state in our objects and our world, but sometimes we want to model stateful objects. We therefore create objects that represent state transitions (e.g. points) and then use the collision mechanism to combine the transition objects with the objects that represent physical entities. That seems a bit convoluted, and I don't think it will scale.

On the other hand, we do gain the immediate benefits of the world and the objects being immutable. Saving and restoring a world is trivial. Reasoning about objects at each update is easy because the objects don't change, but we now have to reason about how objects appear to change in the long run.

The tradeoff of immutable objects is increased allocation. But although a lot more consing is happening, most of it can be quickly reclaimed by the generational collector, so noticable GC pauses are infrequent. I haven't measured the performance, but it is certainly adequate for the little example I wrote. If you had a mechanism to reason about the objects as linear types (Sufficiently Smart Compiler), you could determine when you can update objects in place and avoid reallocating.

The world model, simply a list of objects, is flexible, but not well structured. For instance, the current score and the bullets are among the elements mixed together in this list. You'd have to search this list to find specific elements or filter this list to find elements of a certain type.

The simple collision model is O(n2), so it can't handle a ton of objects. A more sophisticated world model would be needed to keep track of different classes of collidable objects to avoid the O(n2) search. For example, if bullets were kept separately, we could avoid checking if they collide with each other.

The point of this exercise was to play with graphics and see what you can do without the mutable state that is alarmingly ubiquitous. It turns out that you can go pretty far, but it's kind of strange.


Saturday, July 16, 2022

Let's talk to GitHub

Let's teach Common Lisp to talk to GitHub.

We'll need an API token. I like to put these sorts of things in config files. This makes it easier to configure scripts that are deployed to containers. You simply make the config files available through a mount point when starting the container. That way, you can avoid baking credentials into the script.

(defun config-directory ()
  (merge-pathnames
    (make-pathname :directory '(:relative ".config" "github"))
    (user-homedir-pathname)))

(defun config-file (&rest keyargs)
  (merge-pathnames (apply #'make-pathname keyargs) (config-directory)))

(defun load-token (pathname)
  (with-open-file (stream pathname :direction :input)
    (str:trim (read-line stream))))

(defun github-api-token ()
  (load-token (config-file :name "api-token")))

We'll make a lot of use miscellaneous, ad hoc CLOS objects. It is so common for these things to have names that it is worth its own mixin.

(defgeneric get-name (object))

(defclass named-object-mixin ()
  ((name :initarg :name
         :initform (require-initarg :name)
         :reader get-name
         :type string)))

And we'll define a default print-object method. Classes that use this mixin and don't provide their own print-object method will get this one by default.

(defmethod print-object ((obj named-object-mixin) stream)
  (print-unreadable-object (obj stream :identity t :type t)
    (format stream "~a" (slot-value obj 'name))))

We'll make an object to represent GitHub and put the API token in there.

(defclass github (named-object-mixin)
  ((api-token :initarg :api-token
              :initform (require-initarg :api-token)
              :reader get-api-token)))

(defparameter +github+ nil)

(defun github ()  
  (unless (and (boundp '+github+)
               (symbol-value '+github+))
    (setf (symbol-value '+github+)
          (make-instance 'github 
                         :name "GitHub"
                         :api-token (github-api-token))))
  (symbol-value '+github+))

To authenticate to GitHub, we need to pass the API token in the HTTP request headers.

(defun authorization-header (github)
  (cons "Authorization" (format nil "token ~a" (get-api-token github))))
So let's make a request:
* (dex:get "https://api.github.com/user"
           :headers (list (authorization-header (github))
                          '("Accept" . "application/vnd.github.v3+json")))
"{"login":"joseph-marshall69","id":60371090,"node_id":"MDQ6VXNlcjYwMzcxMDkw","avatar_url":"https://avatars.githubusercontent.com/u/60371090?v=4","gravatar_id":"","url":"https://api.github.com/users/jos...[sly-elided string of length 1535]"
200 (8 bits, #xC8, #o310, #b11001000)
#<HASH-TABLE :TEST EQUAL :COUNT 26 {1002A9B2A3}>
#<QURI.URI.HTTP:URI-HTTPS https://api.github.com/user>
#<CL+SSL::SSL-STREAM for #<FD-STREAM for "socket 172.26.126.123:33674, peer: 192.30.255.116:443" {1002A96333}>>
Success! But we got back the string representation of a JSON object. We'll instead request a stream as a return value and pass it to a JSON parser:
* (json:decode-json
    (dex:get "https://api.github.com/user"
             :headers (list (authorization-header (github))
                            '("Accept" . "application/vnd.github.v3+json"))
             :want-stream t))

((:LOGIN . "jrm-code-project") (:ID . 51824598)
 (:NODE--ID . "MDQ6VXNlcjUxODI0NTk4")
 (:AVATAR--URL . "https://avatars.githubusercontent.com/u/51824598?v=4")
 (:GRAVATAR--ID . "") (:URL . "https://api.github.com/users/jrm-code-project")
 (:HTML--URL . "https://github.com/jrm-code-project")
 (:FOLLOWERS--URL . "https://api.github.com/users/jrm-code-project/followers")
 (:FOLLOWING--URL
  . "https://api.github.com/users/jrm-code-project/following{/other_user}")
 (:GISTS--URL
  . "https://api.github.com/users/jrm-code-project/gists{/gist_id}")
 (:STARRED--URL
  . "https://api.github.com/users/jrm-code-project/starred{/owner}{/repo}")
 (:SUBSCRIPTIONS--URL
  . "https://api.github.com/users/jrm-code-project/subscriptions")
 (:ORGANIZATIONS--URL . "https://api.github.com/users/jrm-code-project/orgs")
 (:REPOS--URL . "https://api.github.com/users/jrm-code-project/repos")
 (:EVENTS--URL
  . "https://api.github.com/users/jrm-code-project/events{/privacy}")
 (:RECEIVED--EVENTS--URL
  . "https://api.github.com/users/jrm-code-project/received_events")
 (:TYPE . "User") (:SITE--ADMIN) (:NAME . "Joe Marshall") (:COMPANY)
 (:BLOG . "https://sites.google.com/site/evalapply/")
 (:LOCATION . "Seattle, WA") (:EMAIL) (:HIREABLE) (:BIO) (:TWITTER--USERNAME)
 (:PUBLIC--REPOS . 9) (:PUBLIC--GISTS . 0) (:FOLLOWERS . 21) (:FOLLOWING . 0)
 (:CREATED--AT . "2019-06-14T12:33:06Z")
 (:UPDATED--AT . "2022-03-15T15:18:03Z") (:PRIVATE--GISTS . 0)
 (:TOTAL--PRIVATE--REPOS . 0) (:OWNED--PRIVATE--REPOS . 0)
 (:DISK--USAGE . 44815) (:COLLABORATORS . 0) (:TWO--FACTOR--AUTHENTICATION)
 (:PLAN (:NAME . "free") (:SPACE . 976562499) (:COLLABORATORS . 0)
  (:PRIVATE--REPOS . 10000)))

JSON objects are mapped to alists. The key is a little funny because of how the JSON parser encodes JSON keys with underscores.

An alist is sort of a poor man's object. The problem with an alist is that there is no type associated with it. We know the slots in our poor man's object, but we don't know the class. Without the class information, we don't have a predicate or a way to dispatch to methods. We should create a real CLOS object from this JSON.

(defclass user (named-object-mixin)
  ((login :initarg :login)
   (id :initarg :id)
   (node-id :initarg :node--id)))

(defun json->user-instance (json)
  (apply #'make-instance 'user
         :allow-other-keys t
         (alist->plist json)))

Should we want to bring more fields into Lisp, we need simply add slots with the right initargs to the user class.

Now we can write

(defun get-self (github)
  (json->user-instance
    (json:decode-json
      (dex:get "https://api.github.com/user"
               :headers (list (authorization-header github)
                              '("Accept" . "application/vnd.github.v3+json"))
               :want-stream t))))

* (get-self (github))
#<USER Joe Marshall {1002BE7013}>

* (inspect *)

The object is a STANDARD-OBJECT of type USER.
0. NAME: "Joe Marshall"
1. LOGIN: "jrm-code-project"
2. ID: 51824598
3. NODE-ID: "MDQ6VXNlcjUxODI0NTk4"

GitHub is moving to a GraphQL API. That's easy to handle.


(defun graphql-query (github query &rest variables)
  (let ((content (json:encode-json-to-string
                  `((query . ,query)
                    (variables . ,(plist->alist variables))))))
    (let* ((json (json:decode-json
                  (dex:post "https://api.github.com/graphql"
                            :headers (list (authorization-header github)
                                           '("Accept" . "application/vnd.github.v3+json")
                                           '("Content-Type" . "application/json"))
                            :content content
                            :want-stream t)))
           (errors (cdr (assoc :errors json))))
      (when errors
        (let ((first-error (car errors)))
          (error (cdr (assoc :message first-error)))))
      (cdr (assoc :data json)))))

(defparameter +get-user-by-login-query+
  "query ($login: String!) {
     user (login: $login) {
       databaseId
       login
       name
       }
    }")
    
* (graphql-query (github) +get-user-by-login-query+ :login "jrm-code-project")
((:USER (:DATABASE-ID . 51824598) (:LOGIN . "jrm-code-project")
  (:NAME . "Joe Marshall")))
And you can use the above technique to turn this JSON into a CLOS instance.

At this point we're cooking. We can call GitHub from Common Lisp and get CLOS objects in return. Of course we need more calls other than get-user, but it's more of the same. With this layer as our basis, it is straightforward to script GitHub.