about summary refs log tree commit diff
path: root/third_party/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/lisp')
-rw-r--r--third_party/lisp/OWNERS2
-rw-r--r--third_party/lisp/alexandria.nix28
-rw-r--r--third_party/lisp/anaphora.nix13
-rw-r--r--third_party/lisp/asdf-flv/.gitattributes2
-rw-r--r--third_party/lisp/asdf-flv/.gitignore3
-rw-r--r--third_party/lisp/asdf-flv/Makefile77
-rw-r--r--third_party/lisp/asdf-flv/README.md7
-rw-r--r--third_party/lisp/asdf-flv/asdf-flv.lisp64
-rw-r--r--third_party/lisp/asdf-flv/default.nix13
-rw-r--r--third_party/lisp/asdf-flv/net.didierverna.asdf-flv.asd43
-rw-r--r--third_party/lisp/asdf-flv/package.lisp28
-rw-r--r--third_party/lisp/babel.nix31
-rw-r--r--third_party/lisp/bordeaux-threads.nix24
-rw-r--r--third_party/lisp/cffi.nix34
-rw-r--r--third_party/lisp/chipz.nix26
-rw-r--r--third_party/lisp/chunga.nix22
-rw-r--r--third_party/lisp/cl-ansi-text.nix16
-rw-r--r--third_party/lisp/cl-base64.nix14
-rw-r--r--third_party/lisp/cl-colors.nix16
-rw-r--r--third_party/lisp/cl-colors2.nix18
-rw-r--r--third_party/lisp/cl-date-time-parser.nix21
-rw-r--r--third_party/lisp/cl-fad.nix27
-rw-r--r--third_party/lisp/cl-json.nix53
-rw-r--r--third_party/lisp/cl-plus-ssl.nix50
-rw-r--r--third_party/lisp/cl-ppcre.nix27
-rw-r--r--third_party/lisp/cl-prevalence.nix25
-rw-r--r--third_party/lisp/cl-smtp.nix24
-rw-r--r--third_party/lisp/cl-unicode.nix80
-rw-r--r--third_party/lisp/cl-who.nix13
-rw-r--r--third_party/lisp/cl-yacc.nix17
-rw-r--r--third_party/lisp/closer-mop.nix19
-rw-r--r--third_party/lisp/closure-common.nix36
-rw-r--r--third_party/lisp/closure-html/default.nix65
-rw-r--r--third_party/lisp/closure-html/dtds-from-store.patch16
-rw-r--r--third_party/lisp/closure-html/no-double-defun.patch78
-rw-r--r--third_party/lisp/defclass-std.nix16
-rw-r--r--third_party/lisp/drakma.nix34
-rw-r--r--third_party/lisp/easy-routes.nix30
-rw-r--r--third_party/lisp/fiveam.nix29
-rw-r--r--third_party/lisp/flexi-streams.nix33
-rw-r--r--third_party/lisp/global-vars.nix7
-rw-r--r--third_party/lisp/hunchentoot.nix62
-rw-r--r--third_party/lisp/ironclad.nix163
-rw-r--r--third_party/lisp/iterate.nix12
-rw-r--r--third_party/lisp/lass.nix35
-rw-r--r--third_party/lisp/let-plus.nix15
-rw-r--r--third_party/lisp/lisp-binary.nix33
-rw-r--r--third_party/lisp/local-time.nix22
-rw-r--r--third_party/lisp/marshal.nix13
-rw-r--r--third_party/lisp/md5.nix16
-rw-r--r--third_party/lisp/metabang-bind.nix16
-rw-r--r--third_party/lisp/mime4cl/.skip-subtree1
-rw-r--r--third_party/lisp/mime4cl/OWNERS1
-rw-r--r--third_party/lisp/mime4cl/README.md27
-rw-r--r--third_party/lisp/mime4cl/address.lisp300
-rw-r--r--third_party/lisp/mime4cl/default.nix50
-rw-r--r--third_party/lisp/mime4cl/endec.lisp663
-rw-r--r--third_party/lisp/mime4cl/ex-sclf.lisp368
-rw-r--r--third_party/lisp/mime4cl/mime.lisp1049
-rw-r--r--third_party/lisp/mime4cl/mime4cl-tests.asd55
-rw-r--r--third_party/lisp/mime4cl/mime4cl.asd49
-rw-r--r--third_party/lisp/mime4cl/package.lisp103
-rw-r--r--third_party/lisp/mime4cl/streams.lisp274
-rw-r--r--third_party/lisp/mime4cl/test/address.lisp123
-rw-r--r--third_party/lisp/mime4cl/test/endec.lisp184
-rw-r--r--third_party/lisp/mime4cl/test/mime.lisp41
-rw-r--r--third_party/lisp/mime4cl/test/package.lisp27
-rw-r--r--third_party/lisp/mime4cl/test/rt.lisp258
-rw-r--r--third_party/lisp/mime4cl/test/samples/sample1.msg86
-rw-r--r--third_party/lisp/mime4cl/test/temp-file.lisp72
-rw-r--r--third_party/lisp/moptilities.nix13
-rw-r--r--third_party/lisp/nibbles.nix26
-rw-r--r--third_party/lisp/npg/.project1
-rw-r--r--third_party/lisp/npg/.skip-subtree1
-rw-r--r--third_party/lisp/npg/COPYING504
-rw-r--r--third_party/lisp/npg/OWNERS1
-rw-r--r--third_party/lisp/npg/README48
-rw-r--r--third_party/lisp/npg/default.nix14
-rw-r--r--third_party/lisp/npg/examples/python.lisp336
-rw-r--r--third_party/lisp/npg/examples/vs-cobol-ii.lisp1901
-rw-r--r--third_party/lisp/npg/npg.asd55
-rw-r--r--third_party/lisp/npg/src/common.lisp79
-rw-r--r--third_party/lisp/npg/src/define.lisp408
-rw-r--r--third_party/lisp/npg/src/package.lisp50
-rw-r--r--third_party/lisp/npg/src/parser.lisp234
-rw-r--r--third_party/lisp/parse-float.nix15
-rw-r--r--third_party/lisp/parse-number.nix9
-rw-r--r--third_party/lisp/parseq.nix13
-rw-r--r--third_party/lisp/physical-quantities.nix24
-rw-r--r--third_party/lisp/postmodern.nix94
-rw-r--r--third_party/lisp/prove.nix29
-rw-r--r--third_party/lisp/puri.nix10
-rw-r--r--third_party/lisp/qbase64/coreutils-base64.patch13
-rw-r--r--third_party/lisp/qbase64/default.nix57
-rw-r--r--third_party/lisp/quasiquote_2/README.md258
-rw-r--r--third_party/lisp/quasiquote_2/default.nix17
-rw-r--r--third_party/lisp/quasiquote_2/macros.lisp15
-rw-r--r--third_party/lisp/quasiquote_2/package.lisp11
-rw-r--r--third_party/lisp/quasiquote_2/quasiquote-2.0.asd30
-rw-r--r--third_party/lisp/quasiquote_2/quasiquote-2.0.lisp340
-rw-r--r--third_party/lisp/quasiquote_2/readers.lisp77
-rw-r--r--third_party/lisp/quasiquote_2/tests-macro.lisp21
-rw-r--r--third_party/lisp/quasiquote_2/tests.lisp143
-rw-r--r--third_party/lisp/rfc2388.nix12
-rw-r--r--third_party/lisp/routes.nix39
-rw-r--r--third_party/lisp/s-sysdeps.nix18
-rw-r--r--third_party/lisp/s-xml/0001-fix-definition-order-in-xml.lisp.patch26
-rw-r--r--third_party/lisp/s-xml/default.nix25
-rw-r--r--third_party/lisp/split-sequence.nix15
-rw-r--r--third_party/lisp/trivial-backtrace.nix15
-rw-r--r--third_party/lisp/trivial-features.nix13
-rw-r--r--third_party/lisp/trivial-garbage.nix9
-rw-r--r--third_party/lisp/trivial-gray-streams.nix13
-rw-r--r--third_party/lisp/trivial-indent.nix10
-rw-r--r--third_party/lisp/trivial-ldap.nix28
-rw-r--r--third_party/lisp/trivial-mimes.nix26
-rw-r--r--third_party/lisp/uax-15.nix43
-rw-r--r--third_party/lisp/unix-opts.nix12
-rw-r--r--third_party/lisp/usocket-server.nix19
-rw-r--r--third_party/lisp/usocket.nix46
120 files changed, 10515 insertions, 0 deletions
diff --git a/third_party/lisp/OWNERS b/third_party/lisp/OWNERS
new file mode 100644
index 000000000000..6536baf505d3
--- /dev/null
+++ b/third_party/lisp/OWNERS
@@ -0,0 +1,2 @@
+eta
+aspen
diff --git a/third_party/lisp/alexandria.nix b/third_party/lisp/alexandria.nix
new file mode 100644
index 000000000000..b522e2d142c1
--- /dev/null
+++ b/third_party/lisp/alexandria.nix
@@ -0,0 +1,28 @@
+# Alexandria is one of the foundational Common Lisp libraries that
+# pretty much everything depends on.
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.alexandria;
+in depot.nix.buildLisp.library {
+  name = "alexandria";
+
+  srcs = map (f: src + ("/alexandria-1/" + f)) [
+    "package.lisp"
+    "definitions.lisp"
+    "binding.lisp"
+    "strings.lisp"
+    "conditions.lisp"
+    "symbols.lisp"
+    "macros.lisp"
+    "functions.lisp"
+    "io.lisp"
+    "hash-tables.lisp"
+    "control-flow.lisp"
+    "lists.lisp"
+    "types.lisp"
+    "arrays.lisp"
+    "sequences.lisp"
+    "numbers.lisp"
+    "features.lisp"
+  ];
+}
diff --git a/third_party/lisp/anaphora.nix b/third_party/lisp/anaphora.nix
new file mode 100644
index 000000000000..c079943e6725
--- /dev/null
+++ b/third_party/lisp/anaphora.nix
@@ -0,0 +1,13 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.anaphora;
+in depot.nix.buildLisp.library {
+  name = "anaphora";
+
+  srcs = map (f: src + ("/" + f)) [
+    "packages.lisp"
+    "early.lisp"
+    "symbolic.lisp"
+    "anaphora.lisp"
+  ];
+}
diff --git a/third_party/lisp/asdf-flv/.gitattributes b/third_party/lisp/asdf-flv/.gitattributes
new file mode 100644
index 000000000000..2b45716e4709
--- /dev/null
+++ b/third_party/lisp/asdf-flv/.gitattributes
@@ -0,0 +1,2 @@
+.gitignore	export-ignore
+.gitattributes	export-ignore
diff --git a/third_party/lisp/asdf-flv/.gitignore b/third_party/lisp/asdf-flv/.gitignore
new file mode 100644
index 000000000000..bdf4ad2ae6dd
--- /dev/null
+++ b/third_party/lisp/asdf-flv/.gitignore
@@ -0,0 +1,3 @@
+sbcl-*/
+cmu-*/
+openmcl-*/
diff --git a/third_party/lisp/asdf-flv/Makefile b/third_party/lisp/asdf-flv/Makefile
new file mode 100644
index 000000000000..b4c74feefe82
--- /dev/null
+++ b/third_party/lisp/asdf-flv/Makefile
@@ -0,0 +1,77 @@
+### Makefile --- Toplevel directory
+
+## Copyright (C) 2011, 2015 Didier Verna
+
+## Author: Didier Verna <didier@didierverna.net>
+
+## This file is part of ASDF-FLV.
+
+## Copying and distribution of this file, with or without modification,
+## are permitted in any medium without royalty provided the copyright
+## notice and this notice are preserved.  This file is offered as-is,
+## without any warranty.
+
+
+### Commentary:
+
+## Contents management by FCM version 0.1.
+
+
+### Code:
+
+PROJECT := asdf-flv
+VERSION := 2.1
+
+W3DIR := $(HOME)/www/software/lisp/$(PROJECT)
+
+DIST_NAME := $(PROJECT)-$(VERSION)
+TARBALL   := $(DIST_NAME).tar.gz
+SIGNATURE := $(TARBALL).asc
+
+
+all:
+
+clean:
+	-rm *~
+
+distclean: clean
+	-rm *.tar.gz *.tar.gz.asc
+
+tag:
+	git tag -a -m 'Version $(VERSION)' 'version-$(VERSION)'
+
+tar: $(TARBALL)
+gpg: $(SIGNATURE)
+dist: tar gpg
+
+install-www: dist
+	-install -m 644 $(TARBALL)   "$(W3DIR)/attic/"
+	-install -m 644 $(SIGNATURE) "$(W3DIR)/attic/"
+	echo "\
+<? lref (\"$(PROJECT)/attic/$(PROJECT)-$(VERSION).tar.gz\", \
+	 contents (\"Dernire version\", \"Latest version\")); ?> \
+| \
+<? lref (\"$(PROJECT)/attic/$(PROJECT)-$(VERSION).tar.gz.asc\", \
+	 contents (\"Signature GPG\", \"GPG Signature\")); ?>" \
+	  > "$(W3DIR)/latest.txt"
+	chmod 644 "$(W3DIR)/latest.txt"
+	cd "$(W3DIR)"					\
+	  && ln -fs attic/$(TARBALL) latest.tar.gz	\
+	  && ln -fs attic/$(SIGNATURE) latest.tar.gz.asc
+
+update-version:
+	perl -pi -e 's/:version ".*"/:version "$(VERSION)"/' \
+	  net.didierverna.$(PROJECT).asd
+
+$(TARBALL):
+	git archive --format=tar --prefix=$(DIST_NAME)/ \
+	    --worktree-attributes HEAD			\
+	  | gzip -c > $@
+
+$(SIGNATURE): $(TARBALL)
+	gpg -b -a $<
+
+
+.PHONY: all clean distclean tag tar gpg dist install-www update-version
+
+### Makefile ends here
diff --git a/third_party/lisp/asdf-flv/README.md b/third_party/lisp/asdf-flv/README.md
new file mode 100644
index 000000000000..7ccdd1888163
--- /dev/null
+++ b/third_party/lisp/asdf-flv/README.md
@@ -0,0 +1,7 @@
+ASDF-FLV provides support for file-local variables through ASDF. A file-local
+variable behaves like `*PACKAGE*` and `*READTABLE*` with respect to `LOAD` and
+`COMPILE-FILE`: a new dynamic binding is created before processing the file,
+so that any modification to the variable essentially becomes file-local.
+
+In order to make one or several variables file-local, use the macros
+`SET-FILE-LOCAL-VARIABLE(S)`.
diff --git a/third_party/lisp/asdf-flv/asdf-flv.lisp b/third_party/lisp/asdf-flv/asdf-flv.lisp
new file mode 100644
index 000000000000..76c6845b82b3
--- /dev/null
+++ b/third_party/lisp/asdf-flv/asdf-flv.lisp
@@ -0,0 +1,64 @@
+;;; asdf-flv.lisp --- Implementation
+
+;; Copyright (C) 2011, 2015 Didier Verna
+
+;; Author: Didier Verna <didier@didierverna.net>
+
+;; This file is part of ASDF-FLV.
+
+;; Copying and distribution of this file, with or without modification,
+;; are permitted in any medium without royalty provided the copyright
+;; notice and this notice are preserved.  This file is offered as-is,
+;; without any warranty.
+
+
+;;; Commentary:
+
+;; Contents management by FCM version 0.1.
+
+
+;;; Code:
+
+(in-package :net.didierverna.asdf-flv)
+
+
+(defvar *file-local-variables* ()
+  "List of file-local special variables.")
+
+
+(defun make-variable-file-local (symbol)
+  "Make special variable named by SYMBOL have a file-local value."
+  (pushnew symbol *file-local-variables*))
+
+(defmacro set-file-local-variable (symbol)
+  "Set special variable named by SYMBOL as file-local.
+SYMBOL need not be quoted."
+  `(make-variable-file-local ',symbol))
+
+(defun make-variables-file-local (&rest symbols)
+  "Make special variables named by SYMBOLS have a file-local value."
+  (dolist (symbol symbols)
+    (pushnew symbol *file-local-variables*)))
+
+(defmacro set-file-local-variables (&rest symbols)
+  "Set special variables named by SYMBOLS as file-local.
+SYMBOLS need not be quoted."
+  `(make-variables-file-local ,@(mapcar (lambda (symbol) (list 'quote symbol))
+					symbols)))
+
+
+(defmethod asdf:perform :around
+    ((operation asdf:load-op) (file asdf:cl-source-file))
+  "Establish new dynamic bindings for file-local variables."
+  (progv *file-local-variables*
+      (mapcar #'symbol-value *file-local-variables*)
+    (call-next-method)))
+
+(defmethod asdf:perform :around
+    ((operation asdf:compile-op) (file asdf:cl-source-file))
+  "Establish new dynamic bindings for file-local variables."
+  (progv *file-local-variables*
+      (mapcar #'symbol-value *file-local-variables*)
+    (call-next-method)))
+
+;;; asdf-flv.lisp ends here
diff --git a/third_party/lisp/asdf-flv/default.nix b/third_party/lisp/asdf-flv/default.nix
new file mode 100644
index 000000000000..e8ec4aa8f85c
--- /dev/null
+++ b/third_party/lisp/asdf-flv/default.nix
@@ -0,0 +1,13 @@
+# Imported from https://github.com/didierverna/asdf-flv
+{ depot, ... }:
+
+with depot.nix;
+buildLisp.library {
+  name = "asdf-flv";
+  deps = [ (buildLisp.bundled "asdf") ];
+
+  srcs = [
+    ./package.lisp
+    ./asdf-flv.lisp
+  ];
+}
diff --git a/third_party/lisp/asdf-flv/net.didierverna.asdf-flv.asd b/third_party/lisp/asdf-flv/net.didierverna.asdf-flv.asd
new file mode 100644
index 000000000000..41202746d019
--- /dev/null
+++ b/third_party/lisp/asdf-flv/net.didierverna.asdf-flv.asd
@@ -0,0 +1,43 @@
+;;; net.didierverna.asdf-flv.asd --- ASDF system definition
+
+;; Copyright (C) 2011, 2015 Didier Verna
+
+;; Author: Didier Verna <didier@didierverna.net>
+
+;; This file is part of ASDF-FLV.
+
+;; Copying and distribution of this file, with or without modification,
+;; are permitted in any medium without royalty provided the copyright
+;; notice and this notice are preserved.  This file is offered as-is,
+;; without any warranty.
+
+
+;;; Commentary:
+
+;; Contents management by FCM version 0.1.
+
+
+;;; Code:
+
+(asdf:defsystem :net.didierverna.asdf-flv
+  :long-name "ASDF File Local Variables"
+  :description "ASDF extension to provide support for file-local variables."
+  :long-description "\
+ASDF-FLV provides support for file-local variables through ASDF. A file-local
+variable behaves like *PACKAGE* and *READTABLE* with respect to LOAD and
+COMPILE-FILE: a new dynamic binding is created before processing the file, so
+that any modification to the variable becomes essentially file-local.
+
+In order to make one or several variables file-local, use the macros
+SET-FILE-LOCAL-VARIABLE(S)."
+  :author "Didier Verna"
+  :mailto "didier@didierverna.net"
+  :homepage "http://www.lrde.epita.fr/~didier/software/lisp/misc.php#asdf-flv"
+  :source-control "https://github.com/didierverna/asdf-flv"
+  :license "GNU All Permissive"
+  :version "2.1"
+  :serial t
+  :components ((:file "package")
+	       (:file "asdf-flv")))
+
+;;; net.didierverna.asdf-flv.asd ends here
diff --git a/third_party/lisp/asdf-flv/package.lisp b/third_party/lisp/asdf-flv/package.lisp
new file mode 100644
index 000000000000..1d7fb2bab43d
--- /dev/null
+++ b/third_party/lisp/asdf-flv/package.lisp
@@ -0,0 +1,28 @@
+;;; package.lisp --- Package definition
+
+;; Copyright (C) 2011, 2015 Didier Verna
+
+;; Author: Didier Verna <didier@didierverna.net>
+
+;; This file is part of ASDF-FLV.
+
+;; Copying and distribution of this file, with or without modification,
+;; are permitted in any medium without royalty provided the copyright
+;; notice and this notice are preserved.  This file is offered as-is,
+;; without any warranty.
+
+
+;;; Commentary:
+
+;; Contents management by FCM version 0.1.
+
+
+;;; Code:
+
+(in-package :cl-user)
+
+(defpackage :net.didierverna.asdf-flv
+  (:use :cl)
+  (:export :set-file-local-variable :set-file-local-variables))
+
+;;; package.lisp ends here
diff --git a/third_party/lisp/babel.nix b/third_party/lisp/babel.nix
new file mode 100644
index 000000000000..ae7c5dd23d18
--- /dev/null
+++ b/third_party/lisp/babel.nix
@@ -0,0 +1,31 @@
+# Babel is an encoding conversion library for Common Lisp.
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.babel;
+in depot.nix.buildLisp.library {
+  name = "babel";
+  deps = [
+    depot.third_party.lisp.alexandria
+    depot.third_party.lisp.trivial-features
+  ];
+
+  srcs = map (f: src + ("/src/" + f)) [
+    "packages.lisp"
+    "encodings.lisp"
+    "enc-ascii.lisp"
+    "enc-ebcdic.lisp"
+    "enc-ebcdic-int.lisp"
+    "enc-iso-8859.lisp"
+    "enc-unicode.lisp"
+    "enc-cp1251.lisp"
+    "enc-cp1252.lisp"
+    "jpn-table.lisp"
+    "enc-jpn.lisp"
+    "enc-gbk.lisp"
+    "enc-koi8.lisp"
+    "external-format.lisp"
+    "strings.lisp"
+    "gbk-map.lisp"
+    "sharp-backslash.lisp"
+  ];
+}
diff --git a/third_party/lisp/bordeaux-threads.nix b/third_party/lisp/bordeaux-threads.nix
new file mode 100644
index 000000000000..8a2e09950887
--- /dev/null
+++ b/third_party/lisp/bordeaux-threads.nix
@@ -0,0 +1,24 @@
+# This library is meant to make writing portable multi-threaded apps
+# in Common Lisp simple.
+{ depot, pkgs, ... }:
+
+let
+  src = with pkgs; srcOnly lispPackages.bordeaux-threads;
+  getSrc = f: "${src}/src/${f}";
+in
+depot.nix.buildLisp.library {
+  name = "bordeaux-threads";
+  deps = [ depot.third_party.lisp.alexandria ];
+
+  srcs = map getSrc [
+    "pkgdcl.lisp"
+    "bordeaux-threads.lisp"
+  ] ++ [
+    {
+      sbcl = getSrc "impl-sbcl.lisp";
+      ecl = getSrc "impl-ecl.lisp";
+    }
+  ] ++ map getSrc [
+    "default-implementations.lisp"
+  ];
+}
diff --git a/third_party/lisp/cffi.nix b/third_party/lisp/cffi.nix
new file mode 100644
index 000000000000..de1d0c2e8ed7
--- /dev/null
+++ b/third_party/lisp/cffi.nix
@@ -0,0 +1,34 @@
+# CFFI purports to be the Common Foreign Function Interface.
+{ depot, pkgs, ... }:
+
+with depot.nix;
+let src = with pkgs; srcOnly lispPackages.cffi;
+in buildLisp.library {
+  name = "cffi";
+  deps = with depot.third_party.lisp; [
+    alexandria
+    babel
+    trivial-features
+    (buildLisp.bundled "asdf")
+  ];
+
+  srcs = [
+    {
+      ecl = src + "/src/cffi-ecl.lisp";
+      sbcl = src + "/src/cffi-sbcl.lisp";
+      ccl = src + "/src/cffi-openmcl.lisp";
+    }
+  ] ++ map (f: src + ("/src/" + f)) [
+    "package.lisp"
+    "utils.lisp"
+    "libraries.lisp"
+    "early-types.lisp"
+    "types.lisp"
+    "enum.lisp"
+    "strings.lisp"
+    "structures.lisp"
+    "functions.lisp"
+    "foreign-vars.lisp"
+    "features.lisp"
+  ];
+}
diff --git a/third_party/lisp/chipz.nix b/third_party/lisp/chipz.nix
new file mode 100644
index 000000000000..59e9914ee1d1
--- /dev/null
+++ b/third_party/lisp/chipz.nix
@@ -0,0 +1,26 @@
+# Common Lisp library for decompressing deflate, zlib, gzip, and bzip2 data
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.chipz;
+in depot.nix.buildLisp.library {
+  name = "chipz";
+  deps = [ (depot.nix.buildLisp.bundled "asdf") ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "chipz.asd"
+    "package.lisp"
+    "constants.lisp"
+    "conditions.lisp"
+    "dstate.lisp"
+    "types-and-tables.lisp"
+    "crc32.lisp"
+    "adler32.lisp"
+    "inflate-state.lisp"
+    "gzip.lisp"
+    "zlib.lisp"
+    "inflate.lisp"
+    "bzip2.lisp"
+    "decompress.lisp"
+    "stream.lisp"
+  ];
+}
diff --git a/third_party/lisp/chunga.nix b/third_party/lisp/chunga.nix
new file mode 100644
index 000000000000..d3f50bcb1af8
--- /dev/null
+++ b/third_party/lisp/chunga.nix
@@ -0,0 +1,22 @@
+# Portable chunked streams for Common Lisp
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.chunga;
+in depot.nix.buildLisp.library {
+  name = "chunga";
+  deps = with depot.third_party.lisp; [
+    trivial-gray-streams
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "packages.lisp"
+    "specials.lisp"
+    "util.lisp"
+    "known-words.lisp"
+    "conditions.lisp"
+    "read.lisp"
+    "streams.lisp"
+    "input.lisp"
+    "output.lisp"
+  ];
+}
diff --git a/third_party/lisp/cl-ansi-text.nix b/third_party/lisp/cl-ansi-text.nix
new file mode 100644
index 000000000000..0e3401524755
--- /dev/null
+++ b/third_party/lisp/cl-ansi-text.nix
@@ -0,0 +1,16 @@
+# Enables ANSI colors for printing.
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.cl-ansi-text;
+in depot.nix.buildLisp.library {
+  name = "cl-ansi-text";
+  deps = with depot.third_party.lisp; [
+    alexandria
+    cl-colors2
+  ];
+
+  srcs = map (f: src + ("/src/" + f)) [
+    "cl-ansi-text.lisp"
+    "define-colors.lisp"
+  ];
+}
diff --git a/third_party/lisp/cl-base64.nix b/third_party/lisp/cl-base64.nix
new file mode 100644
index 000000000000..08055a047119
--- /dev/null
+++ b/third_party/lisp/cl-base64.nix
@@ -0,0 +1,14 @@
+# Base64 encoding for Common Lisp
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.cl-base64;
+in depot.nix.buildLisp.library {
+  name = "cl-base64";
+  srcs = [
+    (src + "/package.lisp")
+    (src + "/encode.lisp")
+    (src + "/decode.lisp")
+  ];
+}
+
+
diff --git a/third_party/lisp/cl-colors.nix b/third_party/lisp/cl-colors.nix
new file mode 100644
index 000000000000..b51e4d46a747
--- /dev/null
+++ b/third_party/lisp/cl-colors.nix
@@ -0,0 +1,16 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.cl-colors;
+in depot.nix.buildLisp.library {
+  name = "cl-colors";
+  deps = [
+    depot.third_party.lisp.alexandria
+    depot.third_party.lisp.let-plus
+  ];
+  srcs = [
+    "${src}/package.lisp"
+    "${src}/colors.lisp"
+    "${src}/colornames.lisp"
+    "${src}/hexcolors.lisp"
+  ];
+}
diff --git a/third_party/lisp/cl-colors2.nix b/third_party/lisp/cl-colors2.nix
new file mode 100644
index 000000000000..34201bc2faa0
--- /dev/null
+++ b/third_party/lisp/cl-colors2.nix
@@ -0,0 +1,18 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.cl-colors2;
+in depot.nix.buildLisp.library {
+  name = "cl-colors2";
+  deps = with depot.third_party.lisp; [
+    alexandria
+    cl-ppcre
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "colors.lisp"
+    "colornames-x11.lisp"
+    "colornames-svg.lisp"
+    "hexcolors.lisp"
+  ];
+}
diff --git a/third_party/lisp/cl-date-time-parser.nix b/third_party/lisp/cl-date-time-parser.nix
new file mode 100644
index 000000000000..e53cb2dfce42
--- /dev/null
+++ b/third_party/lisp/cl-date-time-parser.nix
@@ -0,0 +1,21 @@
+{ depot, pkgs, ... }:
+
+depot.nix.buildLisp.library {
+  name = "cl-date-time-parser";
+
+  srcs = [
+    (pkgs.fetchurl {
+      url = "https://raw.githubusercontent.com/tkych/cl-date-time-parser/00d6fc70b599f460fdf13cf0cf7e6bf843312410/date-time-parser.lisp";
+      sha256 = "0zrkv1q3sx5ksijxhw45ixf1hy5b9biii6i6v41h12q6pbkfqz69";
+    })
+  ];
+
+  deps = [
+    depot.third_party.lisp.alexandria
+    depot.third_party.lisp.anaphora
+    depot.third_party.lisp.split-sequence
+    depot.third_party.lisp.cl-ppcre
+    depot.third_party.lisp.local-time
+    depot.third_party.lisp.parse-float
+  ];
+}
diff --git a/third_party/lisp/cl-fad.nix b/third_party/lisp/cl-fad.nix
new file mode 100644
index 000000000000..9350abe2e3a3
--- /dev/null
+++ b/third_party/lisp/cl-fad.nix
@@ -0,0 +1,27 @@
+# Portable pathname library
+{ depot, pkgs, ... }:
+
+with depot.nix;
+
+let src = with pkgs; srcOnly lispPackages.cl-fad;
+in buildLisp.library {
+  name = "cl-fad";
+
+  deps = with depot.third_party.lisp; [
+    alexandria
+    bordeaux-threads
+    {
+      sbcl = buildLisp.bundled "sb-posix";
+    }
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "packages.lisp"
+  ] ++ [
+    { ccl = "${src}/openmcl.lisp"; }
+  ] ++ map (f: src + ("/" + f)) [
+    "fad.lisp"
+    "path.lisp"
+    "temporary-files.lisp"
+  ];
+}
diff --git a/third_party/lisp/cl-json.nix b/third_party/lisp/cl-json.nix
new file mode 100644
index 000000000000..6b82fac772d4
--- /dev/null
+++ b/third_party/lisp/cl-json.nix
@@ -0,0 +1,53 @@
+# JSON encoder & decoder
+{ depot, pkgs, ... }:
+
+let
+  inherit (depot.nix) buildLisp;
+
+  # https://github.com/sharplispers/cl-json/pull/12/
+  src = pkgs.fetchFromGitHub {
+    owner = "sternenseemann";
+    repo = "cl-json";
+    rev = "c059bec94e28a11102a994d6949e2e52764f21fd";
+    sha256 = "0l07syw1b1x2zi8kj4iph3rf6vi6c16b7fk69iv7x27wrdsr1qwj";
+  };
+
+  getSrcs = subdir: map (f: src + ("/" + subdir + "/" + f));
+in
+buildLisp.library {
+  name = "cl-json";
+  deps = [ (buildLisp.bundled "asdf") ];
+
+  srcs = [ "${src}/cl-json.asd" ] ++
+    (getSrcs "src" [
+      "package.lisp"
+      "common.lisp"
+      "objects.lisp"
+      "camel-case.lisp"
+      "decoder.lisp"
+      "encoder.lisp"
+      "utils.lisp"
+      "json-rpc.lisp"
+    ]);
+
+  tests = {
+    deps = [
+      depot.third_party.lisp.cl-unicode
+      depot.third_party.lisp.fiveam
+    ];
+    srcs = [
+      # CLOS tests are broken upstream as well
+      # https://github.com/sharplispers/cl-json/issues/11
+      (pkgs.writeText "no-clos-tests.lisp" ''
+        (replace *features* (delete :cl-json-clos *features*))
+      '')
+    ] ++ getSrcs "t" [
+      "package.lisp"
+      "testencoder.lisp"
+      "testdecoder.lisp"
+      "testmisc.lisp"
+    ];
+
+    expression = "(fiveam:run! 'json-test::json)";
+  };
+}
diff --git a/third_party/lisp/cl-plus-ssl.nix b/third_party/lisp/cl-plus-ssl.nix
new file mode 100644
index 000000000000..dc0a95944fe7
--- /dev/null
+++ b/third_party/lisp/cl-plus-ssl.nix
@@ -0,0 +1,50 @@
+# Common Lisp bindings to OpenSSL
+{ depot, pkgs, ... }:
+
+with depot.nix;
+
+let
+  src = pkgs.fetchgit {
+    url = "https://github.com/cl-plus-ssl/cl-plus-ssl.git";
+    rev = "29081992f6d7b4e3aa2c5eeece4cd92b745071f4";
+    hash = "sha256:16lyrixl98b7vy29dbbzkbq0xaz789350dajrr1gdny5i55rkjq0";
+  };
+in
+buildLisp.library {
+  name = "cl-plus-ssl";
+  deps = with depot.third_party.lisp; [
+    alexandria
+    bordeaux-threads
+    cffi
+    flexi-streams
+    trivial-features
+    trivial-garbage
+    trivial-gray-streams
+    {
+      scbl = buildLisp.bundled "uiop";
+      default = buildLisp.bundled "asdf";
+    }
+    { sbcl = buildLisp.bundled "sb-posix"; }
+  ];
+
+  native = [ pkgs.openssl ];
+
+  srcs = map (f: src + ("/src/" + f)) [
+    "package.lisp"
+    "reload.lisp"
+    "conditions.lisp"
+    "ffi.lisp"
+    "x509.lisp"
+    "ffi-buffer-all.lisp"
+    "ffi-buffer.lisp"
+    "streams.lisp"
+    "bio.lisp"
+    "random.lisp"
+    "context.lisp"
+    "verify-hostname.lisp"
+  ];
+
+  brokenOn = [
+    "ecl" # dynamic cffi
+  ];
+}
diff --git a/third_party/lisp/cl-ppcre.nix b/third_party/lisp/cl-ppcre.nix
new file mode 100644
index 000000000000..561e306191ca
--- /dev/null
+++ b/third_party/lisp/cl-ppcre.nix
@@ -0,0 +1,27 @@
+# cl-ppcre is a Common Lisp regular expression library.
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.cl-ppcre;
+in depot.nix.buildLisp.library {
+  name = "cl-ppcre";
+
+  srcs = map (f: src + ("/" + f)) [
+    "packages.lisp"
+    "specials.lisp"
+    "util.lisp"
+    "errors.lisp"
+    "charset.lisp"
+    "charmap.lisp"
+    "chartest.lisp"
+    "lexer.lisp"
+    "parser.lisp"
+    "regex-class.lisp"
+    "regex-class-util.lisp"
+    "convert.lisp"
+    "optimize.lisp"
+    "closures.lisp"
+    "repetition-closures.lisp"
+    "scanner.lisp"
+    "api.lisp"
+  ];
+}
diff --git a/third_party/lisp/cl-prevalence.nix b/third_party/lisp/cl-prevalence.nix
new file mode 100644
index 000000000000..188cbc686d28
--- /dev/null
+++ b/third_party/lisp/cl-prevalence.nix
@@ -0,0 +1,25 @@
+# cl-prevalence is an implementation of object prevalence for CL (i.e.
+# an in-memory database)
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.cl-prevalence;
+in depot.nix.buildLisp.library {
+  name = "cl-prevalence";
+
+  deps = with depot.third_party.lisp; [
+    bordeaux-threads
+    s-xml
+    s-sysdeps
+  ];
+
+  srcs = map (f: src + ("/src/" + f)) [
+    "package.lisp"
+    "serialization/serialization.lisp"
+    "serialization/xml.lisp"
+    "serialization/sexp.lisp"
+    "prevalence.lisp"
+    "managed-prevalence.lisp"
+    "master-slave.lisp"
+    "blob.lisp"
+  ];
+}
diff --git a/third_party/lisp/cl-smtp.nix b/third_party/lisp/cl-smtp.nix
new file mode 100644
index 000000000000..7ab9bea59ff5
--- /dev/null
+++ b/third_party/lisp/cl-smtp.nix
@@ -0,0 +1,24 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.cl-smtp;
+in depot.nix.buildLisp.library {
+  name = "cl-smtp";
+  deps = with depot.third_party.lisp; [
+    usocket
+    trivial-gray-streams
+    flexi-streams
+    cl-base64
+    cl-plus-ssl
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "attachments.lisp"
+    "cl-smtp.lisp"
+    "mime-types.lisp"
+  ];
+
+  brokenOn = [
+    "ecl" # dynamic cffi
+  ];
+}
diff --git a/third_party/lisp/cl-unicode.nix b/third_party/lisp/cl-unicode.nix
new file mode 100644
index 000000000000..815d99c2dc8e
--- /dev/null
+++ b/third_party/lisp/cl-unicode.nix
@@ -0,0 +1,80 @@
+{ depot, pkgs, ... }:
+
+let
+  inherit (pkgs) sbcl runCommand writeText;
+  inherit (depot.nix.buildLisp) bundled;
+
+  src = pkgs.fetchFromGitHub {
+    owner = "edicl";
+    repo = "cl-unicode";
+    rev = "8073fc5634c9d4802888ac03abf11dfe383e16fa";
+    sha256 = "0ykx2s9lqfl74p1px0ik3l2izd1fc9jd1b4ra68s5x34rvjy0hza";
+  };
+
+  cl-unicode-base = depot.nix.buildLisp.library {
+    name = "cl-unicode-base";
+    deps = with depot.third_party.lisp; [
+      cl-ppcre
+    ];
+
+    srcs = map (f: src + ("/" + f)) [
+      "packages.lisp"
+      "specials.lisp"
+      "util.lisp"
+    ];
+  };
+
+  cl-unicode-build = depot.nix.buildLisp.program {
+    name = "cl-unicode-build";
+    deps = with depot.third_party.lisp; [
+      cl-unicode-base
+      flexi-streams
+      {
+        ecl = bundled "asdf";
+        default = bundled "uiop";
+      }
+    ];
+
+    srcs = (map (f: src + ("/build/" + f)) [
+      "util.lisp"
+      "char-info.lisp"
+      "read.lisp"
+    ]) ++ [
+      (runCommand "dump.lisp" { } ''
+        substitute ${src}/build/dump.lisp $out \
+          --replace ':defaults *this-file*' ":defaults (uiop:getcwd)"
+      '')
+
+      (writeText "export-create-source-files.lisp" ''
+        (in-package :cl-unicode)
+        (export 'create-source-files)
+      '')
+    ];
+
+    main = "cl-unicode:create-source-files";
+  };
+
+
+  generated = runCommand "cl-unicode-generated" { } ''
+    mkdir -p $out/build
+    mkdir -p $out/test
+    cd $out/build
+    pwd
+    ${cl-unicode-build}/bin/cl-unicode-build
+  '';
+
+in
+depot.nix.buildLisp.library {
+  name = "cl-unicode";
+  deps = [ cl-unicode-base ];
+  srcs = [
+    "${src}/conditions.lisp"
+    "${generated}/lists.lisp"
+    "${generated}/hash-tables.lisp"
+    "${src}/api.lisp"
+    "${generated}/methods.lisp"
+    "${src}/test-functions.lisp"
+    "${src}/derived.lisp"
+    "${src}/alias.lisp"
+  ];
+}
diff --git a/third_party/lisp/cl-who.nix b/third_party/lisp/cl-who.nix
new file mode 100644
index 000000000000..601b09f118db
--- /dev/null
+++ b/third_party/lisp/cl-who.nix
@@ -0,0 +1,13 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.cl-who;
+in depot.nix.buildLisp.library {
+  name = "cl-who";
+
+  srcs = map (f: src + ("/" + f)) [
+    "packages.lisp"
+    "specials.lisp"
+    "util.lisp"
+    "who.lisp"
+  ];
+}
diff --git a/third_party/lisp/cl-yacc.nix b/third_party/lisp/cl-yacc.nix
new file mode 100644
index 000000000000..b40d5d0601b2
--- /dev/null
+++ b/third_party/lisp/cl-yacc.nix
@@ -0,0 +1,17 @@
+{ depot, pkgs, ... }:
+
+let
+  src = pkgs.fetchFromGitHub {
+    owner = "jech";
+    repo = "cl-yacc";
+    rev = "1334f5469251ffb3f8738a682dc8ee646cb26635";
+    sha256 = "16946pzf8vvadnyfayvj8rbh4zjzw90h0azz2qk1mxrvhh5wklib";
+  };
+in
+depot.nix.buildLisp.library {
+  name = "cl-yacc";
+
+  srcs = map (f: src + ("/" + f)) [
+    "yacc.lisp"
+  ];
+}
diff --git a/third_party/lisp/closer-mop.nix b/third_party/lisp/closer-mop.nix
new file mode 100644
index 000000000000..145b9cfd4325
--- /dev/null
+++ b/third_party/lisp/closer-mop.nix
@@ -0,0 +1,19 @@
+# Closer to MOP is a compatibility layer that rectifies many of the
+# absent or incorrect CLOS MOP features across a broad range of Common
+# Lisp implementations
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.closer-mop;
+in depot.nix.buildLisp.library {
+  name = "closer-mop";
+
+  srcs = [
+    "${src}/closer-mop-packages.lisp"
+    "${src}/closer-mop-shared.lisp"
+    {
+      sbcl = "${src}/closer-sbcl.lisp";
+      ecl = "${src}/closer-ecl.lisp";
+      ccl = "${src}/closer-clozure.lisp";
+    }
+  ];
+}
diff --git a/third_party/lisp/closure-common.nix b/third_party/lisp/closure-common.nix
new file mode 100644
index 000000000000..7f7f79f8551b
--- /dev/null
+++ b/third_party/lisp/closure-common.nix
@@ -0,0 +1,36 @@
+{ depot, pkgs, ... }:
+
+let
+  src = with pkgs; srcOnly lispPackages.closure-common;
+  getSrcs = builtins.map (p: "${src}/${p}");
+in
+depot.nix.buildLisp.library {
+  name = "closure-common";
+
+  # closure-common.asd surpresses some warnings otherwise breaking
+  # compilation. Feature macros across implementations:
+  #
+  # ECL  #+rune-is-character #-rune-is-integer #-x&y-streams-are-stream
+  # CCL  #+rune-is-character #-rune-is-integer #-x&y-streams-are-stream
+  # SBCL #+rune-is-character #-rune-is-integer #-x&y-streams-are-stream
+  #
+  # Since all implementations agree, the alternative files aren't encoded here.
+  srcs = getSrcs [
+    "closure-common.asd"
+    "package.lisp"
+    "definline.lisp"
+    "characters.lisp" #+rune-is-character
+    "syntax.lisp"
+    "encodings.lisp" #-x&y-streams-are-stream
+    "encodings-data.lisp" #-x&y-streams-are-stream
+    "xstream.lisp" #-x&y-streams-are-stream
+    "ystream.lisp" #-x&y-streams-are-stream
+    "hax.lisp"
+  ];
+
+  deps = [
+    (depot.nix.buildLisp.bundled "asdf")
+    depot.third_party.lisp.trivial-gray-streams
+    depot.third_party.lisp.babel #+rune-is-character
+  ];
+}
diff --git a/third_party/lisp/closure-html/default.nix b/third_party/lisp/closure-html/default.nix
new file mode 100644
index 000000000000..1886ea2ec9a2
--- /dev/null
+++ b/third_party/lisp/closure-html/default.nix
@@ -0,0 +1,65 @@
+{ depot, pkgs, ... }:
+
+let
+  src = pkgs.applyPatches {
+    name = "closure-html-source";
+    src = pkgs.lispPackages.closure-html.src;
+
+    patches = [
+      # delete unexported and unused double defun in sgml-dtd.lisp
+      # which reference undefined CL-USER:*HTML-DTD* (!) which
+      # unlike CLOSURE-HTML:*HTML-DTD* is not involved in the
+      # packages operation.
+      ./no-double-defun.patch
+      # Patches html-parser.lisp to look for the distributed
+      # dtd files and catalog in this source derivations out
+      # path in the nix store instead of the same directory
+      # relatively to the (built) system.
+      ./dtds-from-store.patch
+    ];
+
+    postPatch = ''
+      # Inject file which defines CLOSURE-HTML:*HTML-DTD*
+      # early in the package's build since SBCL otherwise
+      # fails due to the undefined variable. Need to inject
+      # this via postPatch since using a nix file results
+      # in failure to look up the file's true name which
+      # is done for … reasons, apparently.
+      cat > src/define-html-dtd.lisp << EOF
+      (in-package :closure-html)
+      (defvar *html-dtd*)
+      EOF
+
+      # Substitute reference to @out@ of this source
+      # directory in this patched file.
+      substituteAllInPlace src/parse/html-parser.lisp
+    '';
+  };
+
+  getSrcs = builtins.map (p: "${src}/${p}");
+in
+
+depot.nix.buildLisp.library {
+  name = "closure-html";
+
+  srcs = getSrcs [
+    "src/defpack.lisp"
+    "src/define-html-dtd.lisp"
+    "src/glisp/util.lisp"
+    "src/util/clex.lisp"
+    "src/util/lalr.lisp"
+    "src/net/mime.lisp"
+    "src/parse/pt.lisp"
+    "src/parse/sgml-dtd.lisp"
+    "src/parse/sgml-parse.lisp"
+    "src/parse/html-parser.lisp"
+    "src/parse/lhtml.lisp"
+    "src/parse/unparse.lisp"
+    "src/parse/documentation.lisp"
+  ];
+
+  deps = [
+    depot.third_party.lisp.flexi-streams
+    depot.third_party.lisp.closure-common
+  ];
+}
diff --git a/third_party/lisp/closure-html/dtds-from-store.patch b/third_party/lisp/closure-html/dtds-from-store.patch
new file mode 100644
index 000000000000..a9ffd8085e89
--- /dev/null
+++ b/third_party/lisp/closure-html/dtds-from-store.patch
@@ -0,0 +1,16 @@
+diff --git a/src/parse/html-parser.lisp b/src/parse/html-parser.lisp
+index 4e45b81..5025a26 100644
+--- a/src/parse/html-parser.lisp
++++ b/src/parse/html-parser.lisp
+@@ -36,10 +36,7 @@
+         (make-pathname
+ 	 :name nil
+ 	 :type nil
+-	 :defaults (merge-pathnames
+-		    "resources/"
+-		    (asdf:component-relative-pathname
+-		     (asdf:find-system :closure-html))))))
++	 :defaults "@out@/resources/")))
+     (loop
+        :for (name . filename)
+        :in '(("-//W3O//DTD W3 HTML 3.0//EN" . "dtd/HTML-3.0")
diff --git a/third_party/lisp/closure-html/no-double-defun.patch b/third_party/lisp/closure-html/no-double-defun.patch
new file mode 100644
index 000000000000..ce7fb33abff1
--- /dev/null
+++ b/third_party/lisp/closure-html/no-double-defun.patch
@@ -0,0 +1,78 @@
+diff --git a/src/parse/sgml-dtd.lisp b/src/parse/sgml-dtd.lisp
+index de774c0..dbee852 100644
+--- a/src/parse/sgml-dtd.lisp
++++ b/src/parse/sgml-dtd.lisp
+@@ -624,73 +624,6 @@
+           (return))))
+     classes))
+ 
+-;;;; ----------------------------------------------------------------------------------------------------
+-;;;;  Compiled DTDs
+-;;;;
+-
+-;; Since parsing and 'compiling' DTDs is slow, I'll provide for a way
+-;; to (un)dump compiled DTD to stream.
+-
+-(defun dump-dtd (dtd sink)
+-  (let ((*print-pretty* nil)
+-        (*print-readably* t)
+-        (*print-circle* t))
+-    (princ "#." sink)
+-    (prin1
+-     `(MAKE-DTD :NAME ',(dtd-name dtd)
+-                :ELEMENTS (LET ((R (MAKE-HASH-TABLE :TEST #'EQ)))
+-                               (SETF ,@(let ((q nil))
+-                                         (maphash (lambda (key value)
+-                                                    (push `',value q)
+-                                                    (push `(GETHASH ',key R) q))
+-                                                  (dtd-elements dtd))
+-                                         q))
+-                               R)
+-                :ENTITIES ',(dtd-entities dtd)
+-                :RESOLVE-INFO (LET ((R (MAKE-HASH-TABLE :TEST #'EQUAL))) 
+-                                   (SETF ,@(let ((q nil))
+-                                             (maphash (lambda (key value)
+-                                                        (push `',value q)
+-                                                        (push `(GETHASH ',key R) q))
+-                                                      (dtd-resolve-info dtd))
+-                                             q))
+-                                   R)
+-                ;; XXX surclusion-cache fehlt
+-                )
+-     sink)))
+-
+-;;XXX
+-(defun save-html-dtd ()
+-  (with-open-file (sink "html-dtd.lisp" :direction :output :if-exists :new-version)
+-    (print `(in-package :sgml) sink)
+-    (let ((*package* (find-package :sgml)))
+-      (princ "(SETQ " sink)
+-      (prin1 'cl-user::*html-dtd* sink)
+-      (princ " '" sink)
+-      (dump-dtd cl-user::*html-dtd* sink)
+-      (princ ")" sink))))
+-
+-;;; --------------------------------------------------------------------------------
+-;;;  dumping DTDs
+-
+-
+-(defun dump-dtd (dtd filename)
+-  (let ((*foo* dtd))
+-    (declare (special *foo*))
+-    (with-open-file (sink (merge-pathnames filename "*.lisp")
+-                     :direction :output
+-                     :if-exists :new-version)
+-      (format sink "(in-package :sgml)(locally (declare (special *foo*))(setq *foo* '#.*foo*))"))
+-    (compile-file (merge-pathnames filename "*.lisp"))))
+-
+-(defun undump-dtd (filename)
+-  (let (*foo*)
+-    (declare (special *foo*))
+-    (load (compile-file-pathname (merge-pathnames filename "*.lisp"))
+-          :verbose nil
+-          :print nil)
+-    *foo*))
+-
+ (defmethod make-load-form ((self dtd) &optional env)
+   (declare (ignore env))
+   `(make-dtd :name                  ',(dtd-name self)
diff --git a/third_party/lisp/defclass-std.nix b/third_party/lisp/defclass-std.nix
new file mode 100644
index 000000000000..c31ddb3c5b74
--- /dev/null
+++ b/third_party/lisp/defclass-std.nix
@@ -0,0 +1,16 @@
+# A shortcut macro to write DEFCLASS forms quickly
+# Seems to be unmaintained (since early 2021)
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.defclass-std;
+in depot.nix.buildLisp.library {
+  name = "defclass-std";
+  deps = with depot.third_party.lisp; [
+    alexandria
+    anaphora
+  ];
+
+  srcs = map (f: src + ("/src/" + f)) [
+    "defclass-std.lisp"
+  ];
+}
diff --git a/third_party/lisp/drakma.nix b/third_party/lisp/drakma.nix
new file mode 100644
index 000000000000..607f438d7e72
--- /dev/null
+++ b/third_party/lisp/drakma.nix
@@ -0,0 +1,34 @@
+# Drakma is an HTTP client for Common Lisp.
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.drakma;
+in depot.nix.buildLisp.library {
+  name = "drakma";
+  deps = with depot.third_party.lisp; [
+    chipz
+    chunga
+    cl-base64
+    cl-plus-ssl
+    cl-ppcre
+    flexi-streams
+    puri
+    usocket
+    (depot.nix.buildLisp.bundled "asdf")
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "drakma.asd" # Required because the system definition is used
+    "packages.lisp"
+    "specials.lisp"
+    "conditions.lisp"
+    "util.lisp"
+    "read.lisp"
+    "cookies.lisp"
+    "encoding.lisp"
+    "request.lisp"
+  ];
+
+  brokenOn = [
+    "ecl" # dynamic cffi
+  ];
+}
diff --git a/third_party/lisp/easy-routes.nix b/third_party/lisp/easy-routes.nix
new file mode 100644
index 000000000000..5caf8261fa1c
--- /dev/null
+++ b/third_party/lisp/easy-routes.nix
@@ -0,0 +1,30 @@
+{ depot, pkgs, ... }:
+
+let
+
+  src = pkgs.fetchFromGitHub {
+    owner = "mmontone";
+    repo = "easy-routes";
+    rev = "dab613ff419a655036a00beecee026ab6e0ba430";
+    sha256 = "06lnipwc6mmg0v5gybcnr7wn5xmn5xfd1gs19vbima777245bfka";
+  };
+
+in
+depot.nix.buildLisp.library {
+  name = "easy-routes";
+  deps = with depot.third_party.lisp; [
+    hunchentoot
+    routes
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "util.lisp"
+    "easy-routes.lisp"
+    "routes-map-printer.lisp"
+  ];
+
+  brokenOn = [
+    "ecl" # dynamic cffi
+  ];
+}
diff --git a/third_party/lisp/fiveam.nix b/third_party/lisp/fiveam.nix
new file mode 100644
index 000000000000..500e980a819a
--- /dev/null
+++ b/third_party/lisp/fiveam.nix
@@ -0,0 +1,29 @@
+# FiveAM is a Common Lisp testing framework.
+#
+# Imported from https://github.com/sionescu/fiveam.git
+
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.fiveam;
+in depot.nix.buildLisp.library {
+  name = "fiveam";
+
+  deps = with depot.third_party.lisp; [
+    alexandria
+    asdf-flv
+    trivial-backtrace
+  ];
+
+  srcs = map (f: src + ("/src/" + f)) [
+    "package.lisp"
+    "utils.lisp"
+    "check.lisp"
+    "fixture.lisp"
+    "classes.lisp"
+    "random.lisp"
+    "test.lisp"
+    "explain.lisp"
+    "suite.lisp"
+    "run.lisp"
+  ];
+}
diff --git a/third_party/lisp/flexi-streams.nix b/third_party/lisp/flexi-streams.nix
new file mode 100644
index 000000000000..a6a06d4ad057
--- /dev/null
+++ b/third_party/lisp/flexi-streams.nix
@@ -0,0 +1,33 @@
+# Flexible bivalent streams for Common Lisp
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.flexi-streams;
+in depot.nix.buildLisp.library {
+  name = "flexi-streams";
+  deps = [ depot.third_party.lisp.trivial-gray-streams ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "packages.lisp"
+    "mapping.lisp"
+    "ascii.lisp"
+    "koi8-r.lisp"
+    "mac.lisp"
+    "iso-8859.lisp"
+    "enc-cn-tbl.lisp"
+    "code-pages.lisp"
+    "specials.lisp"
+    "util.lisp"
+    "conditions.lisp"
+    "external-format.lisp"
+    "length.lisp"
+    "encode.lisp"
+    "decode.lisp"
+    "in-memory.lisp"
+    "stream.lisp"
+    "output.lisp"
+    "input.lisp"
+    "io.lisp"
+    "strings.lisp"
+  ];
+}
+
diff --git a/third_party/lisp/global-vars.nix b/third_party/lisp/global-vars.nix
new file mode 100644
index 000000000000..a3d27a09b6a0
--- /dev/null
+++ b/third_party/lisp/global-vars.nix
@@ -0,0 +1,7 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.global-vars;
+in depot.nix.buildLisp.library {
+  name = "global-vars";
+  srcs = [ "${src}/global-vars.lisp" ];
+}
diff --git a/third_party/lisp/hunchentoot.nix b/third_party/lisp/hunchentoot.nix
new file mode 100644
index 000000000000..e2480cd349f1
--- /dev/null
+++ b/third_party/lisp/hunchentoot.nix
@@ -0,0 +1,62 @@
+# Hunchentoot is a web framework for Common Lisp.
+{ depot, pkgs, ... }:
+
+let
+  src = with pkgs; srcOnly lispPackages.hunchentoot;
+
+  url-rewrite = depot.nix.buildLisp.library {
+    name = "url-rewrite";
+
+    srcs = map (f: src + ("/url-rewrite/" + f)) [
+      "packages.lisp"
+      "specials.lisp"
+      "primitives.lisp"
+      "util.lisp"
+      "url-rewrite.lisp"
+    ];
+  };
+in
+depot.nix.buildLisp.library {
+  name = "hunchentoot";
+
+  deps = with depot.third_party.lisp; [
+    alexandria
+    bordeaux-threads
+    chunga
+    cl-base64
+    cl-fad
+    rfc2388
+    cl-plus-ssl
+    cl-ppcre
+    flexi-streams
+    md5
+    trivial-backtrace
+    usocket
+    url-rewrite
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "hunchentoot.asd"
+    "packages.lisp"
+    "compat.lisp"
+    "specials.lisp"
+    "conditions.lisp"
+    "mime-types.lisp"
+    "util.lisp"
+    "log.lisp"
+    "cookie.lisp"
+    "reply.lisp"
+    "request.lisp"
+    "session.lisp"
+    "misc.lisp"
+    "headers.lisp"
+    "set-timeouts.lisp"
+    "taskmaster.lisp"
+    "acceptor.lisp"
+    "easy-handlers.lisp"
+  ];
+
+  brokenOn = [
+    "ecl" # dynamic cffi
+  ];
+}
diff --git a/third_party/lisp/ironclad.nix b/third_party/lisp/ironclad.nix
new file mode 100644
index 000000000000..324c5da265d8
--- /dev/null
+++ b/third_party/lisp/ironclad.nix
@@ -0,0 +1,163 @@
+{ depot, pkgs, ... }:
+
+let
+  inherit (pkgs) runCommand;
+  inherit (depot.nix.buildLisp) bundled;
+  src = with pkgs; srcOnly lispPackages.ironclad;
+  getSrc = f: "${src}/src/${f}";
+
+in
+depot.nix.buildLisp.library {
+  name = "ironclad";
+
+  deps = with depot.third_party.lisp; [
+    (bundled "asdf")
+    { sbcl = bundled "sb-rotate-byte"; }
+    { sbcl = bundled "sb-posix"; }
+    alexandria
+    bordeaux-threads
+    nibbles
+  ];
+
+  srcs = map getSrc [
+    # {
+    #   # TODO(grfn): Figure out how to get this compiling with the assembly
+    #   # optimization eventually - see https://cl.tvl.fyi/c/depot/+/1333
+    #   sbcl = runCommand "package.lisp" {} ''
+    #     substitute ${src}/src/package.lisp $out \
+    #       --replace \#-ecl-bytecmp "" \
+    #       --replace '(pushnew :ironclad-assembly *features*)' ""
+    #   '';
+    #   default = getSrc "package.lisp";
+    # }
+    "package.lisp"
+    "conditions.lisp"
+    "generic.lisp"
+    "macro-utils.lisp"
+    "util.lisp"
+  ] ++ [
+    { sbcl = getSrc "opt/sbcl/fndb.lisp"; }
+    { sbcl = getSrc "opt/sbcl/cpu-features.lisp"; }
+    { sbcl = getSrc "opt/sbcl/x86oid-vm.lisp"; }
+
+    { ecl = getSrc "opt/ecl/c-functions.lisp"; }
+
+    { ccl = getSrc "opt/ccl/x86oid-vm.lisp"; }
+  ] ++ map getSrc [
+    "common.lisp"
+
+    "ciphers/cipher.lisp"
+    "ciphers/padding.lisp"
+    "ciphers/make-cipher.lisp"
+    "ciphers/modes.lisp"
+
+    # subsystem def ironclad/ciphers
+    "ciphers/aes.lisp"
+    "ciphers/arcfour.lisp"
+    "ciphers/aria.lisp"
+    "ciphers/blowfish.lisp"
+    "ciphers/camellia.lisp"
+    "ciphers/cast5.lisp"
+    "ciphers/chacha.lisp"
+    "ciphers/des.lisp"
+    "ciphers/idea.lisp"
+    "ciphers/kalyna.lisp"
+    "ciphers/kuznyechik.lisp"
+    "ciphers/misty1.lisp"
+    "ciphers/rc2.lisp"
+    "ciphers/rc5.lisp"
+    "ciphers/rc6.lisp"
+    "ciphers/salsa20.lisp"
+    "ciphers/keystream.lisp"
+    "ciphers/seed.lisp"
+    "ciphers/serpent.lisp"
+    "ciphers/sm4.lisp"
+    "ciphers/sosemanuk.lisp"
+    "ciphers/square.lisp"
+    "ciphers/tea.lisp"
+    "ciphers/threefish.lisp"
+    "ciphers/twofish.lisp"
+    "ciphers/xchacha.lisp"
+    "ciphers/xor.lisp"
+    "ciphers/xsalsa20.lisp"
+    "ciphers/xtea.lisp"
+
+    "digests/digest.lisp"
+    # subsystem def ironclad/digests
+    "digests/adler32.lisp"
+    "digests/blake2.lisp"
+    "digests/blake2s.lisp"
+    "digests/crc24.lisp"
+    "digests/crc32.lisp"
+    "digests/groestl.lisp"
+    "digests/jh.lisp"
+    "digests/kupyna.lisp"
+    "digests/md2.lisp"
+    "digests/md4.lisp"
+    "digests/md5.lisp"
+    "digests/md5-lispworks-int32.lisp"
+    "digests/ripemd-128.lisp"
+    "digests/ripemd-160.lisp"
+    "digests/sha1.lisp"
+    "digests/sha256.lisp"
+    "digests/sha3.lisp"
+    "digests/sha512.lisp"
+    "digests/skein.lisp"
+    "digests/sm3.lisp"
+    "digests/streebog.lisp"
+    "digests/tiger.lisp"
+    "digests/tree-hash.lisp"
+    "digests/whirlpool.lisp"
+
+    "macs/mac.lisp"
+    # subsystem def ironclad/macs
+    "macs/blake2-mac.lisp"
+    "macs/blake2s-mac.lisp"
+    "macs/cmac.lisp"
+    "macs/hmac.lisp"
+    "macs/gmac.lisp"
+    "macs/poly1305.lisp"
+    "macs/siphash.lisp"
+    "macs/skein-mac.lisp"
+
+    "prng/prng.lisp"
+    "prng/os-prng.lisp"
+    "prng/generator.lisp"
+    "prng/fortuna.lisp"
+
+    "math.lisp"
+
+    "octet-stream.lisp"
+
+    "aead/aead.lisp"
+    # subsystem def ironclad/aead
+    "aead/eax.lisp"
+    "aead/etm.lisp"
+    "aead/gcm.lisp"
+
+    "kdf/kdf.lisp"
+    # subsystem def ironclad/kdfs
+    "kdf/argon2.lisp"
+    "kdf/bcrypt.lisp"
+    "kdf/hmac.lisp"
+    "kdf/pkcs5.lisp"
+    "kdf/password-hash.lisp"
+    "kdf/scrypt.lisp"
+
+    "public-key/public-key.lisp"
+    "public-key/pkcs1.lisp"
+    "public-key/elliptic-curve.lisp"
+    # subsystem def ironclad/public-keys
+    "public-key/dsa.lisp"
+    "public-key/rsa.lisp"
+    "public-key/elgamal.lisp"
+    "public-key/curve25519.lisp"
+    "public-key/curve448.lisp"
+    "public-key/ed25519.lisp"
+    "public-key/ed448.lisp"
+    "public-key/secp256k1.lisp"
+    "public-key/secp256r1.lisp"
+    "public-key/secp384r1.lisp"
+    "public-key/secp521r1.lisp"
+  ];
+}
diff --git a/third_party/lisp/iterate.nix b/third_party/lisp/iterate.nix
new file mode 100644
index 000000000000..b7d60265ac37
--- /dev/null
+++ b/third_party/lisp/iterate.nix
@@ -0,0 +1,12 @@
+# iterate is an iteration construct for Common Lisp, similar to the
+# LOOP macro.
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.iterate;
+in depot.nix.buildLisp.library {
+  name = "iterate";
+  srcs = [
+    "${src}/package.lisp"
+    "${src}/iterate.lisp"
+  ];
+}
diff --git a/third_party/lisp/lass.nix b/third_party/lisp/lass.nix
new file mode 100644
index 000000000000..00f66c1fe314
--- /dev/null
+++ b/third_party/lisp/lass.nix
@@ -0,0 +1,35 @@
+{ depot, pkgs, ... }:
+
+let
+  src = pkgs.fetchFromGitHub {
+    owner = "Shinmera";
+    repo = "LASS";
+    rev = "f51b9e941ee0a2a1f76ba814dcef22f9fb5f69bf";
+    sha256 = "11mxzyx34ynsfsrs8pgrarqi9s442vkpmh7kdpzvarhj7i97g8yx";
+  };
+
+in
+depot.nix.buildLisp.library {
+  name = "lass";
+
+  deps = with depot.third_party.lisp; [
+    trivial-indent
+    trivial-mimes
+    physical-quantities
+    parse-float
+    cl-base64
+    (depot.nix.buildLisp.bundled "asdf")
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "readable-list.lisp"
+    "compiler.lisp"
+    "property-funcs.lisp"
+    "writer.lisp"
+    "lass.lisp"
+    "special.lisp"
+    "units.lisp"
+    "asdf.lisp"
+  ];
+}
diff --git a/third_party/lisp/let-plus.nix b/third_party/lisp/let-plus.nix
new file mode 100644
index 000000000000..bd7f31dfa0de
--- /dev/null
+++ b/third_party/lisp/let-plus.nix
@@ -0,0 +1,15 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.let-plus;
+in depot.nix.buildLisp.library {
+  name = "let-plus";
+  deps = [
+    depot.third_party.lisp.alexandria
+    depot.third_party.lisp.anaphora
+  ];
+  srcs = [
+    "${src}/package.lisp"
+    "${src}/let-plus.lisp"
+    "${src}/extensions.lisp"
+  ];
+}
diff --git a/third_party/lisp/lisp-binary.nix b/third_party/lisp/lisp-binary.nix
new file mode 100644
index 000000000000..296112cc9e9a
--- /dev/null
+++ b/third_party/lisp/lisp-binary.nix
@@ -0,0 +1,33 @@
+# A library to easily read and write complex binary formats.
+{ depot, pkgs, ... }:
+
+let
+  src = pkgs.srcOnly pkgs.lispPackages.lisp-binary;
+in
+depot.nix.buildLisp.library {
+  name = "lisp-binary";
+
+  deps = with depot.third_party.lisp; [
+    alexandria
+    cffi
+    closer-mop
+    flexi-streams
+    moptilities
+    quasiquote_2
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "utils.lisp"
+    "integer.lisp"
+    "float.lisp"
+    "simple-bit-stream.lisp"
+    "reverse-stream.lisp"
+    "binary-1.lisp"
+    "binary-2.lisp"
+    "types.lisp"
+  ];
+
+  brokenOn = [
+    "ecl" # TODO(sterni): disable conditionally cffi for ECL
+  ];
+}
diff --git a/third_party/lisp/local-time.nix b/third_party/lisp/local-time.nix
new file mode 100644
index 000000000000..1358408d387c
--- /dev/null
+++ b/third_party/lisp/local-time.nix
@@ -0,0 +1,22 @@
+# Library for manipulating dates & times
+{ depot, pkgs, ... }:
+
+let
+  inherit (depot.nix) buildLisp;
+  src = with pkgs; srcOnly lispPackages.local-time;
+in
+buildLisp.library {
+  name = "local-time";
+  deps = [
+    depot.third_party.lisp.cl-fad
+    {
+      scbl = buildLisp.bundled "uiop";
+      default = buildLisp.bundled "asdf";
+    }
+  ];
+
+  srcs = [
+    "${src}/src/package.lisp"
+    "${src}/src/local-time.lisp"
+  ];
+}
diff --git a/third_party/lisp/marshal.nix b/third_party/lisp/marshal.nix
new file mode 100644
index 000000000000..73a1664a0162
--- /dev/null
+++ b/third_party/lisp/marshal.nix
@@ -0,0 +1,13 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.marshal;
+in depot.nix.buildLisp.library {
+  name = "marshal";
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "serialization-format.lisp"
+    "coding-idiom.lisp"
+    "marshal.lisp"
+    "unmarshal.lisp"
+  ];
+}
diff --git a/third_party/lisp/md5.nix b/third_party/lisp/md5.nix
new file mode 100644
index 000000000000..8c3e255f166b
--- /dev/null
+++ b/third_party/lisp/md5.nix
@@ -0,0 +1,16 @@
+# MD5 hash implementation
+{ depot, pkgs, ... }:
+
+with depot.nix;
+
+let src = with pkgs; srcOnly lispPackages.md5;
+in buildLisp.library {
+  name = "md5";
+  deps = [
+    {
+      sbcl = buildLisp.bundled "sb-rotate-byte";
+      default = depot.third_party.lisp.flexi-streams;
+    }
+  ];
+  srcs = [ (src + "/md5.lisp") ];
+}
diff --git a/third_party/lisp/metabang-bind.nix b/third_party/lisp/metabang-bind.nix
new file mode 100644
index 000000000000..fc046d08951a
--- /dev/null
+++ b/third_party/lisp/metabang-bind.nix
@@ -0,0 +1,16 @@
+{ depot, pkgs, ... }:
+
+let
+  getSrcs = builtins.map (p: "${pkgs.srcOnly pkgs.lispPackages.metabang-bind}/${p}");
+in
+
+depot.nix.buildLisp.library {
+  name = "metabang-bind";
+
+  srcs = getSrcs [
+    "dev/packages.lisp"
+    "dev/macros.lisp"
+    "dev/bind.lisp"
+    "dev/binding-forms.lisp"
+  ];
+}
diff --git a/third_party/lisp/mime4cl/.skip-subtree b/third_party/lisp/mime4cl/.skip-subtree
new file mode 100644
index 000000000000..5051f60d6b86
--- /dev/null
+++ b/third_party/lisp/mime4cl/.skip-subtree
@@ -0,0 +1 @@
+prevent readTree from creating entries for subdirs that don't contain an .nix files
diff --git a/third_party/lisp/mime4cl/OWNERS b/third_party/lisp/mime4cl/OWNERS
new file mode 100644
index 000000000000..2e9580706346
--- /dev/null
+++ b/third_party/lisp/mime4cl/OWNERS
@@ -0,0 +1 @@
+sterni
diff --git a/third_party/lisp/mime4cl/README.md b/third_party/lisp/mime4cl/README.md
new file mode 100644
index 000000000000..2704d481ed3c
--- /dev/null
+++ b/third_party/lisp/mime4cl/README.md
@@ -0,0 +1,27 @@
+# mime4cl
+
+`MIME4CL` is a Common Lisp library for dealing with MIME messages. It was
+originally been written by Walter C. Pelissero and vendored into depot
+([mime4cl-20150207T211851.tbz](http://wcp.sdf-eu.org/software/mime4cl-20150207T211851.tbz)
+to be exact) as upstream has become inactive. Its [original
+website](http://wcp.sdf-eu.org/software/#mime4cl) can still be accessed.
+
+The depot version has since diverged from upstream. Main aims were to improve
+performance and reduce code size by relying on third party libraries like
+flexi-streams. It is planned to improve encoding handling in the long term.
+Currently, the library is being worked on intermittently and not very well
+tested—**it may not work as expected**.
+
+## Differences from the original version
+
+* `//nix/buildLisp` is used as the build system. ASDF is currently untested and
+  may be broken.
+
+* The dependency on [sclf](http://wcp.sdf-eu.org/software/#sclf) has been
+  eliminated by inlining the relevant parts.
+
+* `MY-STRING-INPUT-STREAM`, `DELIMITED-INPUT-STREAM`,
+  `CHARACTER-INPUT-ADAPTER-STREAM`, `BINARY-INPUT-ADAPTER-STREAM` etc. have been
+  replaced by (thin wrappers around) flexi-streams. In addition to improved
+  handling of encodings, this allows using `READ-SEQUENCE` via the gray stream
+  interface.
diff --git a/third_party/lisp/mime4cl/address.lisp b/third_party/lisp/mime4cl/address.lisp
new file mode 100644
index 000000000000..42688a595b26
--- /dev/null
+++ b/third_party/lisp/mime4cl/address.lisp
@@ -0,0 +1,300 @@
+;;;  address.lisp --- e-mail address parser
+
+;;;  Copyright (C) 2007, 2008, 2009 by Walter C. Pelissero
+;;;  Copyright (C) 2022-2023 The TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+;;;  Although not MIME specific, this parser is often useful together
+;;;  with the MIME primitives.  It should be able to parse the address
+;;;  syntax described in RFC2822 excluding the obsolete syntax (see
+;;;  RFC822).  Have a look at the test suite to get an idea of what
+;;;  kind of addresses it can parse.
+
+(in-package :mime4cl)
+
+(defstruct (mailbox (:conc-name mbx-))
+  description
+  user
+  host
+  domain)
+
+(defstruct (mailbox-group (:conc-name mbxg-))
+  name
+  mailboxes)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun write-mailbox-domain-name (addr &optional (stream *standard-output*))
+  (when (eq :internet (mbx-domain addr))
+    (write-char #\[ stream))
+  (write-string (mbx-host addr) stream)
+  (when (eq :internet (mbx-domain addr))
+    (write-char #\] stream))
+  (when (stringp (mbx-domain addr))
+    (write-char #\. stream)
+    (write-string (mbx-domain addr) stream)))
+
+(defun write-mailbox-address (addr &optional (stream *standard-output*))
+  (write-string (mbx-user addr) stream)
+  (when (mbx-host addr)
+    (write-char #\@ stream)
+    (write-mailbox-domain-name addr stream)))
+
+(defmethod mbx-domain-name ((MBX mailbox))
+  "Return the complete domain name string of MBX, in the form
+\"host.domain\"."
+  (with-output-to-string (out)
+    (write-mailbox-domain-name mbx out)))
+
+(defmethod mbx-address ((mbx mailbox))
+  "Return the e-mail address string of MBX, in the form
+\"user@host.domain\"."
+  (with-output-to-string (out)
+    (write-mailbox-address mbx out)))
+
+(defun write-mailbox (addr &optional (stream *standard-output*))
+  (awhen (mbx-description addr)
+    (write it :stream stream :readably t)
+    (write-string " <" stream))
+  (write-mailbox-address addr stream)
+  (awhen (mbx-description addr)
+    (write-char #\> stream)))
+
+(defun write-mailbox-group (grp &optional (stream *standard-output*))
+  (write-string (mbxg-name grp) stream)
+  (write-string ": " stream)
+  (loop
+     for mailboxes on (mbxg-mailboxes grp)
+     for mailbox = (car mailboxes)
+     do (write-mailbox mailbox stream)
+     unless (endp (cdr mailboxes))
+     do (write-string ", " stream))
+  (write-char #\; stream))
+
+(defmethod print-object ((mbx mailbox) stream)
+  (if (or *print-readably* *print-escape*)
+      (call-next-method)
+      (write-mailbox mbx stream)))
+
+(defmethod print-object ((grp mailbox-group) stream)
+  (if (or *print-readably* *print-escape*)
+      (call-next-method)
+      (write-mailbox-group grp stream)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun parser-make-mailbox (description address-list)
+  (make-mailbox :description description
+                :user (car address-list)
+                :host (cadr address-list)
+                :domain (when (cddr address-list)
+                          (string-concat (cddr address-list) "."))))
+
+
+(defun populate-grammar ()
+  (defrule address-list
+      := (+ address ","))
+
+  (defrule address
+      := mailbox
+      := group)
+
+  (defrule mailbox
+      := display-name? angle-addr comment?
+      :reduce (parser-make-mailbox (or display-name comment) angle-addr)
+      := addr-spec comment?
+      :reduce (parser-make-mailbox comment addr-spec))
+
+  (defrule angle-addr
+      := "<" addr-spec ">")
+
+  (defrule group
+      := display-name ":" mailbox-list ";"
+      :reduce (make-mailbox-group :name display-name :mailboxes mailbox-list))
+
+  (defrule display-name
+      := phrase
+      :reduce (string-concat phrase " "))
+
+  (defrule phrase
+      := word+)
+
+  (defrule word
+      := atext
+      := string)
+
+  (defrule mailbox-list
+      := (+ mailbox ","))
+
+  (defrule addr-spec
+      := local-part "@" domain :reduce (cons local-part domain))
+
+  (defrule local-part
+      := dot-atom :reduce (string-concat dot-atom ".")
+      := string)
+
+  (defrule domain
+      := dot-atom
+      := domain-literal :reduce (list domain-literal :internet))
+
+  ;; actually, according to the RFC, dot-atoms don't allow spaces in
+  ;; between but these rules do
+  (defrule dot-atom
+      := (+ atom "."))
+
+  (defrule atom
+      := atext+
+      :reduce (apply #'concatenate 'string atext)))
+
+(deflazy define-grammar
+  (let ((*package* #.*package*)
+        (*compile-print* (when npg::*debug* t)))
+    (reset-grammar)
+    (format t "~&creating e-mail address grammar...~%")
+    (populate-grammar)
+    (let ((grammar (npg:generate-grammar #'string=)))
+      (reset-grammar)
+      (npg:print-grammar-figures grammar)
+      grammar)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; The lexical analyser
+
+(defstruct cursor
+  stream
+  (position 0))
+
+(defun read-delimited-string (stream end-char &key nesting-start-char (escape-char #\\))
+  (labels ((collect ()
+             (with-output-to-string (out)
+               (loop
+                  for c = (read-char stream nil)
+                  while (and c (not (char= c end-char)))
+                  do (cond ((char= c escape-char)
+                            (awhen (read-char stream nil)
+                              (write-char it out)))
+                           ((and nesting-start-char
+                                 (char= c nesting-start-char))
+                            (write-char nesting-start-char out)
+                            (write-string (collect) out)
+                            (write-char end-char out))
+                           (t (write-char c out)))))))
+    (collect)))
+
+
+(defun read-string (cursor)
+  (make-token :type 'string
+              :value (read-delimited-string (cursor-stream cursor) #\")
+              :position (incf (cursor-position cursor))))
+
+(defun read-domain-literal (cursor)
+  (make-token :type 'domain-literal
+              :value (read-delimited-string (cursor-stream cursor) #\])
+              :position (incf (cursor-position cursor))))
+
+(defun read-comment (cursor)
+  (make-token :type 'comment
+              :value (read-delimited-string (cursor-stream cursor) #\) :nesting-start-char #\()
+              :position (incf (cursor-position cursor))))
+
+(declaim (inline atom-component-p))
+(defun atom-component-p (c)
+  (declare (type character c))
+  (not (find c " ()\"[]@.<>:;,")))
+
+(defun read-atext (first-character cursor)
+  (let ((string (with-output-to-string (out)
+                  (write-char first-character out)
+                  (loop
+                    for c = (read-char (cursor-stream cursor) nil)
+                    while (and c (atom-component-p c))
+                    do (write-char c out)
+                    finally (when c
+                              (unread-char c (cursor-stream cursor)))))))
+    (make-token :type 'atext
+                :value string
+                :position (incf (cursor-position cursor)))))
+
+(defmethod read-next-tokens ((cursor cursor))
+  (flet ((make-keyword (c)
+           (make-token :type 'keyword
+                       :value (string c)
+                       :position (incf (cursor-position cursor)))))
+    (let ((in (cursor-stream cursor)))
+      (loop
+         for c = (read-char in nil)
+         while c
+         unless (whitespace-p c)
+         return (list
+                 (cond ((char= #\( c)
+                        (read-comment cursor))
+                       ((char= #\" c)
+                        (read-string cursor))
+                       ((char= #\[ c)
+                        (read-domain-literal cursor))
+                       ((find c "@.<>:;,")
+                        (make-keyword c))
+                       (t
+                        ;; anything else is considered a text atom even
+                        ;; though it's just a single character
+                        (read-atext c cursor))))))))
+
+(defun analyse-string (string)
+  "Return the list of tokens produced by a lexical analysis of
+STRING.  These are the tokens that would be seen by the parser."
+  (with-input-from-string (stream string)
+    (let ((cursor (make-cursor :stream stream)))
+      (loop
+         for tokens = (read-next-tokens cursor)
+         until (endp tokens)
+         append tokens))))
+
+(defun mailboxes-only (list-of-mailboxes-and-groups)
+  "Return a flat list of MAILBOX-ADDRESSes from
+LIST-OF-MAILBOXES-AND-GROUPS, which is the kind of list returned
+by PARSE-ADDRESSES.  This turns out to be useful when your
+program is not interested in mailbox groups and expects the user
+addresses only."
+  (mapcan #'(lambda (mbx)
+              (if (typep mbx 'mailbox-group)
+                  (mbxg-mailboxes mbx)
+                  (list mbx)))
+          list-of-mailboxes-and-groups))
+
+(defun parse-addresses (string &key no-groups)
+  "Parse STRING and return a list of MAILBOX-ADDRESSes or
+MAILBOX-GROUPs.  If STRING is unparsable return NIL.  If
+NO-GROUPS is true, return a flat list of mailboxes throwing away
+the group containers, if any."
+  (let ((grammar (force define-grammar)))
+    (with-input-from-string (stream string)
+      (let* ((cursor (make-cursor :stream stream))
+             (mailboxes (ignore-errors  ; ignore parsing errors
+                         (parse grammar 'address-list cursor))))
+        (if no-groups
+            (mailboxes-only mailboxes)
+            mailboxes)))))
+
+(defun debug-addresses (string)
+  "More or less like PARSE-ADDRESSES, but don't ignore parsing errors."
+  (let ((grammar (force define-grammar)))
+    (with-input-from-string (stream string)
+      (let ((cursor (make-cursor :stream stream)))
+        (parse grammar 'address-list cursor)))))
+
diff --git a/third_party/lisp/mime4cl/default.nix b/third_party/lisp/mime4cl/default.nix
new file mode 100644
index 000000000000..99b23c91aa69
--- /dev/null
+++ b/third_party/lisp/mime4cl/default.nix
@@ -0,0 +1,50 @@
+# Copyright (C) 2021 by the TVL Authors
+# SPDX-License-Identifier: LGPL-2.1-or-later
+{ depot, pkgs, ... }:
+
+depot.nix.buildLisp.library {
+  name = "mime4cl";
+
+  deps = [
+    depot.third_party.lisp.flexi-streams
+    depot.third_party.lisp.npg
+    depot.third_party.lisp.trivial-gray-streams
+    depot.third_party.lisp.qbase64
+  ];
+
+  srcs = [
+    ./ex-sclf.lisp
+    ./package.lisp
+    ./endec.lisp
+    ./streams.lisp
+    ./mime.lisp
+    ./address.lisp
+  ];
+
+  tests = {
+    name = "mime4cl-tests";
+
+    srcs = [
+      ./test/rt.lisp
+      ./test/package.lisp
+      (pkgs.writeText "nix-samples.lisp" ''
+        (in-package :mime4cl-tests)
+
+        ;; override auto discovery which doesn't work in the nix store
+        (defvar *samples-directory* (pathname "${./test/samples}/"))
+      '')
+      ./test/temp-file.lisp
+      ./test/endec.lisp
+      ./test/address.lisp
+      ./test/mime.lisp
+    ];
+
+    expression = "(rtest:do-tests)";
+  };
+
+  # limited by sclf
+  brokenOn = [
+    "ccl"
+    "ecl"
+  ];
+}
diff --git a/third_party/lisp/mime4cl/endec.lisp b/third_party/lisp/mime4cl/endec.lisp
new file mode 100644
index 000000000000..2e282c237822
--- /dev/null
+++ b/third_party/lisp/mime4cl/endec.lisp
@@ -0,0 +1,663 @@
+;;;  endec.lisp --- encoder/decoder functions
+
+;;;  Copyright (C) 2005-2008, 2010 by Walter C. Pelissero
+;;;  Copyright (C) 2023 by The TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+
+(in-package :mime4cl)
+
+(defun redirect-stream (in out &key (buffer-size 4096))
+  "Consume input stream IN and write all its content to output stream OUT.
+The streams' element types need to match."
+  (let ((buf (make-array buffer-size :element-type (stream-element-type in))))
+    (loop for pos = (read-sequence buf in)
+          while (> pos 0)
+          do (write-sequence buf out :end pos))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Thank you SBCL for rendering constants totally useless!
+(defparameter +base64-encode-table+
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=")
+
+(declaim (type simple-string +base64-encode-table+))
+
+(defvar *base64-line-length* 76
+  "Maximum length of the encoded base64 line.  NIL means it can
+be of unlimited length \(no line breaks will be done by the
+encoding function).")
+
+(defvar *quoted-printable-line-length* 72
+  "Maximum length of the encoded quoted printable line.  NIL
+means it can be of unlimited length \(no line breaks will be done
+by the encoding function).")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass decoder ()
+  ((input-function :initarg :input-function
+                   :reader decoder-input-function
+                   :type function
+                   :documentation
+                   "Function is called repeatedly by the decoder methods to get the next character.
+It should return a character os NIL (indicating EOF)."))
+  (:documentation
+   "Abstract base class for decoders."))
+
+(defclass parsing-decoder (decoder)
+  ((parser-errors :initform nil
+                  :initarg :parser-errors
+                  :reader decoder-parser-errors
+                  :type boolean))
+  (:documentation
+   "Abstract base class for decoders that do parsing."))
+
+(defclass encoder ()
+  ((output-function :initarg :output-function
+                    :reader encoder-output-function
+                    :type function
+                    :documentation
+                    "Function is called repeatedly by the encoder methods to output a character.
+It should expect a character as its only argument."))
+  (:documentation
+   "Abstract base class for encoders."))
+
+(defclass line-encoder (encoder)
+  ((column :initform 0
+           :type fixnum)
+   (line-length :initarg :line-length
+                :initform nil
+                :reader encoder-line-length
+                :type (or fixnum null)))
+  (:documentation
+   "Abstract base class for line encoders."))
+
+(defclass 8bit-decoder (decoder)
+  ()
+  (:documentation
+   "Class for decoders that do nothing."))
+
+(defclass 8bit-encoder (encoder)
+  ()
+  (:documentation
+   "Class for encoders that do nothing."))
+
+(defclass 7bit-decoder (decoder)
+  ()
+  (:documentation
+   "Class for decoders that do nothing."))
+
+(defclass 7bit-encoder (encoder)
+  ()
+  (:documentation
+   "Class for encoders that do nothing."))
+
+(defclass byte-decoder (decoder)
+  ()
+  (:documentation
+   "Class for decoders that turns chars to bytes."))
+
+(defclass byte-encoder (encoder)
+  ()
+  (:documentation
+   "Class for encoders that turns bytes to chars."))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric encoder-write-byte (encoder byte))
+(defgeneric encoder-finish-output (encoder))
+(defgeneric decoder-read-byte (decoder))
+
+(defmethod encoder-finish-output ((encoder encoder))
+  (values))
+
+(defmethod encoder-write-byte ((encoder 8bit-encoder) byte)
+  (funcall (slot-value encoder 'output-function)
+           (code-char byte))
+  (values))
+
+(defmethod decoder-read-byte ((decoder 8bit-decoder))
+  (awhen (funcall (slot-value decoder 'input-function))
+    (char-code it)))
+
+(defmethod encoder-write-byte ((encoder 7bit-encoder) byte)
+  (funcall (slot-value encoder 'output-function)
+           (code-char (logand #x7F byte)))
+  (values))
+
+(defmethod decoder-read-byte ((decoder 7bit-decoder))
+  (awhen (funcall (slot-value decoder 'input-function))
+    (logand #x7F (char-code it))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun decoder-read-sequence (sequence decoder &key (start 0) (end (length sequence)))
+  (declare (optimize (speed 3) (safety 0) (debug 0))
+           (type fixnum start end)
+           (type vector sequence))
+  (loop
+     for i fixnum from start below end
+     for byte = (decoder-read-byte decoder)
+     while byte
+     do (setf (aref sequence i) byte)
+     finally (return i)))
+
+(defun decoder-read-line (decoder)
+  (with-output-to-string (str)
+    (loop
+       for byte = (decoder-read-byte decoder)
+       unless byte
+       do (return-from decoder-read-line nil)
+       do (let ((c (code-char byte)))
+            (cond ((char= c #\return)
+                   ;; skip the newline
+                   (decoder-read-byte decoder)
+                   (return nil))
+                  ((char= c #\newline)
+                   ;; the #\return was missing
+                   (return nil))
+                  (t (write-char c str)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declaim (inline parse-hex))
+(defun parse-hex (c1 c2)
+  "Parse two characters as hexadecimal and return their combined
+value."
+  (declare (optimize (speed 3) (safety 0) (debug 0))
+           (type character c1 c2))
+  (flet ((digit-value (char)
+           (or (position char "0123456789ABCDEF")
+               (return-from parse-hex nil))))
+    (+ (* 16 (digit-value c1))
+       (digit-value c2))))
+
+(defclass quoted-printable-decoder (parsing-decoder)
+  ((saved-bytes :initform (make-queue))))
+
+(defmethod decoder-read-byte ((decoder quoted-printable-decoder))
+  (declare (optimize (speed 3) (safety 0) (debug 0)))
+  (with-slots (input-function saved-bytes parser-errors) decoder
+    (declare (type function input-function))
+    (labels ((saveb (b)
+               (queue-append saved-bytes b)
+               (values))
+             (save (c)
+               (saveb (char-code c)))
+             (push-next ()
+               (let ((c (funcall input-function)))
+                 (declare (type (or null character) c))
+                 (cond ((not c))
+                       ((or (char= c #\space)
+                            (char= c #\tab))
+                        (save c)
+                        (push-next))
+                       ((char= c #\=)
+                        (let ((c1 (funcall input-function)))
+                          (cond ((not c1)
+                                 (save #\=))
+                                ((char= c1 #\return)
+                                 ;; soft line break: skip the next
+                                 ;; character which we assume to be a
+                                 ;; newline (pity if it isn't)
+                                 (funcall input-function)
+                                 (push-next))
+                                ((char= c1 #\newline)
+                                 ;; soft line break: the #\return is
+                                 ;; missing, but we are tolerant
+                                 (push-next))
+                                (t
+                                 ;; hexadecimal sequence: get the 2nd digit
+                                 (let ((c2 (funcall input-function)))
+                                   (if c2
+                                       (aif (parse-hex c1 c2)
+                                            (saveb it)
+                                            (if parser-errors
+                                                (error "invalid hex sequence ~A~A" c1 c2)
+                                                (progn
+                                                  (save #\=)
+                                                  (save c1)
+                                                  (save c2))))
+                                       (progn
+                                         (save c)
+                                         (save c1))))))))
+                       (t
+                        (save c))))))
+      (or (queue-pop saved-bytes)
+          (progn
+            (push-next)
+            (queue-pop saved-bytes))))))
+
+(defmacro make-encoder-loop (encoder-class input-form output-form)
+  (with-gensyms (encoder byte)
+    `(loop
+        with ,encoder = (make-instance ',encoder-class
+                                       :output-function #'(lambda (char) ,output-form))
+        for ,byte = ,input-form
+        while ,byte
+        do (encoder-write-byte ,encoder ,byte)
+        finally (encoder-finish-output ,encoder))))
+
+(defmacro make-decoder-loop (decoder-class input-form output-form &key parser-errors)
+  (with-gensyms (decoder)
+    `(loop
+        with ,decoder = (make-instance ',decoder-class
+                                       :input-function #'(lambda () ,input-form)
+                                       :parser-errors ,parser-errors)
+        for byte = (decoder-read-byte ,decoder)
+        while byte
+        do ,output-form)))
+
+(defun decode-quoted-printable-stream (in out &key parser-errors)
+  "Read from stream IN a quoted printable text and write to
+binary output OUT the decoded stream of bytes."
+  (make-decoder-loop quoted-printable-decoder
+                     (read-byte in nil) (write-byte byte out)
+                     :parser-errors parser-errors))
+
+(defmacro make-stream-to-sequence-decoder (decoder-class input-form &key parser-errors)
+  "Decode the character stream STREAM and return a sequence of bytes."
+  (with-gensyms (output-sequence)
+    `(let ((,output-sequence (make-array 0
+                                         :element-type '(unsigned-byte 8)
+                                         :fill-pointer 0
+                                         :adjustable t)))
+       (make-decoder-loop ,decoder-class ,input-form
+                          (vector-push-extend byte ,output-sequence)
+                          :parser-errors ,parser-errors)
+       ,output-sequence)))
+
+(defun decode-quoted-printable-stream-to-sequence (stream &key parser-errors)
+  "Read from STREAM a quoted printable text and return a vector of
+bytes."
+  (make-stream-to-sequence-decoder quoted-printable-decoder
+    (read-char stream nil)
+    :parser-errors parser-errors))
+
+(defun decode-quoted-printable-string (string &key (start 0) (end (length string)) parser-errors)
+  "Decode STRING as quoted printable sequence of characters and
+return a decoded sequence of bytes."
+  (with-input-from-string (in string :start start :end end)
+    (decode-quoted-printable-stream-to-sequence in :parser-errors parser-errors)))
+
+(defclass quoted-printable-encoder (line-encoder)
+  ((line-length :initform *quoted-printable-line-length*
+                :type (or fixnum null))
+   (pending-space :initform nil
+                  :type boolean)))
+
+(defmethod encoder-write-byte ((encoder quoted-printable-encoder) byte)
+  (declare (optimize (speed 3) (safety 0) (debug 0))
+           (type (unsigned-byte 8) byte))
+  (with-slots (output-function column pending-space line-length) encoder
+    (declare (type function output-function)
+             (type fixnum column)
+             (type (or fixnum null) line-length)
+             (type boolean pending-space))
+    (labels ((out (c)
+               (funcall output-function c)
+               (values))
+             (outs (str)
+               (declare (type simple-string str))
+               (loop
+                  for c across str
+                  do (out c))
+               (values))
+             (out2hex (x)
+               (declare (type fixnum x))
+               (multiple-value-bind (a b) (truncate x 16)
+                 (out (digit-char a 16))
+                 (out (digit-char b 16)))))
+      (cond ((= byte #.(char-code #\newline))
+             (when pending-space
+               (outs "=20")
+               (setf pending-space nil))
+             (out #\newline)
+             (setf column 0))
+            ((= byte #.(char-code #\space))
+             (if pending-space
+                 (progn
+                   (out #\space)
+                   (f++ column))
+                 (setf pending-space t)))
+            (t
+             (when pending-space
+               (out #\space)
+               (f++ column)
+               (setf pending-space nil))
+             (cond ((or (< byte 32)
+                        (= byte #.(char-code #\=))
+                        (> byte 126))
+                    (out #\=)
+                    (out2hex byte)
+                    (f++ column 3))
+                   (t
+                    (out (code-char byte))
+                    (f++ column)))))
+      (when (and line-length
+                 (>= column line-length))
+        ;; soft line break
+        (outs #.(coerce '(#\= #\newline) 'string))
+        (setf column 0)))))
+
+(defmethod encoder-finish-output ((encoder quoted-printable-encoder))
+  (declare (optimize (speed 3) (safety 0) (debug 0)))
+  (with-slots (pending-space output-function) encoder
+    (declare (type boolean pending-space)
+             (type function output-function))
+    (when pending-space
+      (flet ((outs (s)
+               (declare (type simple-string s))
+               (loop
+                  for c across s
+                  do (funcall output-function c))))
+        (setf pending-space nil)
+        (outs "=20")))))
+
+(defun encode-quoted-printable-stream (in out)
+  "Read from IN a stream of bytes and write to OUT a stream of
+characters quoted printables encoded."
+  (make-encoder-loop quoted-printable-encoder
+                     (read-byte in nil)
+                     (write-char char out)))
+
+(defun encode-quoted-printable-sequence-to-stream (sequence stream &key (start 0) (end (length sequence)))
+  "Encode the sequence of bytes SEQUENCE and write to STREAM a
+quoted printable sequence of characters."
+  (let ((i start))
+    (make-encoder-loop quoted-printable-encoder
+     (when (< i end)
+       (prog1 (elt sequence i)
+         (f++ i)))
+     (write-char char stream))))
+
+(defun encode-quoted-printable-sequence (sequence &key (start 0) (end (length sequence)))
+  "Encode the sequence of bytes SEQUENCE into a quoted printable
+string and return it."
+  (with-output-to-string (out)
+    (encode-quoted-printable-sequence-to-stream sequence out :start start :end end)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass base64-encoder (line-encoder)
+  ((line-length :initform *base64-line-length*)
+   (bitstore :initform 0
+             :type fixnum)
+   (bytecount :initform 0
+              :type fixnum))
+  (:documentation
+   "Class for Base64 encoder output streams."))
+
+
+(eval-when (:load-toplevel :compile-toplevel)
+  (unless (> most-positive-fixnum (expt 2 (* 8 3)))))
+
+(macrolet ((with-encoder (encoder &body forms)
+             `(with-slots (bitstore line-length column bytecount output-function) ,encoder
+                (declare (type fixnum column)
+                         (type fixnum bitstore bytecount)
+                         (type (or fixnum null) line-length)
+                         (type function output-function))
+                (labels ((emitr (i b)
+                           (declare (type fixnum i b))
+                           (unless (zerop i)
+                             (emitr (1- i) (ash b -6)))
+                           (emitc
+                            (char +base64-encode-table+ (logand b #x3F)))
+                           (values))
+                         (out (c)
+                           (funcall output-function c))
+                         (eol ()
+                           (progn
+                             (out #\return)
+                             (out #\newline)))
+                         (emitc (char)
+                           (out char)
+                           (f++ column)
+                           (when (and line-length
+                                      (>= column line-length))
+                             (setf column 0)
+                             (eol))))
+                  (declare (inline out eol emitc)
+                           (ignorable (function emitr) (function out) (function eol) (function emitc)))
+                  ,@forms))))
+  ;; For this function to work correctly, the FIXNUM must be at least
+  ;; 24 bits.
+  (defmethod encoder-write-byte ((encoder base64-encoder) byte)
+    (declare (optimize (speed 3) (safety 0) (debug 0))
+             (type (unsigned-byte 8) byte))
+    (with-encoder encoder
+      (setf bitstore (logior byte (the fixnum (ash bitstore 8))))
+      (f++ bytecount)
+      (when (= 3 bytecount)
+        (emitr 3 bitstore)
+        (setf bitstore 0
+              bytecount 0)))
+    (values))
+
+  (defmethod encoder-finish-output ((encoder base64-encoder))
+    (with-encoder encoder
+      (unless (zerop bytecount)
+        (multiple-value-bind (saved6 rest) (truncate (* bytecount 8) 6)
+          (setf bitstore (ash bitstore (- 6 rest)))
+          (emitr saved6 bitstore)
+          (dotimes (x (- 3 saved6))
+            (emitc #\=))))
+      (when (and line-length
+                 (not (zerop column)))
+        (eol)))
+    (values)))
+
+(defun encode-base64-stream (in out)
+  "Read a byte stream from IN and write to OUT the encoded Base64
+character stream."
+  (make-encoder-loop base64-encoder (read-byte in nil)
+                     (write-char char out)))
+
+(defun encode-base64-sequence-to-stream (sequence stream &key (start 0) (end (length sequence)))
+  "Encode the sequence of bytes SEQUENCE and write to STREAM the
+Base64 character sequence."
+  (let ((i start))
+    (make-encoder-loop base64-encoder
+                       (when (< i end)
+                         (prog1 (elt sequence i)
+                           (incf i)))
+                       (write-char char stream))))
+
+(defun encode-base64-sequence (sequence &key (start 0) (end (length sequence)))
+  "Encode the sequence of bytes SEQUENCE into a Base64 string and
+return it."
+  (with-output-to-string (out)
+    (encode-base64-sequence-to-stream sequence out :start start :end end)))
+
+(defun decode-base64-stream (in out &key parser-errors)
+  "Read from IN a stream of characters Base64 encoded and write
+to OUT a stream of decoded bytes."
+  ;; parser-errors are ignored for base64
+  (declare (ignore parser-errors))
+  (redirect-stream (make-instance 'qbase64:decode-stream
+                                  :underlying-stream in)
+                   out))
+
+(defun decode-base64-stream-to-sequence (stream &key parser-errors)
+  "Read Base64 characters from STREAM and return result of decoding them as a
+binary sequence."
+  ;; parser-errors are ignored for base64
+  (declare (ignore parser-errors))
+  (let* ((buffered-size 4096)
+         (dstream (make-instance 'qbase64:decode-stream
+                                 :underlying-stream stream))
+         (output-seq (make-array buffered-size
+                                 :element-type '(unsigned-byte 8)
+                                 :adjustable t)))
+    (loop for cap = (array-dimension output-seq 0)
+          for pos = (read-sequence output-seq dstream :start (or pos 0))
+          if (>= pos cap)
+            do (adjust-array output-seq (+ cap buffered-size))
+          else
+            do (progn
+                 (adjust-array output-seq pos)
+                 (return output-seq)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun dump-stream-binary (in out)
+  "Write content of IN character stream to OUT binary stream."
+  (loop
+     for c = (read-char in nil)
+     while c
+     do (write-byte (char-code c) out)))
+
+(defun decode-string (string encoding &key parser-errors-p)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (decode-quoted-printable-string string
+                                     :parser-errors parser-errors-p))
+    (:base64
+     ;; parser-errors-p is unused in base64
+     (qbase64:decode-string string))
+    (otherwise
+     (map '(vector (unsigned-byte 8)) #'char-code string))))
+
+(defun decode-stream-to-sequence (stream encoding &key parser-errors-p)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (decode-quoted-printable-stream-to-sequence stream
+                                                 :parser-errors parser-errors-p))
+    (:base64
+     (decode-base64-stream-to-sequence stream
+                                       :parser-errors parser-errors-p))
+    (otherwise
+     (loop
+        with output-sequence = (make-array 0 :fill-pointer 0
+                                           :element-type '(unsigned-byte 8)
+                                           :adjustable t)
+        for c = (read-char stream nil)
+        while c
+        do (vector-push-extend (char-code c) output-sequence)
+        finally (return output-sequence)))))
+
+(defun encode-stream (in out encoding)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (encode-quoted-printable-stream in out))
+    (:base64
+     (encode-base64-stream in out))
+    (otherwise
+     (loop
+        for byte = (read-byte in nil)
+        while byte
+        do (write-char (code-char byte) out)))))
+
+(defun encode-sequence-to-stream (sequence out encoding)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (encode-quoted-printable-sequence-to-stream sequence out))
+    (:base64
+     (encode-base64-sequence-to-stream sequence out))
+    (otherwise
+     (loop
+        for byte across sequence
+        do (write-char (code-char byte) out)))))
+
+(defun encode-sequence (sequence encoding)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (encode-quoted-printable-sequence sequence))
+    (:base64
+     (encode-base64-sequence sequence))
+    (otherwise
+     (map 'string #'code-char sequence))))
+
+;; This is similar to decode-quoted-printable-string but #\_ is used
+;; instead of space
+(defun decode-quoted-printable-RFC2047-string (string &key (start 0) (end (length string)))
+  "Decode a string encoded according to the quoted printable
+method of RFC2047 and return a sequence of bytes."
+  (declare (optimize (speed 3) (debug 0) (safety 0))
+           (type simple-string string))
+  (loop
+     with output-sequence = (make-array (length string)
+                                        :element-type '(unsigned-byte 8)
+                                        :fill-pointer 0)
+     for i fixnum from start by 1 below end
+     for c = (char string i)
+     do (case c
+          (#\=
+           (vector-push-extend (or (parse-hex (char string (1+ i)) (char string (+ 2 i)))
+                                   ;; the char code was malformed
+                                   #.(char-code #\?))
+                               output-sequence)
+           (f++ i 2))
+          (#\_ (vector-push-extend #.(char-code #\space) output-sequence))
+          (otherwise
+           (vector-push-extend (char-code c) output-sequence)))
+       finally (return output-sequence)))
+
+(defun decode-RFC2047-part (encoding string &key (start 0) (end (length string)))
+  "Decode STRING according to RFC2047 and return a sequence of
+bytes."
+  (gcase (encoding string-equal)
+    ("Q" (decode-quoted-printable-RFC2047-string string :start start :end end))
+    ("B" (qbase64:decode-string (subseq string start end)))
+    (t string)))
+
+(defun parse-RFC2047-text (text)
+  "Parse the string TEXT according to RFC2047 rules and return a list
+of pairs and strings.  The strings are the bits interposed between the
+actually encoded text.  The pairs are composed of: a decoded byte
+sequence, a charset string indicating the original coding."
+  (loop
+     with result = '()
+     with previous-end = 0
+     for start = (search "=?" text :start2 previous-end)
+     while start
+     for first-? = (position #\? text :start (+ 2 start))
+     while first-?
+     for second-? = (position #\? text :start (1+ first-?))
+     while second-?
+     for end = (search "?=" text :start2 (1+ second-?))
+     while end
+     do (let ((charset (string-upcase (subseq text (+ 2 start) first-?)))
+              (encoding (subseq text (1+ first-?) second-?)))
+          (unless (= previous-end start)
+            (push (subseq text previous-end start)
+                  result))
+          (setf previous-end (+ end 2))
+          (push (cons (decode-RFC2047-part encoding text :start (1+ second-?) :end end)
+                      charset)
+                result))
+     finally (unless (= previous-end (length text))
+               (push (subseq text previous-end (length text))
+                     result))
+       (return (nreverse result))))
+
+(defun decode-RFC2047 (text)
+  "Decode TEXT into a fully decoded string. Whenever a non ASCII part is
+  encountered, try to decode it using flexi-streams, otherwise signal an error."
+  (flet ((decode-part (part)
+           (etypecase part
+             (cons (flexi-streams:octets-to-string
+                    (car part)
+                    :external-format (flexi-streams:make-external-format
+                                      (intern (string-upcase (cdr part)) 'keyword))))
+             (string part))))
+    (apply #'concatenate
+           (cons 'string
+                 (mapcar #'decode-part (mime:parse-RFC2047-text text))))))
diff --git a/third_party/lisp/mime4cl/ex-sclf.lisp b/third_party/lisp/mime4cl/ex-sclf.lisp
new file mode 100644
index 000000000000..7951b44f4d0f
--- /dev/null
+++ b/third_party/lisp/mime4cl/ex-sclf.lisp
@@ -0,0 +1,368 @@
+;;; ex-sclf.lisp --- subset of sclf used by mime4cl
+
+;;;  Copyright (C) 2005-2010 by Walter C. Pelissero
+;;;  Copyright (C) 2022-2023 The TVL Authors
+
+;;;  Author: sternenseemann <sternenseemann@systemli.org>
+;;;  Project: mime4cl
+;;;
+;;;  mime4cl uses sclf for miscellaneous utility functions. sclf's portability
+;;;  is quite limited. Since mime4cl is the only thing in TVL's depot depending
+;;;  on sclf, it made more sense to strip down sclf to the extent mime4cl needed
+;;;  in order to lessen the burden of porting it to other CL implementations
+;;;  later.
+;;;
+;;;  Eventually it probably makes sense to drop the utilities we don't like and
+;;;  merge the ones we do like into depot's own utility package, klatre.
+
+#+cmu (ext:file-comment "$Module: ex-sclf.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(defpackage :mime4cl-ex-sclf
+  (:use :common-lisp)
+  (:export
+   #:aif
+   #:awhen
+   #:aand
+   #:it
+
+   #:gcase
+
+   #:with-gensyms
+
+   #:split-at
+   #:split-string-at-char
+   #:+whitespace+
+   #:whitespace-p
+   #:string-concat
+   #:s+
+   #:string-starts-with
+   #:string-trim-whitespace
+   #:string-left-trim-whitespace
+   #:string-right-trim-whitespace
+
+   #:queue
+   #:make-queue
+   #:queue-append
+   #:queue-pop
+   #:queue-empty-p
+
+   #:save-file-excursion
+   #:read-file
+
+   #:unix-file-stat
+   #:unix-stat
+   #:file-size
+
+   #:promise
+   #:make-promise
+   #:lazy
+   #:force
+   #:forced-p
+   #:deflazy
+
+   #:f++
+
+   #:week-day->string
+   #:month->string))
+
+(in-package :mime4cl-ex-sclf)
+
+;; MACRO UTILS
+
+(defmacro with-gensyms ((&rest symbols) &body body)
+  "Gensym all SYMBOLS and make them available in BODY.
+See also LET-GENSYMS."
+  `(let ,(mapcar #'(lambda (s)
+                     (list s '(gensym))) symbols)
+     ,@body))
+
+;; CONTROL FLOW
+
+(defmacro aif (test then &optional else)
+  `(let ((it ,test))
+     (if it
+         ,then
+         ,else)))
+
+(defmacro awhen (test &body then)
+  `(let ((it ,test))
+     (when it
+       ,@then)))
+
+(defmacro aand (&rest args)
+  (cond ((null args) t)
+        ((null (cdr args)) (car args))
+        (t `(aif ,(car args) (aand ,@(cdr args))))))
+
+(defmacro gcase ((value &optional (test 'equalp)) &rest cases)
+  "Generic CASE macro.  Match VALUE to CASES as if by the normal CASE
+but use TEST as the comparison function, which defaults to EQUALP."
+  (with-gensyms (val)
+    `(let ((,val ,value))
+       ,(cons 'cond
+              (mapcar #'(lambda (case-desc)
+                          (destructuring-bind (vals &rest forms) case-desc
+                            `(,(cond ((consp vals)
+                                      (cons 'or (mapcar #'(lambda (v)
+                                                            (list test val v))
+                                                        vals)))
+                                     ((or (eq vals 'otherwise)
+                                          (eq vals t))
+                                      t)
+                                     (t (list test val vals)))
+                               ,@forms)))
+                      cases)))))
+
+;; SEQUENCES
+
+(defun position-any (bag sequence &rest position-args)
+  "Find any element of bag in sequence and return its position.
+Accept any argument accepted by the POSITION function."
+  (apply #'position-if #'(lambda (element)
+                           (find element bag)) sequence position-args))
+
+(defun split-at (bag sequence &key (start 0) key)
+  "Split SEQUENCE at occurence of any element from BAG.
+Contiguous occurences of elements from BAG are considered atomic;
+so no empty sequence is returned."
+  (let ((len (length sequence)))
+    (labels ((split-from (start)
+               (unless (>= start len)
+                 (let ((sep (position-any bag sequence :start start :key key)))
+                   (cond ((not sep)
+                          (list (subseq sequence start)))
+                         ((> sep start)
+                          (cons (subseq sequence start sep)
+                                (split-from (1+ sep))))
+                         (t
+                          (split-from (1+ start))))))))
+      (split-from start))))
+
+;; STRINGS
+
+(defvar +whitespace+ '(#\return #\newline #\tab #\space #\page))
+
+(defun whitespace-p (char)
+  (member char +whitespace+))
+
+(defun string-trim-whitespace (string)
+  (string-trim +whitespace+ string))
+
+(defun string-right-trim-whitespace (string)
+  (string-right-trim +whitespace+ string))
+
+(defun string-left-trim-whitespace (string)
+  (string-left-trim +whitespace+ string))
+
+(defun split-string-at-char (string separator &key escape skip-empty)
+  "Split STRING at SEPARATORs and return a list of the substrings.  If
+SKIP-EMPTY is true then filter out the empty substrings.  If ESCAPE is
+not nil then split at SEPARATOR only if it's not preceded by ESCAPE."
+  (declare (type string string) (type character separator))
+  (labels ((next-separator (beg)
+             (let ((pos (position separator string :start beg)))
+               (if (and escape
+                        pos
+                        (plusp pos)
+                        (char= escape (char string (1- pos))))
+                   (next-separator (1+ pos))
+                   pos)))
+           (parse (beg)
+             (cond ((< beg (length string))
+                    (let* ((end (next-separator beg))
+                           (substring (subseq string beg end)))
+                      (cond ((and skip-empty (string= "" substring))
+                             (parse (1+ end)))
+                            ((not end)
+                             (list substring))
+                            (t
+                             (cons substring (parse (1+ end)))))))
+                   (skip-empty
+                    '())
+                   (t
+                    (list "")))))
+    (parse 0)))
+
+(defun s+ (&rest strings)
+  "Return a string which is made of the concatenation of STRINGS."
+  (apply #'concatenate 'string strings))
+
+(defun string-concat (list &optional (separator ""))
+  "Concatenate the strings in LIST interposing SEPARATOR (default
+nothing) between them."
+  (reduce #'(lambda (&rest args)
+              (if args
+                  (s+ (car args) separator (cadr args))
+                  ""))
+          list))
+
+(defun string-starts-with (prefix string &optional (compare #'string=))
+  (let ((prefix-length (length prefix)))
+    (and (>= (length string) prefix-length)
+         (funcall compare prefix string :end2 prefix-length))))
+
+;; QUEUE
+
+(defstruct queue
+  first
+  last)
+
+(defgeneric queue-append (queue objects))
+(defgeneric queue-pop (queue))
+(defgeneric queue-empty-p (queue))
+
+(defmethod queue-append ((queue queue) (objects list))
+  (cond ((null (queue-first queue))
+         (setf (queue-first queue) objects
+               (queue-last queue) (last objects)))
+        (t
+         (setf (cdr (queue-last queue)) objects
+               (queue-last queue) (last objects))))
+  queue)
+
+(defmethod queue-append ((queue queue) object)
+  (queue-append queue (list object)))
+
+(defmethod queue-pop ((queue queue))
+  (prog1 (car (queue-first queue))
+    (setf (queue-first queue) (cdr (queue-first queue)))))
+
+(defmethod queue-empty-p ((queue queue))
+  (null (queue-first queue)))
+
+;; STREAMS
+
+(defmacro save-file-excursion ((stream &optional position) &body forms)
+  "Execute FORMS returning, on exit, STREAM to the position it was
+before FORMS.  Optionally POSITION can be set to the starting offset."
+  (unless position
+    (setf position (gensym)))
+  `(let ((,position (file-position ,stream)))
+     (unwind-protect (progn ,@forms)
+       (file-position ,stream ,position))))
+
+(defun read-file (pathname &key (element-type 'character) (if-does-not-exist :error) default)
+  "Read the whole content of file and return it as a sequence which
+can be a string, a vector of bytes, or whatever you specify as
+ELEMENT-TYPE."
+  (with-open-file (in pathname
+                      :element-type element-type
+                      :if-does-not-exist (unless (eq :value if-does-not-exist)
+                                           :error))
+    (if in
+        (let ((seq (make-array (file-length in) :element-type element-type)))
+          (read-sequence seq in)
+          seq)
+        default)))
+
+;; FILES
+
+(defun native-namestring (pathname)
+  #+sbcl (sb-ext:native-namestring pathname)
+  #-sbcl (let (#+cmu (lisp::*ignore-wildcards* t))
+           (namestring pathname)))
+
+(defstruct (unix-file-stat (:conc-name stat-))
+  device
+  inode
+  links
+  atime
+  mtime
+  ctime
+  size
+  blksize
+  blocks
+  uid
+  gid
+  mode)
+
+(defun unix-stat (pathname)
+  ;; this could be different depending on the unix systems
+  (multiple-value-bind (ok? device inode mode links uid gid rdev
+                            size atime mtime ctime
+                            blksize blocks)
+      (#+cmu unix:unix-lstat
+       #+sbcl sb-unix:unix-lstat
+       ;; TODO(sterni): ECL, CCL
+       (if (stringp pathname)
+           pathname
+           (native-namestring pathname)))
+    (declare (ignore rdev))
+    (when ok?
+      (make-unix-file-stat :device device
+                           :inode inode
+                           :links links
+                           :atime atime
+                           :mtime mtime
+                           :ctime ctime
+                           :size size
+                           :blksize blksize
+                           :blocks blocks
+                           :uid uid
+                           :gid gid
+                           :mode mode))))
+
+;; FILE-LENGTH is a bit idiosyncratic in this respect.  Besides, Unix
+;; allows to get to know the file size without being able to open a
+;; file; just ask politely.
+(defun file-size (pathname)
+  (stat-size (unix-stat pathname)))
+
+;; LAZY
+
+(defstruct promise
+  procedure
+  value)
+
+(defmacro lazy (form)
+  `(make-promise :procedure #'(lambda () ,form)))
+
+(defun forced-p (promise)
+  (null (promise-procedure promise)))
+
+(defun force (promise)
+  (if (forced-p promise)
+      (promise-value promise)
+      (prog1 (setf (promise-value promise)
+                   (funcall (promise-procedure promise)))
+        (setf (promise-procedure promise) nil))))
+
+(defmacro deflazy (name value &optional documentation)
+  `(defparameter ,name (lazy ,value)
+     ,@(when documentation
+             (list documentation))))
+
+;; FIXNUMS
+
+(defmacro f++ (x &optional (delta 1))
+  "Same as INCF but hopefully optimised for fixnums."
+  `(setf ,x (+ (the fixnum ,x) (the fixnum ,delta))))
+
+;; TIME
+
+(defun week-day->string (day &optional sunday-first)
+  "Return the weekday string corresponding to DAY number."
+  (elt (if sunday-first
+           #("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday")
+           #("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"))
+       day))
+
+(defvar +month-names+  #("January" "February" "March" "April" "May" "June" "July"
+                           "August" "September" "October" "November" "December"))
+
+(defun month->string (month)
+  "Return the month string corresponding to MONTH number."
+  (elt +month-names+ (1- month)))
diff --git a/third_party/lisp/mime4cl/mime.lisp b/third_party/lisp/mime4cl/mime.lisp
new file mode 100644
index 000000000000..3cdac4b26b6f
--- /dev/null
+++ b/third_party/lisp/mime4cl/mime.lisp
@@ -0,0 +1,1049 @@
+;;;  mime4cl.lisp --- MIME primitives for Common Lisp
+
+;;;  Copyright (C) 2005-2008, 2010 by Walter C. Pelissero
+;;;  Copyright (C) 2021-2023 by the TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl)
+
+(defclass mime-part ()
+  ((subtype
+    :type (or string null)
+    :initarg :subtype
+    :accessor mime-subtype
+    ;; some mime types don't require a subtype
+    :initform nil)
+   (type-parameters
+    :type list
+    :initarg :type-parameters
+    :initform '()
+    :accessor mime-type-parameters)
+   (version
+    :type (or string null)
+    :initarg :mime-version
+    :initform "1.0"
+    :accessor mime-version)
+   (id
+    :initform nil
+    :initarg :id
+    :reader mime-id)
+   (description
+    :initform nil
+    :initarg :description
+    :accessor mime-description)
+   (encoding
+    :initform :7bit
+    :initarg :encoding
+    :reader mime-encoding
+    :documentation
+    "It's supposed to be either:
+  :7BIT, :8BIT, :BINARY, :QUOTED-PRINTABLE, :BASE64, a
+  X-token or an ietf-token (whatever that means).")
+   (disposition
+    :type (or string null)
+    :initarg :disposition
+    :initform nil
+    :accessor mime-disposition)
+   (disposition-parameters
+    :type list
+    :initarg :disposition-parameters
+    :initform '()
+    :accessor mime-disposition-parameters))
+  (:documentation
+   "Abstract base class for all types of MIME parts."))
+
+(defclass mime-bodily-part (mime-part)
+  ((body
+    :initarg :body
+    :accessor mime-body))
+  (:documentation
+   "Abstract base class for MIME parts with a body."))
+
+(defclass mime-unknown-part (mime-bodily-part)
+  ((type
+    :initarg :type
+    :reader mime-type
+    :documentation
+    "The original type string from the MIME header."))
+  (:documentation
+   "MIME part unknown to this library.  Accepted but not handled."))
+
+(defclass mime-text (mime-bodily-part) ())
+
+;; This turns out to be handy when making methods specialised
+;; non-textual attachments.
+(defclass mime-binary (mime-bodily-part) ())
+
+(defclass mime-image (mime-binary) ())
+
+(defclass mime-audio (mime-binary) ())
+
+(defclass mime-video (mime-binary) ())
+
+(defclass mime-application (mime-binary) ())
+
+(defclass mime-multipart (mime-part)
+  ((parts :initarg :parts
+          :accessor mime-parts)))
+
+(defclass mime-message (mime-part)
+  ((headers :initarg :headers
+            :initform '()
+            :type list
+            :accessor mime-message-headers)
+   (real-message :initarg :body
+                 :accessor mime-body)))
+
+(defun mime-part-p (object)
+  (typep object 'mime-part))
+
+(defmethod initialize-instance ((part mime-multipart) &key &allow-other-keys)
+  (call-next-method)
+  ;; The initialization argument of the PARTS slot of a mime-multipart
+  ;; is expected to be a list of mime-parts.  Thus, we implicitly
+  ;; create the mime parts using the arguments found in this list.
+  (with-slots (parts) part
+    (when (slot-boundp part 'parts)
+      (setf parts
+            (mapcar #'(lambda (subpart)
+                        (if (mime-part-p subpart)
+                            subpart
+                            (apply #'make-instance subpart)))
+                    parts)))))
+
+(defmethod initialize-instance ((part mime-message) &key &allow-other-keys)
+  (call-next-method)
+  ;; Allow a list of mime parts to be specified as body of a
+  ;; mime-message.  In that case we implicitly create a mime-multipart
+  ;; and assign to the body slot.
+  (with-slots (real-message) part
+    (when (and (slot-boundp part 'real-message)
+               (consp real-message))
+      (setf real-message
+            (make-instance 'mime-multipart :parts real-message)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun alist= (alist1 alist2 &key (test #'eql))
+  (null
+   (set-difference alist1 alist2
+                   :test #'(lambda (x y)
+                             (and (funcall test (car x) (car y))
+                                  (funcall test (cdr x) (cdr y)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric mime= (mime1 mime2)
+  (:documentation
+   "Return true if MIME1 and MIME2 have equivalent structure and identical bodies (as for EQ)."))
+
+(defmethod mime= ((part1 mime-part) (part2 mime-part))
+  (macrolet ((null-or (compare x y)
+               `(or (and (not ,x)
+                         (not ,y))
+                    (and ,x ,y
+                         (,compare ,x ,y))))
+             (cmp-slot (compare reader)
+               `(null-or ,compare (,reader part1) (,reader part2))))
+    (and (eq (class-of part1) (class-of part2))
+         (cmp-slot string-equal mime-subtype)
+         (alist= (mime-type-parameters part1)
+                 (mime-type-parameters part2)
+                 :test #'string-equal)
+         (cmp-slot string= mime-id)
+         (cmp-slot string= mime-description)
+         (cmp-slot eq mime-encoding)
+         (cmp-slot equal mime-disposition)
+         (alist= (mime-disposition-parameters part1)
+                 (mime-disposition-parameters part2)
+                 :test #'string-equal))))
+
+(defmethod mime= ((part1 mime-multipart) (part2 mime-multipart))
+  (and (call-next-method)
+       (every #'mime= (mime-parts part1) (mime-parts part2))))
+
+(defmethod mime= ((part1 mime-message) (part2 mime-message))
+  (and (call-next-method)
+       (alist= (mime-message-headers part1) (mime-message-headers part2)
+               :test #'string=)
+       (mime= (mime-body part1) (mime-body part2))))
+
+(defun mime-body-stream (mime-part)
+  (make-input-adapter (mime-body mime-part)))
+
+(defun mime-body-length (mime-part)
+  (let ((body (mime-body mime-part)))
+    ;; here the stream type is missing on purpose, because we may not
+    ;; be able to size the length of a stream
+    (etypecase body
+      (string
+       (length body))
+      (vector
+       (length body))
+      (pathname
+       (file-size body))
+      (file-portion
+       (with-open-stream (in (open-decoded-file-portion body))
+         (loop
+            for byte = (read-byte in nil)
+            while byte
+            count byte))))))
+
+(defmacro with-input-from-mime-body-stream ((stream part) &body forms)
+  `(with-open-stream (,stream (mime-body-stream ,part))
+     ,@forms))
+
+(defmethod mime= ((part1 mime-bodily-part) (part2 mime-bodily-part))
+  (and (call-next-method)
+       (with-input-from-mime-body-stream (in1 part1)
+         (with-input-from-mime-body-stream (in2 part2)
+           (loop
+              for b1 = (read-byte in1 nil)
+              for b2 = (read-byte in2 nil)
+              always (eq b1 b2)
+              while (and b1 b2))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric get-mime-type-parameter (part name)
+  (:documentation
+   "Return the MIME type parameter associated to NAME of PART."))
+
+(defgeneric (setf get-mime-type-parameter) (value part name)
+  (:documentation
+   "Set the MIME type parameter associated to NAME of PART."))
+
+(defmethod get-mime-type-parameter ((part mime-part) name)
+  (cdr (assoc name (mime-type-parameters part) :test #'string-equal)))
+
+(defmethod (setf get-mime-type-parameter) (value part name)
+  (aif (assoc name (mime-type-parameters part) :test #'string-equal)
+       (setf (cdr it) value)
+       (push (cons name value)
+             (mime-type-parameters part)))
+  value)
+
+(defgeneric get-mime-disposition-parameter (part name)
+  (:documentation
+   "Return the MIME disposition parameter associated to NAME of PART."))
+
+(defmethod get-mime-disposition-parameter ((part mime-part) name)
+  (cdr (assoc name (mime-disposition-parameters part) :test #'string-equal)))
+
+(defmethod (setf get-mime-disposition-parameter) (value part name)
+  (aif (assoc name (mime-disposition-parameters part) :test #'string-equal)
+       (setf (cdr it) value)
+       (push (cons name value)
+             (mime-disposition-parameters part))))
+
+(defmethod mime-part-file-name ((part mime-part))
+  "Return the filename associated to mime PART or NIL if the mime
+part doesn't have a file name."
+  (or (get-mime-disposition-parameter part :filename)
+      (get-mime-type-parameter part :name)))
+
+(defmethod (setf mime-part-file-name) (value (part mime-part))
+  "Set the filename associated to mime PART."
+  (setf (get-mime-disposition-parameter part :filename) value
+        (get-mime-type-parameter part :name) value))
+
+(defun mime-text-charset (part)
+  (get-mime-type-parameter part :charset))
+
+(defun split-header-parts (string)
+  "Split parts of a MIME headers.  These are divided by
+semi-colons not within strings or comments."
+  (labels ((skip-comment (pos)
+             (loop
+                while (< pos (length string))
+                do (case (elt string pos)
+                     (#\( (setf pos (skip-comment (1+ pos))))
+                     (#\\ (incf pos 2))
+                     (#\) (return (1+ pos)))
+                     (otherwise (incf pos)))
+                finally (return pos)))
+           (skip-string (pos)
+             (loop
+                while (< pos (length string))
+                do (case (elt string pos)
+                     (#\\ (incf pos 2))
+                     (#\" (return (1+ pos)))
+                     (otherwise (incf pos)))
+                finally (return pos))))
+    (loop
+       with start = 0 and i = 0 and parts = '()
+       while (< i (length string))
+       do (case (elt string i)
+            (#\; (push (subseq string start i) parts)
+                 (setf start (incf i)))
+            (#\" (setf i (skip-string i)))
+            (#\( (setf i (skip-comment (1+ i))))
+            (otherwise (incf i)))
+       finally (return (mapcar #'string-trim-whitespace (nreverse (cons (subseq string start) parts)))))))
+
+(defun parse-parameter (string)
+  "Given a string like \"foo=bar\" return a pair (\"foo\" .
+\"bar\").  Return NIL if string is not parsable."
+  ;; TODO(sterni): when-let
+  (let ((equal-position (position #\= string)))
+    (when equal-position
+      (let ((key (subseq string  0 equal-position)))
+        (if (= equal-position (1- (length string)))
+            (cons key "")
+            (let ((value (string-trim-whitespace (subseq string (1+ equal-position)))))
+              (cons key
+                    (if (and (> (length value) 1)
+                             (char= #\" (elt value 0)))
+                        ;; the syntax of a RFC822 string is more or
+                        ;; less the same as the Lisp one: use the Lisp
+                        ;; reader
+                        (or (ignore-errors (read-from-string value))
+                            (subseq value 1))
+                        (let ((end (or (position-if #'whitespace-p value)
+                                       (length value))))
+                          (subseq value 0 end))))))))))
+
+(defun parse-content-type (string)
+  "Parse string as a Content-Type MIME header and return a list
+of three elements.  The first is the type, the second is the
+subtype and the third is an alist of parameters and their values.
+Example: (\"text\" \"plain\" ((\"charset\" . \"us-ascii\")...))."
+  (let* ((parts (split-header-parts string))
+         (content-type-string (car parts))
+         (slash (position #\/ content-type-string)))
+    ;; You'd be amazed to know how many MUA can't produce an RFC
+    ;; compliant message.
+    (when slash
+      (let ((type (subseq content-type-string 0 slash))
+            (subtype (subseq content-type-string (1+ slash))))
+        (list type subtype (remove nil (mapcar #'parse-parameter (cdr parts))))))))
+
+(defun parse-content-disposition (string)
+  "Parse string as a Content-Disposition MIME header and return a
+list.  The first element is the layout, the other elements are
+the optional parameters alist.
+Example: (\"inline\" (\"filename\" . \"doggy.jpg\"))."
+  (let ((parts (split-header-parts string)))
+    (cons (car parts) (mapcan #'(lambda (parameter-string)
+                                  (awhen (parse-parameter parameter-string)
+                                    (list it)))
+                              (cdr parts)))))
+
+(defun parse-RFC822-header (string)
+  "Parse STRING which should be a valid RFC822 message header and
+return two values: a string of the header name and a string of
+the header value."
+  (let ((colon (position #\: string)))
+    (when colon
+      (values (string-trim-whitespace (subseq string 0 colon))
+              (string-trim-whitespace (subseq string (1+ colon)))))))
+
+
+(defvar *default-type* '("text" "plain" (("charset" . "us-ascii")))
+  "Internal special variable that contains the default MIME type at
+any given time of the parsing phase.  There are MIME container parts
+that may change this.")
+
+(defvar *mime-types*
+  '((:text mime-text)
+    (:image mime-image)
+    (:audio mime-audio)
+    (:video mime-video)
+    (:application mime-application)
+    (:multipart mime-multipart)
+    (:message mime-message)))
+
+(defgeneric mime-part-size (part)
+  (:documentation
+   "Return the size in bytes of the body of a MIME part."))
+
+(defgeneric print-mime-part (part stream)
+  (:documentation
+   "Output to STREAM one of the possible human-readable representation
+of mime PART.  Binary parts are omitted.  This function can be used to
+quote messages, for instance."))
+
+(defun do-multipart-parts (body-stream part-boundary contents-function end-part-function)
+  "Read through BODY-STREAM.  Call CONTENTS-FUNCTION at
+each (non-boundary) line or END-PART-FUNCTION at each PART-BOUNDARY."
+  (let* ((boundary (s+ "--" part-boundary))
+         (boundary-length (length boundary)))
+    (labels ((output-line (line)
+               (funcall contents-function line))
+             (end-part ()
+               (funcall end-part-function))
+             (last-part ()
+               (end-part)
+               (return-from do-multipart-parts))
+             (process-line (line)
+               (cond ((not (string-starts-with boundary line))
+                      ;; normal line
+                      (output-line line))
+                     ((and (= (length (string-trim-whitespace line))
+                              (+ 2 boundary-length))
+                           (string= "--" line :start2 boundary-length))
+                      ;; end of the last part
+                      (last-part))
+                     ;; according to RFC2046 "the boundary may be followed
+                     ;; by zero or more characters of linear whitespace"
+                     ((= (length (string-trim-whitespace line)) boundary-length)
+                      ;; beginning of the next part
+                      (end-part))
+                     (t
+                      ;; the line boundary is followed by some
+                      ;; garbage; we treat it as a normal line
+                      (output-line line)))))
+      (loop
+         for line = (read-line body-stream nil)
+         ;; we should never reach the end of a proper multipart MIME
+         ;; stream, but we don't want to be fooled by corrupted ones,
+         ;; so we check for EOF
+         unless line
+         do (last-part)
+         do (process-line line)))))
+
+(defun index-multipart-parts (body-stream part-boundary)
+  "Read from BODY-STREAM and return the file offset of the MIME parts
+separated by PART-BOUNDARY."
+  (let ((parts '())
+        (start 0)
+        (len 0)
+        (beginning-of-part-p t))
+    (flet ((sum-chars (line)
+             (incf len (length line))
+             ;; account for the #\newline
+             (if beginning-of-part-p
+                 (setf beginning-of-part-p nil)
+                 (incf len)))
+           (end-part ()
+             (setf beginning-of-part-p t)
+             (push (cons start (+ start len)) parts)
+             (setf start (file-position body-stream)
+                   len 0)))
+      (do-multipart-parts body-stream part-boundary #'sum-chars #'end-part)
+      ;; the first part is all the stuff up to the first boundary;
+      ;; just junk
+      (cdr (nreverse parts)))))
+
+(defgeneric encode-mime-part (part stream))
+(defgeneric encode-mime-body (part stream))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun write-mime-header (part stream)
+  (when (mime-version part)
+    (format stream "~&MIME-Version: ~A~%" (mime-version part)))
+  (format stream "~&Content-Type: ~A~:{; ~A=~S~}~%" (mime-type-string part)
+          (mapcar #'(lambda (pair)
+                      (list (car pair) (cdr pair)))
+                  (mime-type-parameters part)))
+  (awhen (mime-encoding part)
+    (format stream "Content-Transfer-Encoding: ~A~%" it))
+  (awhen (mime-description part)
+    (format stream "Content-Description: ~A~%" it))
+  (when (mime-disposition part)
+    (format stream "Content-Disposition: ~A~:{; ~A=~S~}~%"
+            (mime-disposition part)
+            (mapcar #'(lambda (pair)
+                        (list (car pair) (cdr pair)))
+                    (mime-disposition-parameters part))))
+  (awhen (mime-id part)
+    (format stream "Content-ID: ~A~%" it))
+  (terpri stream))
+
+(defmethod encode-mime-part ((part mime-part) stream)
+  (write-mime-header part stream)
+  (encode-mime-body part stream))
+
+(defmethod encode-mime-part ((part mime-message) stream)
+  ;; tricky: we have to mix the MIME headers with the message headers
+  (dolist (h (mime-message-headers part))
+    (unless (stringp (car h))
+      (setf (car h)
+            (string-capitalize (car h))))
+    (unless (or (string-starts-with "content-" (car h) #'string-equal)
+                (string-equal "mime-version" (car h)))
+      (format stream "~A: ~A~%"
+              (car h) (cdr h))))
+  (encode-mime-part (mime-body part) stream))
+
+(defmethod encode-mime-part ((part mime-multipart) stream)
+  ;; choose a boundary if not already set
+  (let* ((original-boundary (get-mime-type-parameter part :boundary))
+         (boundary (choose-boundary (mime-parts part) original-boundary)))
+    (unless (and original-boundary
+                 (string= boundary original-boundary))
+      (setf (get-mime-type-parameter part :boundary) boundary))
+    (call-next-method)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod encode-mime-body ((part mime-part) stream)
+  (with-input-from-mime-body-stream (in part)
+    (encode-stream in stream (mime-encoding part))))
+
+(defmethod encode-mime-body ((part mime-message) stream)
+  (encode-mime-body (mime-body part) stream))
+
+(defmethod encode-mime-body ((part mime-multipart) stream)
+  (let ((boundary (or (get-mime-type-parameter part :boundary)
+                      (setf (get-mime-type-parameter part :boundary)
+                            (choose-boundary (mime-parts part))))))
+    (dolist (p (mime-parts part))
+      (format stream "~%--~A~%" boundary)
+      (encode-mime-part p stream))
+    (format stream "~%--~A--~%" boundary)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun time-RFC822-string (&optional (epoch (get-universal-time)))
+  "Return a string describing the current time according to
+the RFC822."
+  (multiple-value-bind (ss mm hh day month year week-day dst tz) (decode-universal-time epoch)
+    (declare (ignore dst))
+    (format nil "~A, ~A ~A ~2,'0D ~2,'0D:~2,'0D:~2,'0D ~:[-~;+~]~2,'0D~2,'0D"
+            (subseq (week-day->string week-day) 0 3)
+            day (subseq (month->string month) 0 3) (mod year 100) hh mm ss
+            (plusp tz) (abs (truncate tz)) (mod (* 60 tz) 60))))
+
+(defun parse-RFC822-date (date-string)
+  "Parse a RFC822 compliant date string and return an universal
+time."
+  ;; if we can't parse it, just return NIL
+  (ignore-errors
+    ;; skip the optional DoW
+    (awhen (position #\, date-string)
+      (setf date-string (subseq date-string (1+ it))))
+    (destructuring-bind (day month year time &optional tz &rest rubbish)
+        (split-at '(#\space #\tab) date-string)
+      (declare (ignore rubbish))
+      (destructuring-bind (hh mm &optional ss) (split-string-at-char time #\:)
+        (encode-universal-time
+         (if ss
+             (read-from-string ss)
+             0)
+         (read-from-string mm)
+         (read-from-string hh)
+         (read-from-string day)
+         (1+ (position month
+                       '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
+                         "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
+                       :test #'string-equal))
+         (read-from-string year)
+         (when (and tz (or (char= #\+ (elt tz 0))
+                           (char= #\- (elt tz 0))))
+           (/ (read-from-string tz) 100)))))))
+
+(defun read-RFC822-headers (stream &optional required-headers)
+  "Read RFC822 compliant headers from STREAM and return them in a
+alist of keyword and string pairs.  REQUIRED-HEADERS is a list of
+header names we are interested in; if NIL return all headers
+found in STREAM."
+  ;; the skip-header variable is to avoid the mistake of appending a
+  ;; continuation line of a header we don't want to a header we want
+  (loop
+     with headers = '() and skip-header = nil
+     for line = (let ((line (read-line stream nil)))
+                  ;; skip the Unix "From " header if present
+                  (if (string-starts-with "From " line)
+                      (read-line stream nil)
+                      line))
+     then (read-line stream nil)
+     while (and line
+                (not (zerop (length line))))
+     do (if (whitespace-p (elt line 0))
+            (unless (or skip-header
+                        (null headers))
+              (setf (cdar headers) (s+ (cdar headers) '(#\newline) line)))
+            (multiple-value-bind (name value) (parse-RFC822-header line)
+              ;; the line contained rubbish instead of an header: we
+              ;; play nice and return as we were at the end of the
+              ;; headers
+              (unless name
+                (return (nreverse headers)))
+              (if (or (null required-headers)
+                      (member name required-headers :test #'string-equal))
+                  (progn
+                    (push (cons name value) headers)
+                    (setf skip-header nil))
+                  (setf skip-header t))))
+     finally (return (nreverse headers))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric mime-message (thing)
+  (:documentation
+   "Convert THING to a MIME-MESSAGE object."))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun mime-message-header-values (name message &key decode)
+  "Return all values of the header with NAME in MESSAGE, optionally decoding
+  it according to RFC2047 if :DECODE is T."
+  (loop ;; A header may occur multiple times
+        for header in (mime-message-headers message)
+        ;; MIME Headers should be case insensitive
+        ;; https://stackoverflow.com/a/6143644
+        when (string-equal (car header) name)
+        collect (if decode
+                    (decode-RFC2047 (cdr header))
+                    (cdr header))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *lazy-mime-decode* t
+  "If true don't  decode mime bodies in memory.")
+
+(defgeneric decode-mime-body (part input-stream))
+
+(defmethod decode-mime-body ((part mime-part) (stream flexi-stream))
+  (let ((base (flexi-stream-root-stream stream)))
+    (if *lazy-mime-decode*
+        (setf (mime-body part)
+              (make-file-portion :data (etypecase base
+                                         (vector-stream
+                                          (flexi-streams::vector-stream-vector base))
+                                         (file-stream
+                                          (pathname base)))
+                                 :encoding (mime-encoding part)
+                                 :start (flexi-stream-position stream)
+                                 :end (flexi-stream-bound stream)))
+        (call-next-method))))
+
+(defmethod decode-mime-body ((part mime-part) (stream file-stream))
+  (if *lazy-mime-decode*
+      (setf (mime-body part)
+            (make-file-portion :data (pathname stream)
+                               :encoding (mime-encoding part)
+                               :start (file-position stream)))
+      (call-next-method)))
+
+(defmethod decode-mime-body ((part mime-part) (stream vector-stream))
+  (if *lazy-mime-decode*
+      (setf (mime-body part)
+            (make-file-portion :data (flexi-streams::vector-stream-vector stream)
+                               :encoding (mime-encoding part)
+                               :start (flexi-streams::vector-stream-index stream)))
+      (call-next-method)))
+
+(defmethod decode-mime-body ((part mime-part) stream)
+  (setf (mime-body part)
+        (decode-stream-to-sequence stream (mime-encoding part))))
+
+(defmethod decode-mime-body ((part mime-multipart) stream)
+  "Decode STREAM according to PART characteristics and return a
+list of MIME parts."
+  (save-file-excursion (stream)
+    (let ((offsets (index-multipart-parts stream (get-mime-type-parameter part :boundary))))
+      (setf (mime-parts part)
+            (mapcar #'(lambda (p)
+                        (destructuring-bind (start . end) p
+                          (let ((*default-type* (if (eq :digest (mime-subtype part))
+                                                    '("message" "rfc822" ())
+                                                    '("text" "plain" (("charset" . "us-ascii")))))
+                                (in (make-positioned-flexi-input-stream stream
+                                                                        :position start
+                                                                        :bound end
+                                                                        :ignore-close t)))
+                            (read-mime-part in))))
+                    offsets)))))
+
+(defmethod decode-mime-body ((part mime-message) stream)
+  "Read from STREAM the body of PART.  Return the decoded MIME
+body."
+  (setf (mime-body part)
+        (read-mime-message stream)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar +known-encodings+ '(:7BIT :8BIT :BINARY :QUOTED-PRINTABLE :BASE64)
+  "List of known content encodings.")
+
+(defun keywordify-encoding (string)
+  "Return a keyword for a content transfer encoding string.
+Return STRING itself if STRING is an unkown encoding."
+  (aif (member string +known-encodings+ :test #'string-equal)
+       (car it)
+       string))
+
+(defun header (name headers)
+  (let ((elt (assoc name headers :test #'string-equal)))
+    (values (cdr elt) (car elt))))
+
+(defun (setf header) (value name headers)
+  (let ((entry (assoc name headers :test #'string-equal)))
+    (unless entry
+      (error "missing header ~A can't be set" name))
+    (setf (cdr entry) value)))
+
+(defun make-mime-part (headers stream)
+  "Create a MIME-PART object based on HEADERS and a body which
+has to be read from STREAM.  If the mime part type can't be
+guessed from the headers, use the *DEFAULT-TYPE*."
+  (flet ((hdr (what)
+           (header what headers)))
+    (destructuring-bind (type subtype parms)
+        (or
+         (aand (hdr :content-type)
+               (parse-content-type it))
+         *default-type*)
+      (let* ((class (or (cadr (assoc type *mime-types* :test #'string-equal))
+                        'mime-unknown-part))
+             (disp (aif (hdr :content-disposition)
+                        (parse-content-disposition it)
+                        (values nil nil)))
+             (part (make-instance class
+                                  :type (hdr :content-type)
+                                  :subtype subtype
+                                  :type-parameters parms
+                                  :disposition (car disp)
+                                  :disposition-parameters (cdr disp)
+                                  :mime-version (hdr :mime-version)
+                                  :encoding (keywordify-encoding
+                                             (hdr :content-transfer-encoding))
+                                  :description (hdr :content-description)
+                                  :id (hdr :content-id)
+                                  :allow-other-keys t)))
+        (decode-mime-body part stream)
+        part))))
+
+(defun read-mime-part (stream)
+  "Read mime part from STREAM.  Return a MIME-PART object."
+  (let ((headers (read-rfc822-headers stream
+                                      '(:mime-version :content-transfer-encoding :content-type
+                                        :content-disposition :content-description :content-id))))
+    (make-mime-part headers stream)))
+
+(defun read-mime-message (stream)
+  "Main function to read a MIME message from a stream.  It
+returns a MIME-MESSAGE object."
+  (let ((headers (read-rfc822-headers stream))
+        (*default-type* '("text" "plain" (("charset" . "us-ascii")))))
+    (flet ((hdr (what)
+             (header what headers)))
+      (destructuring-bind (type subtype parms)
+          (or (aand (hdr :content-type)
+                    (parse-content-type it))
+              *default-type*)
+        (declare (ignore type subtype))
+        (make-instance 'mime-message
+                       :headers headers
+                       ;; this is just for easy access
+                       :type-parameters parms
+                       :body (make-mime-part headers stream))))))
+
+(defmethod mime-message ((msg mime-message))
+  msg)
+
+(defmethod mime-message ((msg string))
+  (mime-message (flexi-streams:string-to-octets msg)))
+
+(defmethod mime-message ((msg vector))
+  (with-input-from-sequence (in msg)
+    (mime-message in)))
+
+(defmethod mime-message ((msg pathname))
+  (with-open-file (in msg :element-type '(unsigned-byte 8))
+    (mime-message in)))
+
+(defmethod mime-message ((msg flexi-stream))
+  (read-mime-message msg))
+
+(defmethod mime-message ((msg stream))
+  (read-mime-message (make-flexi-stream msg)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric mime-part (object)
+  (:documentation
+   "Promote object, if necessary, to MIME-PART."))
+
+(defmethod mime-part ((object string))
+  (make-instance 'mime-text :subtype "plain" :body object))
+
+(defmethod mime-part ((object pathname))
+  (make-instance 'mime-application
+                 :subtype "octect-stream"
+                 :content-transfer-encoding :base64
+                 :body (read-file object :element-type '(unsigned-byte 8))))
+
+(defmethod mime-part ((object mime-part))
+  object)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod make-encoded-body-stream ((part mime-bodily-part))
+  (let ((body (mime-body part)))
+    (make-instance (case (mime-encoding part)
+                     (:base64
+                      'base64-encoder-input-stream)
+                     (:quoted-printable
+                      'quoted-printable-encoder-input-stream)
+                     (otherwise
+                      '8bit-encoder-input-stream))
+                   :underlying-stream
+                   (make-input-adapter body))))
+
+(defun choose-boundary (parts &optional default)
+  (labels ((match-in-parts (boundary parts)
+             (loop
+                for p in parts
+                thereis (typecase p
+                          (mime-multipart
+                           (match-in-parts boundary (mime-parts p)))
+                          (mime-bodily-part
+                           (match-in-body p boundary)))))
+           (match-in-body (part boundary)
+             (with-open-stream (in (make-encoded-body-stream part))
+               (loop
+                  for line = (read-line in nil)
+                  while line
+                  when (string= line boundary)
+                  return t
+                  finally (return nil)))))
+    (do ((boundary (if default
+                       (format nil "--~A" default)
+                       #1=(format nil "--~{~36R~}"
+                                  (loop
+                                     for i from 0 below 20
+                                     collect (random 36))))
+                   #1#))
+        ((not (match-in-parts boundary parts)) (subseq boundary 2)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; fall back method
+(defmethod mime-part-size ((part mime-part))
+  (let ((body (mime-body part)))
+    (typecase body
+      (pathname
+       (file-size body))
+      (string
+       (length body))
+      (vector
+       (length body))
+      (t nil))))
+
+(defmethod mime-part-size ((part mime-multipart))
+  (loop
+     for p in (mime-parts part)
+     for size = (mime-part-size p)
+     unless size
+     return nil
+     sum size))
+
+(defmethod mime-part-size ((part mime-message))
+  (mime-part-size (mime-body part)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod print-mime-part ((part mime-multipart) (out stream))
+  (case (mime-subtype part)
+    (:alternative
+     ;; try to choose something simple to print or the first thing
+     (let ((parts (mime-parts part)))
+       (print-mime-part (or (find-if #'(lambda (part)
+                                         (and (eq (class-of part) (find-class 'mime-text))
+                                              (eq (mime-subtype part) :plain)))
+                                     parts)
+                            (car parts)) out)))
+    (otherwise
+     (dolist (subpart (mime-parts part))
+       (print-mime-part subpart out)))))
+
+;; This is WRONG.  Here we don't use any special character encoding
+;; because we don't know which one we should use.  Messages written in
+;; anything but ASCII will likely be unreadable -wcp11/10/07.
+(defmethod print-mime-part ((part mime-text) (out stream))
+  (let ((body (mime-body part)))
+    (etypecase body
+      (string
+       (write-string body out))
+      (vector
+       (loop
+          for byte across body
+          do (write-char (code-char byte) out)))
+      (pathname
+       (with-open-file (in body)
+         (loop
+            for c = (read-char in nil)
+            while c
+            do (write-char c out)))))))
+
+(defmethod print-mime-part ((part mime-message) (out stream))
+  (flet ((hdr (name)
+           (multiple-value-bind (value tag)
+               (header name (mime-message-headers part))
+             (cons tag value))))
+    (dolist (h (mapcar #'hdr '("from" "subject" "to" "date" "x-march-archive-id")))
+      (when h
+        (format out "~&~A: ~A" (car h) (cdr h))))
+    (format out "~2%")
+    (print-mime-part (mime-body part) out)))
+
+(defmethod print-mime-part ((part mime-part) (out stream))
+  (format out "~&[ ~A subtype=~A ~@[description=~S ~]~@[size=~A~] ]~%"
+          (type-of part) (mime-subtype part) (mime-description part) (mime-part-size part)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric find-mime-part-by-path (mime path)
+  (:documentation
+   "Return a subpart of MIME identified by PATH, which is a list of
+integers.  For example '(2 3 1) is the first part of the third of the
+second in MIME."))
+
+(defmethod find-mime-part-by-path ((part mime-part) path)
+  (if (null path)
+      part
+      (error "~S doesn't have subparts" part)))
+
+(defmethod find-mime-part-by-path ((part mime-message) path)
+  (if (null path)
+      part
+      (if (= 1 (car path))
+          (find-mime-part-by-path (mime-body part) (cdr path))
+          (error "~S may have just one subpart, but part ~D was requested (parts are enumerated base 1)."
+                 part (car path)))))
+
+(defmethod find-mime-part-by-path ((part mime-multipart) path)
+  (if (null path)
+      part
+      (let ((parts (mime-parts part))
+            (part-number (car path)))
+        (if (<= 1 part-number (length parts))
+            (find-mime-part-by-path (nth (1- (car path)) (mime-parts part)) (cdr path))
+            (error "~S has just ~D subparts, but part ~D was requested (parts are enumerated base 1)."
+                   part (length parts) part-number)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric find-mime-part-by-id (part id)
+  (:documentation
+   "Return a subpart of PAR, whose Content-ID is the same as ID, which
+is a string."))
+
+(defmethod find-mime-part-by-id ((part mime-part) id)
+  (when (string= id (mime-id part))
+    part))
+
+(defmethod find-mime-part-by-id ((part mime-message) id)
+  (find-mime-part-by-id (mime-body part) id))
+
+(defmethod find-mime-part-by-id ((part mime-multipart) id)
+  (or (call-next-method)
+      (some #'(lambda (p)
+                (find-mime-part-by-id p id))
+            (mime-parts part))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric find-mime-text-part (msg)
+  (:documentation
+   "Return message if it is a text message or first text part.
+   If no suitable text part is found, return NIL."))
+
+(defmethod find-mime-text-part ((part mime-text))
+  part) ; found our target
+
+(defmethod find-mime-text-part ((msg mime-message))
+  ;; mime-body is either a mime-part or mime-multipart
+  (find-mime-text-part (mime-body msg)))
+
+(defmethod find-mime-text-part ((parts mime-multipart))
+  ;; multipart messages may have a body, otherwise we
+  ;; search for the first text part
+  (or (call-next-method)
+      (find-if #'find-mime-text-part (mime-parts parts))))
+
+(defmethod find-mime-text-part ((part mime-part))
+  nil) ; default case
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric mime-type-string (mime-part)
+  (:documentation
+   "Return the string describing the MIME part."))
+
+(defmethod mime-type-string ((part mime-unknown-part))
+  (mime-type part))
+
+(defmethod mime-type-string ((part mime-text))
+  (format nil "text/~A" (mime-subtype part)))
+
+(defmethod mime-type-string ((part mime-image))
+  (format nil "image/~A" (mime-subtype part)))
+
+(defmethod mime-type-string ((part mime-audio))
+  (format nil "audio/~A" (mime-subtype part)))
+
+(defmethod mime-type-string ((part mime-video))
+  (format nil "video/~A" (mime-subtype part)))
+
+(defmethod mime-type-string ((part mime-application))
+  (format nil "application/~A" (mime-subtype part)))
+
+(defmethod mime-type-string ((part mime-multipart))
+  (format nil "multipart/~A" (mime-subtype part)))
+
+(defmethod mime-type-string ((part mime-message))
+  (format nil "message/~A" (mime-subtype part)))
+
+(defmethod mime-type-string ((part mime-unknown-part))
+  (mime-type part))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric map-parts (function mime-part)
+  (:documentation
+   "Recursively map FUNCTION to MIME-PART or its components."))
+
+;; Here we wrongly assume that we'll never want to replace messages
+;; and multiparts altogether.  If you need to do so you have to write
+;; your own mapping functions.
+
+(defmethod map-parts ((function function) (part mime-part))
+  (funcall function part))
+
+(defmethod map-parts ((function function) (part mime-message))
+  (setf (mime-body part) (map-parts function (mime-body part)))
+  part)
+
+(defmethod map-parts ((function function) (part mime-multipart))
+  (setf (mime-parts part) (mapcar #'(lambda (p)
+                                      (map-parts function p))
+                                  (mime-parts part)))
+  part)
+
+;; apply-on-parts is like map-parts but doesn't modify the parts (at least
+;; not implicitly)
+
+(defgeneric apply-on-parts (function part))
+
+(defmethod apply-on-parts ((function function) (part mime-part))
+  (funcall function part))
+
+(defmethod apply-on-parts ((function function) (part mime-multipart))
+  (dolist (p (mime-parts part))
+    (apply-on-parts function p)))
+
+(defmethod apply-on-parts ((function function) (part mime-message))
+  (apply-on-parts function (mime-body part)))
+
+(defmacro do-parts ((var mime-part) &body body)
+  `(apply-on-parts #'(lambda (,var) ,@body) ,mime-part))
diff --git a/third_party/lisp/mime4cl/mime4cl-tests.asd b/third_party/lisp/mime4cl/mime4cl-tests.asd
new file mode 100644
index 000000000000..f3b429eafbf7
--- /dev/null
+++ b/third_party/lisp/mime4cl/mime4cl-tests.asd
@@ -0,0 +1,55 @@
+;;;  mime4cl-tests.asd --- system description for the regression tests
+
+;;;  Copyright (C) 2006, 2007, 2010 by Walter C. Pelissero
+;;;  Copyright (C) 2022 by The TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+#-(or sbcl)
+(warn "This code hasn't been tested on your Lisp system.")
+
+(defpackage :mime4cl-tests-system
+  (:use :common-lisp :asdf #+asdfa :asdfa)
+  (:export #:*base-directory*
+           #:*compilation-epoch*))
+
+(in-package :mime4cl-tests-system)
+
+(defsystem mime4cl-tests
+    :name "MIME4CL-tests"
+    :author "Walter C. Pelissero <walter@pelissero.de>"
+    :maintainer "Walter C. Pelissero <walter@pelissero.de>"
+    :description "Test suite for the MIME4CL library"
+    :long-description
+    "These regression tests require rt.lisp from MIT.  It is included."
+    :licence "LGPL"
+    :depends-on (:mime4cl)
+    :components
+    ((:module test
+              :components
+              ((:file "rt")
+               (:file "package" :depends-on ("rt"))
+               (:file "endec" :depends-on ("rt" "package"))
+               (:file "address" :depends-on ("rt" "package"))
+               (:file "mime" :depends-on ("rt" "package"))))))
+
+;; when loading this form the regression-test, the package is yet to
+;; be loaded so we cannot use rt:do-tests directly or we would get a
+;; reader error (unknown package)
+(defmethod perform ((o test-op) (c (eql (find-system :mime4cl-tests))))
+  (or (funcall (intern "DO-TESTS" "REGRESSION-TEST"))
+      (error "test-op failed")))
diff --git a/third_party/lisp/mime4cl/mime4cl.asd b/third_party/lisp/mime4cl/mime4cl.asd
new file mode 100644
index 000000000000..6528f115d47a
--- /dev/null
+++ b/third_party/lisp/mime4cl/mime4cl.asd
@@ -0,0 +1,49 @@
+;;;  mime4cl.asd --- system definition
+
+;;;  Copyright (C) 2005-2007, 2010 by Walter C. Pelissero
+;;;  Copyright (C) 2022 by The TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 2, or (at
+;;; your option) any later version.
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+
+(in-package :cl-user)
+
+(defpackage :mime4cl-system
+  (:use :common-lisp :asdf))
+
+(in-package :mime4cl-system)
+
+(defsystem mime4cl
+    :name "MIME4CL"
+    :author "Walter C. Pelissero <walter@pelissero.de>"
+    :maintainer "Walter C. Pelissero <walter@pelissero.de>"
+    ;; :version "0.0"
+    :description "MIME primitives for Common Lisp"
+    :long-description
+    "A collection of Common Lisp primitives to forge and handle
+MIME mail contents."
+    :licence "LGPL"
+    :depends-on (:npg :sclf :trivial-gray-streams)
+    :components
+    ((:file "package")
+     (:file "mime" :depends-on ("package" "endec" "streams"))
+     (:file "endec" :depends-on ("package"))
+     (:file "streams" :depends-on ("package" "endec"))
+     (:file "address" :depends-on ("package"))))
+
+(defmethod perform ((o test-op) (c (eql (find-system 'mime4cl))))
+  (oos 'load-op 'mime4cl-tests)
+  (oos 'test-op 'mime4cl-tests :force t))
diff --git a/third_party/lisp/mime4cl/package.lisp b/third_party/lisp/mime4cl/package.lisp
new file mode 100644
index 000000000000..94b9e6b39053
--- /dev/null
+++ b/third_party/lisp/mime4cl/package.lisp
@@ -0,0 +1,103 @@
+;;;  package.lisp --- package declaration
+
+;;;  Copyright (C) 2005-2007, 2010 by Walter C. Pelissero
+;;;  Copyright (C) 2022 The TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :cl-user)
+
+(defpackage :mime4cl
+  (:nicknames :mime)
+  (:use :common-lisp :npg :mime4cl-ex-sclf :trivial-gray-streams :flexi-streams)
+  (:export #:*lazy-mime-decode*
+           #:print-mime-part
+           #:read-mime-message
+           #:mime-part
+           #:mime-text
+           #:mime-binary
+           #:mime-id
+           #:mime-image
+           #:mime-message
+           #:mime-multipart
+           #:mime-audio
+           #:mime-unknown-part
+           #:get-mime-disposition-parameter
+           #:get-mime-type-parameter
+           #:mime-disposition
+           #:mime-disposition-parameters
+           #:mime-encoding
+           #:mime-application
+           #:mime-video
+           #:mime-description
+           #:mime-part-size
+           #:mime-subtype
+           #:mime-body
+           #:mime-body-stream
+           #:mime-body-length
+           #:mime-parts
+           #:mime-part-p
+           #:mime-type
+           #:mime-type-string
+           #:mime-type-parameters
+           #:mime-message-headers
+           #:mime-message-header-values
+           #:mime=
+           #:find-mime-part-by-path
+           #:find-mime-part-by-id
+           #:find-mime-text-part
+           #:encode-mime-part
+           #:encode-mime-body
+           #:decode-quoted-printable-stream
+           #:decode-quoted-printable-string
+           #:encode-quoted-printable-stream
+           #:encode-quoted-printable-sequence
+           #:encode-base64-stream
+           #:encode-base64-sequence
+           #:parse-RFC2047-text
+           #:decode-RFC2047
+           #:parse-RFC822-header
+           #:read-RFC822-headers
+           #:time-RFC822-string
+           #:parse-RFC822-date
+           #:map-parts
+           #:do-parts
+           #:apply-on-parts
+           #:mime-part-file-name
+           #:mime-text-charset
+           #:with-input-from-mime-body-stream
+           ;; endec.lisp
+           #:base64-encoder
+           #:null-encoder
+           #:null-decoder
+           #:byte-encoder
+           #:byte-decoder
+           #:quoted-printable-encoder
+           #:quoted-printable-decoder
+           #:encoder-write-byte
+           #:encoder-finish-output
+           #:decoder-read-byte
+           #:decoder-read-sequence
+           #:*base64-line-length*
+           #:*quoted-printable-line-length*
+           ;; address.lisp
+           #:parse-addresses #:mailboxes-only
+           #:mailbox #:mbx-description #:mbx-user #:mbx-host #:mbx-domain #:mbx-domain-name #:mbx-address
+           #:mailbox-group #:mbxg-name #:mbxg-mailboxes
+           ;; streams.lisp
+           #:redirect-stream
+           ))
diff --git a/third_party/lisp/mime4cl/streams.lisp b/third_party/lisp/mime4cl/streams.lisp
new file mode 100644
index 000000000000..71a32d84e461
--- /dev/null
+++ b/third_party/lisp/mime4cl/streams.lisp
@@ -0,0 +1,274 @@
+;;; streams.lisp --- En/De-coding Streams
+
+;;; Copyright (C) 2012 by Walter C. Pelissero
+;;; Copyright (C) 2021-2023 by the TVL Authors
+
+;;; Author: Walter C. Pelissero <walter@pelissero.de>
+;;; Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl)
+
+(defun flexi-stream-root-stream (stream)
+  "Return the non FLEXI-STREAM stream a given chain of FLEXI-STREAMs is based on."
+  (if (typep stream 'flexi-stream)
+      (flexi-stream-root-stream (flexi-stream-stream stream))
+      stream))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass coder-stream-mixin ()
+  ((real-stream :type stream
+                :initarg :underlying-stream
+                :reader real-stream)
+   (dont-close :initform nil
+               :initarg :dont-close)))
+
+(defmethod stream-file-position ((stream coder-stream-mixin))
+  (file-position (slot-value stream 'real-stream)))
+
+(defmethod (setf stream-file-position) (newval (stream coder-stream-mixin))
+  (file-position (slot-value stream 'real-stream) newval))
+
+(defclass coder-input-stream-mixin (fundamental-binary-input-stream coder-stream-mixin)
+  ())
+(defclass coder-output-stream-mixin (fundamental-binary-output-stream coder-stream-mixin)
+  ())
+
+;; TODO(sterni): temporary, ugly measure to make flexi-streams happy
+(defmethod stream-element-type ((stream coder-input-stream-mixin))
+  (declare (ignore stream))
+  '(unsigned-byte 8))
+
+(defclass quoted-printable-decoder-stream (coder-input-stream-mixin quoted-printable-decoder) ())
+(defclass 8bit-decoder-stream (coder-input-stream-mixin 8bit-decoder) ())
+
+(defclass quoted-printable-encoder-stream (coder-output-stream-mixin quoted-printable-encoder) ())
+(defclass base64-encoder-stream (coder-output-stream-mixin base64-encoder) ())
+(defclass 8bit-encoder-stream (coder-output-stream-mixin 8bit-encoder) ())
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod initialize-instance :after ((stream coder-stream-mixin) &key &allow-other-keys)
+  (unless (slot-boundp stream 'real-stream)
+    (error "REAL-STREAM is unbound.  Must provide a :UNDERLYING-STREAM argument.")))
+
+(defmethod initialize-instance ((stream coder-output-stream-mixin) &key &allow-other-keys)
+  (call-next-method)
+  (unless (slot-boundp stream 'output-function)
+    (setf (slot-value stream 'output-function)
+          #'(lambda (char)
+              (write-char char (slot-value stream 'real-stream))))))
+
+(defmethod initialize-instance ((stream coder-input-stream-mixin) &key &allow-other-keys)
+  (call-next-method)
+  (unless (slot-boundp stream 'input-function)
+    (setf (slot-value stream 'input-function)
+          #'(lambda ()
+              (read-char (slot-value stream 'real-stream) nil)))))
+
+(defmethod stream-read-byte ((stream coder-input-stream-mixin))
+  (or (decoder-read-byte stream)
+      :eof))
+
+(defmethod stream-write-byte ((stream coder-output-stream-mixin) byte)
+  (encoder-write-byte stream byte))
+
+(defmethod close ((stream coder-stream-mixin) &key abort)
+  (with-slots (real-stream dont-close) stream
+    (unless dont-close
+      (close real-stream :abort abort))))
+
+(defmethod close ((stream coder-output-stream-mixin) &key abort)
+  (unless abort
+    (encoder-finish-output stream))
+  (call-next-method))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass encoder-input-stream (fundamental-character-input-stream coder-stream-mixin)
+  ((encoder)
+   (buffer-queue :initform (make-queue)))
+  (:documentation
+   "This is the base class for encoders with the direction swapped. It
+reads from REAL-STREAM a stream of bytes, encodes it and returnes it
+in a stream of character."))
+
+(defclass quoted-printable-encoder-input-stream (encoder-input-stream) ())
+(defclass base64-encoder-input-stream (encoder-input-stream) ())
+(defclass 8bit-encoder-input-stream (fundamental-character-input-stream coder-stream-mixin) ())
+
+(defmethod initialize-instance ((stream quoted-printable-encoder-input-stream) &key &allow-other-keys)
+  (call-next-method)
+  (with-slots (encoder buffer-queue) stream
+    (setf encoder
+          (make-instance 'quoted-printable-encoder
+                         :output-function #'(lambda (char)
+                                              (queue-append buffer-queue char))))))
+
+(defmethod initialize-instance ((stream base64-encoder-input-stream) &key &allow-other-keys)
+  (call-next-method)
+  (with-slots (encoder buffer-queue) stream
+    (setf encoder
+          (make-instance 'base64-encoder
+                         :output-function #'(lambda (char)
+                                              (queue-append buffer-queue char))))))
+
+(defmethod stream-read-char ((stream encoder-input-stream))
+  (with-slots (encoder buffer-queue real-stream) stream
+    (loop
+       while (queue-empty-p buffer-queue)
+       do (let ((byte (read-byte real-stream nil)))
+            (if byte
+                (encoder-write-byte encoder byte)
+                (progn
+                  (encoder-finish-output encoder)
+                  (queue-append buffer-queue :eof)))))
+    (queue-pop buffer-queue)))
+
+
+(defmethod stream-read-char ((stream 8bit-encoder-input-stream))
+  (with-slots (real-stream) stream
+    (aif (read-byte real-stream nil)
+         (code-char it)
+         :eof)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun make-custom-flexi-stream (class stream other-args)
+  (apply #'make-instance
+         class
+         :stream stream
+         (mapcar (lambda (x)
+                   ;; make-flexi-stream has a discrepancy between :initarg of
+                   ;; make-instance and its &key which we mirror here.
+                   (if (eq x :external-format) :flexi-stream-external-format x))
+                 other-args)))
+
+(defclass adapter-flexi-input-stream (flexi-input-stream)
+  ((ignore-close
+    :initform nil
+    :initarg :ignore-close
+    :documentation
+    "If T, calling CLOSE on the stream does nothing.
+If NIL, the underlying stream is closed."))
+  (:documentation "FLEXI-STREAM that does not close the underlying stream on
+CLOSE if :IGNORE-CLOSE is T."))
+
+(defmethod close ((stream adapter-flexi-input-stream) &key abort)
+  (declare (ignore abort))
+  (with-slots (ignore-close) stream
+    (unless ignore-close
+      (call-next-method))))
+
+(defun make-input-adapter (source)
+  (etypecase source
+    ;; If it's already a stream, we need to make sure it's not closed by the adapter
+    (stream
+     (assert (input-stream-p source))
+     (if (and (typep source 'adapter-flexi-input-stream)
+              (slot-value source 'ignore-close))
+         source ; already ignores CLOSE
+         (make-adapter-flexi-input-stream source :ignore-close t)))
+    ;; TODO(sterni): is this necessary? (maybe with (not *lazy-mime-decode*)?)
+    (string
+     (make-input-adapter (string-to-octets source)))
+    ((vector (unsigned-byte 8))
+     (make-in-memory-input-stream source))
+    (pathname
+     (make-flexi-stream (open source :element-type '(unsigned-byte 8))))
+    (file-portion
+     (open-decoded-file-portion source))))
+
+(defun make-adapter-flexi-input-stream (stream &rest args)
+  "Create a ADAPTER-FLEXI-INPUT-STREAM. Accepts the same keyword arguments as
+MAKE-FLEXI-STREAM as well as :IGNORE-CLOSE. If T, the underlying stream is not
+closed."
+  (make-custom-flexi-stream 'adapter-flexi-input-stream stream args))
+
+(defclass positioned-flexi-input-stream (adapter-flexi-input-stream)
+  ()
+  (:documentation
+   "FLEXI-INPUT-STREAM that automatically advances the underlying :STREAM to
+the location given by :POSITION. This uses FILE-POSITION internally, so it'll
+only works if the underlying stream position is tracked in bytes. Note that
+the underlying stream is still advanced, so having multiple instances of
+POSITIONED-FLEXI-INPUT-STREAM based with the same underlying stream won't work
+reliably.
+Also supports :IGNORE-CLOSE of ADAPTER-FLEXI-INPUT-STREAM."))
+
+(defmethod initialize-instance ((stream positioned-flexi-input-stream)
+                                &key &allow-other-keys)
+  (call-next-method)
+  ;; The :POSITION initarg is only informational for flexi-streams: It assumes
+  ;; it is were the stream it got is already at and continuously updates it
+  ;; for querying (via FLEXI-STREAM-POSITION) and bound checking.
+  ;; Since we have streams that are not positioned correctly, we need to do this
+  ;; here using FILE-POSITION. Note that assumes the underlying implementation
+  ;; uses bytes for FILE-POSITION which is not guaranteed (probably some streams
+  ;; even in SBCL don't).
+  (file-position (flexi-stream-stream stream) (flexi-stream-position stream)))
+
+(defun make-positioned-flexi-input-stream (stream &rest args)
+  "Create a POSITIONED-FLEXI-INPUT-STREAM. Accepts the same keyword arguments as
+MAKE-FLEXI-STREAM as well as :IGNORE-CLOSE. Causes the FILE-POSITION of STREAM to
+be modified to match the :POSITION argument."
+  (make-custom-flexi-stream 'positioned-flexi-input-stream stream args))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; TODO(sterni): test correct behavior with END NIL
+(defstruct file-portion
+  data                                  ; string or a pathname
+  encoding
+  start
+  end)
+
+(defun open-decoded-file-portion (file-portion)
+  (with-slots (data encoding start end)
+      file-portion
+    (let* ((binary-stream
+             (etypecase data
+               (pathname
+                (open data :element-type '(unsigned-byte 8)))
+               ((vector (unsigned-byte 8))
+                (flexi-streams:make-in-memory-input-stream data))
+               (stream
+                ;; TODO(sterni): assert that bytes/flexi-stream
+                data)))
+           (params (ccase encoding
+                     ((:quoted-printable :base64) '(:external-format :us-ascii))
+                     (:8bit '(:element-type (unsigned-byte 8)))
+                     (:7bit '(:external-format :us-ascii))))
+           (portion-stream (apply #'make-positioned-flexi-input-stream
+                                  binary-stream
+                                  :position start
+                                  :bound end
+                                  ;; if data is a stream we can't have a
+                                  ;; FILE-PORTION without modifying it when
+                                  ;; reading etc. The least we can do, though,
+                                  ;; is forgo destroying it.
+                                  :ignore-close (typep data 'stream)
+                                  params))
+           (needs-decoder-stream (member encoding '(:quoted-printable
+                                                    :base64))))
+
+      (if needs-decoder-stream
+          (make-instance
+           (ccase encoding
+             (:quoted-printable 'quoted-printable-decoder-stream)
+             (:base64 'qbase64:decode-stream))
+           :underlying-stream portion-stream)
+          portion-stream))))
diff --git a/third_party/lisp/mime4cl/test/address.lisp b/third_party/lisp/mime4cl/test/address.lisp
new file mode 100644
index 000000000000..a3653985c40e
--- /dev/null
+++ b/third_party/lisp/mime4cl/test/address.lisp
@@ -0,0 +1,123 @@
+;;;  address.lisp --- tests for the e-mail address parser
+
+;;;  Copyright (C) 2007, 2009 by Walter C. Pelissero
+;;;  Copyright (C) 2022 by The TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl-tests)
+
+(defun test-parsing (string)
+  (format nil "~{~A~^, ~}" (parse-addresses string)))
+
+(deftest address-parse-simple.1
+    (test-parsing "foo@bar")
+  "foo@bar")
+
+(deftest address-parse-simple.2
+    (test-parsing "foo@bar.com")
+  "foo@bar.com")
+
+(deftest address-parse-simple.3
+    (test-parsing "foo@bar.baz.com")
+  "foo@bar.baz.com")
+
+(deftest address-parse-simple.4
+    (test-parsing "foo.ooo@bar.baz.com")
+  "foo.ooo@bar.baz.com")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-simple-commented.1
+    (test-parsing "foo@bar (Some Comment)")
+  "\"Some Comment\" <foo@bar>")
+
+(deftest address-parse-simple-commented.2
+    (test-parsing "foo@bar (Some, Comment)")
+  "\"Some, Comment\" <foo@bar>")
+
+(deftest address-parse-simple-commented.3
+    (test-parsing "foo@bar (Some Comment (yes, indeed))")
+  "\"Some Comment (yes, indeed)\" <foo@bar>")
+
+(deftest address-parse-simple-commented.4
+    (test-parsing "foo.bar@host.complicated.domain.net (Some Comment (yes, indeed))")
+  "\"Some Comment (yes, indeed)\" <foo.bar@host.complicated.domain.net>")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-angle.1
+    (test-parsing "<foo@bar.baz.net>")
+  "foo@bar.baz.net")
+
+(deftest address-parse-angle.2
+    (test-parsing "My far far friend <foo@bar.baz.net>")
+  "\"My far far friend\" <foo@bar.baz.net>")
+
+(deftest address-parse-angle.3
+    (test-parsing "\"someone, I don't like\" <foo@bar.baz.net>")
+  "\"someone, I don't like\" <foo@bar.baz.net>")
+
+(deftest address-parse-angle.4
+    (test-parsing "\"this could (be a comment)\" <foo@bar.net>")
+  "\"this could (be a comment)\" <foo@bar.net>")
+
+(deftest address-parse-angle.5
+    (test-parsing "don't be fooled <foo@bar.net>")
+  "\"don't be fooled\" <foo@bar.net>")
+
+(deftest address-parse-angle.6
+    (test-parsing "<foo@bar>")
+  "foo@bar")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-domain-literal.1
+    (test-parsing "<foo@[bar]>")
+  "foo@[bar]")
+
+(deftest address-parse-domain-literal.2
+    (test-parsing "<foo@[bar.net]>")
+  "foo@[bar.net]")
+
+(deftest address-parse-domain-literal.3
+    (test-parsing "<foo@[10.0.0.2]>")
+  "foo@[10.0.0.2]")
+
+(deftest address-parse-domain-literal.4
+    (test-parsing "<foo.bar@[10.0.0.2]>")
+  "foo.bar@[10.0.0.2]")
+
+(deftest address-parse-domain-literal.5
+    (test-parsing "somewhere unkown <foo.bar@[10.0.0.2]>")
+  "\"somewhere unkown\" <foo.bar@[10.0.0.2]>")
+
+(deftest address-parse-domain-literal.6
+    (test-parsing "\"Some--One\" <foo.bar@[10.0.0.23]>")
+  "\"Some--One\" <foo.bar@[10.0.0.23]>")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-group.1
+    (test-parsing "friends:john@bar.in.soho, jack@pub.round.the.corner, jim@[10.0.1.2];")
+  "friends: john@bar.in.soho, jack@pub.round.the.corner, jim@[10.0.1.2];")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-mixed.1
+    (test-parsing "Foo BAR <foo@bar.com>, \"John, Smith (that one!)\" <john.smith@host.domain.org>, friends:john@bar,jack@pub;, foo.bar.baz@wow.mail.mine, dont.bark@me (Fierce Dog)")
+  "\"Foo BAR\" <foo@bar.com>, \"John, Smith (that one!)\" <john.smith@host.domain.org>, friends: john@bar, jack@pub;, foo.bar.baz@wow.mail.mine, \"Fierce Dog\" <dont.bark@me>")
diff --git a/third_party/lisp/mime4cl/test/endec.lisp b/third_party/lisp/mime4cl/test/endec.lisp
new file mode 100644
index 000000000000..6b22b3f6a287
--- /dev/null
+++ b/third_party/lisp/mime4cl/test/endec.lisp
@@ -0,0 +1,184 @@
+;;;  endec.lisp --- test suite for the MIME encoder/decoder functions
+
+;;;  Copyright (C) 2006, 2007, 2009, 2010 by Walter C. Pelissero
+;;;  Copyright (C) 2022 by The TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl-tests)
+
+(deftest quoted-printable.1
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+                                           "Français, Español, böse, skøl"))
+  "Fran=E7ais, Espa=F1ol, b=F6se, sk=F8l")
+
+(deftest quoted-printable.2
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+                                           "Français, Español, böse, skøl")
+                                      :start 10 :end 17)
+  "Espa=F1ol")
+
+(deftest quoted-printable.3
+    (map 'string #'code-char
+         (decode-quoted-printable-string "Fran=E7ais, Espa=F1ol, b=F6se, sk=F8l"))
+  "Français, Español, böse, skøl")
+
+(deftest quoted-printable.4
+    (map 'string #'code-char
+         (decode-quoted-printable-string "Fran=E7ais, Espa=F1ol, b=F6se, sk=F8l"
+                                         :start 12 :end 21))
+  "Español")
+
+(deftest quoted-printable.5
+    (map 'string #'code-char
+         (decode-quoted-printable-string "this = wrong"))
+  "this = wrong")
+
+(deftest quoted-printable.6
+    (map 'string #'code-char
+         (decode-quoted-printable-string "this is wrong="))
+  "this is wrong=")
+
+(deftest quoted-printable.7
+    (map 'string #'code-char
+         (decode-quoted-printable-string "this is wrong=1"))
+  "this is wrong=1")
+
+(deftest quoted-printable.8
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+                                           "x = x + 1"))
+  "x =3D x + 1")
+
+(deftest quoted-printable.9
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+                                           "x = x + 1   "))
+  "x =3D x + 1  =20")
+
+(deftest quoted-printable.10
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+                                           "this string is very very very very very very very very very very very very very very very very very very very very long"))
+  "this string is very very very very very very very very very very very ve=
+ry very very very very very very very very long")
+
+(deftest quoted-printable.11
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+                                           "this string is very very                                                                                  very very long"))
+  "this string is very very                                                =
+                                  very very long")
+
+(deftest quoted-printable.12
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+                                           "please read the next   
+line"))
+  "please read the next  =20
+line")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest base64.1
+    (let ((*base64-line-length* nil))
+      (encode-base64-sequence (map '(vector (unsigned-byte 8)) #'char-code
+                                   "Some random string.")))
+  "U29tZSByYW5kb20gc3RyaW5nLg==")
+
+(deftest base64.2
+    (let ((*base64-line-length* nil))
+      (encode-base64-sequence (map '(vector (unsigned-byte 8)) #'char-code
+                                   "Some random string.") :start 5 :end 11))
+  "cmFuZG9t")
+
+(deftest base64.3
+    (map 'string #'code-char
+         (qbase64:decode-string "U29tZSByYW5kb20gc3RyaW5nLg=="))
+  "Some random string.")
+
+(deftest base64.4
+    (map 'string #'code-char
+         (qbase64:decode-string "U29tZSByYW5kb20gc3RyaW5nLg=="))
+  "Some random string.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest RFC2047.1
+    (parse-RFC2047-text "foo bar")
+  ("foo bar"))
+
+;; from RFC2047 section 8
+(deftest RFC2047.2
+    (decode-RFC2047 "=?US-ASCII?Q?Keith_Moore?= <moore@cs.utk.edu>")
+  "Keith Moore <moore@cs.utk.edu>")
+
+;; from RFC2047 section 8
+(deftest RFC2047.3
+    (decode-RFC2047 "=?ISO-8859-1?Q?Olle_J=E4rnefors?=")
+  "Olle Järnefors")
+
+;; from RFC2047 section 8
+(deftest RFC2047.4
+    (decode-RFC2047 "Nathaniel Borenstein <nsb@thumper.bellcore.com> (=?iso-8859-8?b?7eXs+SDv4SDp7Oj08A==?=)")
+  "Nathaniel Borenstein <nsb@thumper.bellcore.com> (םולש ןב ילטפנ)")
+
+;; from RFC2047 section 8
+(deftest RFC2047.5
+  (decode-RFC2047 "=?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?= <keld@dkuug.dk>")
+  "Keld Jørn Simonsen <keld@dkuug.dk>")
+
+(defun perftest-encoder (encoder-class &optional (megs 100))
+  (declare (optimize (speed 3) (debug 0) (safety 0))
+           (type fixnum megs))
+  (with-open-file (in #P"/dev/random" :element-type '(unsigned-byte 8))
+    (let* ((meg (* 1024 1024))
+           (buffer (make-sequence '(vector (unsigned-byte 8)) meg))
+           (encoder (make-instance encoder-class
+                                   :output-function #'(lambda (c) (declare (ignore c))))))
+      (declare (type fixnum meg))
+      (time
+       (progn
+         (dotimes (x megs)
+           (read-sequence buffer in)
+           (dotimes (i meg)
+             (mime4cl:encoder-write-byte encoder (aref buffer i))))
+         (mime4cl:encoder-finish-output encoder))))))
+
+(defun perftest-decoder (decoder-class &optional (megs 100))
+  (declare (optimize (speed 3) (debug 0) (safety 0))
+           (type fixnum megs))
+  (with-open-file (in #P"/dev/random" :element-type '(unsigned-byte 8))
+    (let ((*tmp-file-defaults* (make-pathname :defaults #.(or *load-pathname* *compile-file-pathname*)
+                                                   :type "encoded-data")))
+      (with-temp-file (tmp nil :direction :io)
+        (let* ((meg (* 1024 1024))
+               (buffer (make-sequence '(vector (unsigned-byte 8)) meg))
+               (encoder-class (ecase decoder-class
+                                (mime4cl:quoted-printable-decoder 'mime4cl:quoted-printable-encoder)))
+               (encoder (make-instance encoder-class
+                                       :output-function #'(lambda (c)
+                                                            (write-char c tmp))))
+               (decoder (make-instance decoder-class
+                                       :input-function #'(lambda ()
+                                                           (read-char tmp nil)))))
+          (declare (type fixnum meg))
+          (dotimes (x megs)
+            (read-sequence buffer in)
+            (dotimes (i meg)
+              (mime4cl:encoder-write-byte encoder (aref buffer i))))
+          (mime4cl:encoder-finish-output encoder)
+          (file-position tmp 0)
+          (time
+           (loop
+              for b = (mime4cl:decoder-read-byte decoder)
+              while b)))))))
diff --git a/third_party/lisp/mime4cl/test/mime.lisp b/third_party/lisp/mime4cl/test/mime.lisp
new file mode 100644
index 000000000000..dbd1dd996dcc
--- /dev/null
+++ b/third_party/lisp/mime4cl/test/mime.lisp
@@ -0,0 +1,41 @@
+;;; mime.lisp --- MIME regression tests
+
+;;; Copyright (C) 2012 by Walter C. Pelissero
+;;; Copyright (C) 2021-2023 by the TVL Authors
+
+;;; Author: Walter C. Pelissero <walter@pelissero.de>
+;;; Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl-tests)
+
+(defvar *samples-directory*
+  (merge-pathnames (make-pathname :directory '(:relative "samples"))
+                   #.(or *compile-file-pathname*
+                         *load-pathname*
+                         #P"")))
+
+(loop
+ for f in (directory (make-pathname :defaults *samples-directory*
+                                    :name :wild
+                                    :type "msg"))
+ for i from 1
+ do
+ (add-test (intern (format nil "MIME.~A" i))
+           `(let* ((orig (mime-message ,f))
+                   (dup (mime-message
+                         (with-output-to-string (out) (encode-mime-part orig out)))))
+              (mime= orig dup))
+           t))
diff --git a/third_party/lisp/mime4cl/test/package.lisp b/third_party/lisp/mime4cl/test/package.lisp
new file mode 100644
index 000000000000..965680448fe4
--- /dev/null
+++ b/third_party/lisp/mime4cl/test/package.lisp
@@ -0,0 +1,27 @@
+;;;  package.lisp --- package description for the regression tests
+
+;;;  Copyright (C) 2006, 2009 by Walter C. Pelissero
+;;;  Copyright (C) 2022 by The TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(cl:in-package :common-lisp)
+
+(defpackage :mime4cl-tests
+  (:use :common-lisp
+        :rtest :mime4cl :mime4cl-ex-sclf)
+  (:export))
diff --git a/third_party/lisp/mime4cl/test/rt.lisp b/third_party/lisp/mime4cl/test/rt.lisp
new file mode 100644
index 000000000000..3f3aa5c56cd3
--- /dev/null
+++ b/third_party/lisp/mime4cl/test/rt.lisp
@@ -0,0 +1,258 @@
+#|----------------------------------------------------------------------------|
+ | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
+ | Copyright 2023 by the TVL Authors                                          |
+ |                                                                            |
+ | Permission  to  use,  copy, modify, and distribute this software  and  its |
+ | documentation for any purpose  and without fee is hereby granted, provided |
+ | that this copyright  and  permission  notice  appear  in  all  copies  and |
+ | supporting  documentation,  and  that  the  name  of M.I.T. not be used in |
+ | advertising or  publicity  pertaining  to  distribution  of  the  software |
+ | without   specific,   written   prior   permission.      M.I.T.  makes  no |
+ | representations  about  the  suitability of this software for any purpose. |
+ | It is provided "as is" without express or implied warranty.                |
+ |                                                                            |
+ |  M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,  INCLUDING  |
+ |  ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL  |
+ |  M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL  DAMAGES  OR  |
+ |  ANY  DAMAGES  WHATSOEVER  RESULTING  FROM  LOSS OF USE, DATA OR PROFITS,  |
+ |  WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER  TORTIOUS  ACTION,  |
+ |  ARISING  OUT  OF  OR  IN  CONNECTION WITH THE USE OR PERFORMANCE OF THIS  |
+ |  SOFTWARE.                                                                 |
+ |----------------------------------------------------------------------------|#
+
+(defpackage #:regression-test
+  (:nicknames #:rtest #-lispworks #:rt)
+  (:use #:cl)
+  (:export #:*do-tests-when-defined* #:*test* #:continue-testing
+           #:deftest #:add-test #:do-test #:do-tests #:get-test #:pending-tests
+           #:rem-all-tests #:rem-test)
+  (:documentation "The MIT regression tester with pfdietz's modifications"))
+
+(in-package :regression-test)
+
+(defvar *test* nil "Current test name")
+(defvar *do-tests-when-defined* nil)
+(defvar *entries* '(nil) "Test database")
+(defvar *in-test* nil "Used by TEST")
+(defvar *debug* nil "For debugging")
+(defvar *catch-errors* t
+  "When true, causes errors in a test to be caught.")
+(defvar *print-circle-on-failure* nil
+  "Failure reports are printed with *PRINT-CIRCLE* bound to this value.")
+(defvar *compile-tests* nil
+  "When true, compile the tests before running them.")
+(defvar *optimization-settings* '((safety 3)))
+(defvar *expected-failures* nil
+  "A list of test names that are expected to fail.")
+
+(defstruct (entry (:conc-name nil)
+                  (:type list))
+  pend name form)
+
+(defmacro vals (entry) `(cdddr ,entry))
+
+(defmacro defn (entry) `(cdr ,entry))
+
+(defun pending-tests ()
+  (do ((l (cdr *entries*) (cdr l))
+       (r nil))
+      ((null l) (nreverse r))
+    (when (pend (car l))
+      (push (name (car l)) r))))
+
+(defun rem-all-tests ()
+  (setq *entries* (list nil))
+  nil)
+
+(defun rem-test (&optional (name *test*))
+  (do ((l *entries* (cdr l)))
+      ((null (cdr l)) nil)
+    (when (equal (name (cadr l)) name)
+      (setf (cdr l) (cddr l))
+      (return name))))
+
+(defun get-test (&optional (name *test*))
+  (defn (get-entry name)))
+
+(defun get-entry (name)
+  (let ((entry (find name (cdr *entries*)
+                     :key #'name
+                     :test #'equal)))
+    (when (null entry)
+      (report-error t
+        "~%No test with name ~:@(~S~)."
+        name))
+    entry))
+
+(defmacro deftest (name form &rest values)
+  `(add-entry '(t ,name ,form .,values)))
+
+(defun add-test (name form &rest values)
+  (funcall #'add-entry (append (list 't name form) values)))
+
+(defun add-entry (entry)
+  (setq entry (copy-list entry))
+  (do ((l *entries* (cdr l))) (nil)
+    (when (null (cdr l))
+      (setf (cdr l) (list entry))
+      (return nil))
+    (when (equal (name (cadr l))
+                 (name entry))
+      (setf (cadr l) entry)
+      (report-error nil
+                    "Redefining test ~:@(~S~)"
+                    (name entry))
+      (return nil)))
+  (when *do-tests-when-defined*
+    (do-entry entry))
+  (setq *test* (name entry)))
+
+(defun report-error (error? &rest args)
+  (cond (*debug*
+         (apply #'format t args)
+         (if error? (throw '*debug* nil)))
+        (error? (apply #'error args))
+        (t (apply #'warn args))))
+
+(defun do-test (&optional (name *test*))
+  (do-entry (get-entry name)))
+
+(defun equalp-with-case (x y)
+  "Like EQUALP, but doesn't do case conversion of characters."
+  (cond
+   ((eq x y) t)
+   ((consp x)
+    (and (consp y)
+         (equalp-with-case (car x) (car y))
+         (equalp-with-case (cdr x) (cdr y))))
+   ((and (typep x 'array)
+         (= (array-rank x) 0))
+    (equalp-with-case (aref x) (aref y)))
+   ((typep x 'vector)
+    (and (typep y 'vector)
+         (let ((x-len (length x))
+               (y-len (length y)))
+           (and (eql x-len y-len)
+                (loop
+                 for e1 across x
+                 for e2 across y
+                 always (equalp-with-case e1 e2))))))
+   ((and (typep x 'array)
+         (typep y 'array)
+         (not (equal (array-dimensions x)
+                     (array-dimensions y))))
+    nil)
+   ((typep x 'array)
+    (and (typep y 'array)
+         (let ((size (array-total-size x)))
+           (loop for i from 0 below size
+                 always (equalp-with-case (row-major-aref x i)
+                                          (row-major-aref y i))))))
+   (t (eql x y))))
+
+(defun do-entry (entry &optional
+                       (s *standard-output*))
+  (catch '*in-test*
+    (setq *test* (name entry))
+    (setf (pend entry) t)
+    (let* ((*in-test* t)
+           ;; (*break-on-warnings* t)
+           (aborted nil)
+           r)
+      ;; (declare (special *break-on-warnings*))
+
+      (block aborted
+        (setf r
+              (flet ((%do
+                      ()
+                      (if *compile-tests*
+                          (multiple-value-list
+                           (funcall (compile
+                                     nil
+                                     `(lambda ()
+                                        (declare
+                                         (optimize ,@*optimization-settings*))
+                                        ,(form entry)))))
+                        (multiple-value-list
+                         (eval (form entry))))))
+                (if *catch-errors*
+                    (handler-bind
+                        ((style-warning #'muffle-warning)
+                         (error #'(lambda (c)
+                                    (setf aborted t)
+                                    (setf r (list c))
+                                    (return-from aborted nil))))
+                      (%do))
+                  (%do)))))
+
+      (setf (pend entry)
+            (or aborted
+                (not (equalp-with-case r (vals entry)))))
+
+      (when (pend entry)
+        (let ((*print-circle* *print-circle-on-failure*))
+          (format s "~&Test ~:@(~S~) failed~
+                   ~%Form: ~S~
+                   ~%Expected value~P: ~
+                      ~{~S~^~%~17t~}~%"
+                  *test* (form entry)
+                  (length (vals entry))
+                  (vals entry))
+          (format s "Actual value~P: ~
+                      ~{~S~^~%~15t~}.~%"
+                  (length r) r)))))
+  (when (not (pend entry)) *test*))
+
+(defun continue-testing ()
+  (if *in-test*
+      (throw '*in-test* nil)
+      (do-entries *standard-output*)))
+
+(defun do-tests (&optional
+                 (out *standard-output*))
+  (dolist (entry (cdr *entries*))
+    (setf (pend entry) t))
+  (if (streamp out)
+      (do-entries out)
+      (with-open-file
+          (stream out :direction :output)
+        (do-entries stream))))
+
+(defun do-entries (s)
+  (format s "~&Doing ~A pending test~:P ~
+             of ~A tests total.~%"
+          (count t (cdr *entries*)
+                 :key #'pend)
+          (length (cdr *entries*)))
+  (dolist (entry (cdr *entries*))
+    (when (pend entry)
+      (format s "~@[~<~%~:; ~:@(~S~)~>~]"
+              (do-entry entry s))))
+  (let ((pending (pending-tests))
+        (expected-table (make-hash-table :test #'equal)))
+    (dolist (ex *expected-failures*)
+      (setf (gethash ex expected-table) t))
+    (let ((new-failures
+           (loop for pend in pending
+                 unless (gethash pend expected-table)
+                 collect pend)))
+      (if (null pending)
+          (format s "~&No tests failed.")
+        (progn
+          (format s "~&~A out of ~A ~
+                   total tests failed: ~
+                   ~:@(~{~<~%   ~1:;~S~>~
+                         ~^, ~}~)."
+                  (length pending)
+                  (length (cdr *entries*))
+                  pending)
+          (if (null new-failures)
+              (format s "~&No unexpected failures.")
+            (when *expected-failures*
+              (format s "~&~A unexpected failures: ~
+                   ~:@(~{~<~%   ~1:;~S~>~
+                         ~^, ~}~)."
+                    (length new-failures)
+                    new-failures)))
+          ))
+      (null pending))))
diff --git a/third_party/lisp/mime4cl/test/samples/sample1.msg b/third_party/lisp/mime4cl/test/samples/sample1.msg
new file mode 100644
index 000000000000..662a9fab341e
--- /dev/null
+++ b/third_party/lisp/mime4cl/test/samples/sample1.msg
@@ -0,0 +1,86 @@
+From wcp@scylla.home.lan Fri Feb 17 11:02:28 2012
+Status: RO
+X-VM-v5-Data: ([nil nil nil nil nil nil nil nil nil]
+	["1133" "Friday" "17" "February" "2012" "11:02:27" "+0100" "Walter C. Pelissero" "walter@pelissero.de" nil "56" "test" "^From:" nil nil "2" nil nil nil nil nil nil nil nil nil nil]
+	nil)
+X-Clpmr-Processed: 2012-02-17T11:02:31
+X-Clpmr-Version: 2011-10-23T12:55:20, SBCL 1.0.49
+Received: from scylla.home.lan (localhost [127.0.0.1])
+	by scylla.home.lan (8.14.5/8.14.5) with ESMTP id q1HA2Sik004513
+	for <wcp@scylla.home.lan>; Fri, 17 Feb 2012 11:02:28 +0100 (CET)
+	(envelope-from wcp@scylla.home.lan)
+Received: (from wcp@localhost)
+	by scylla.home.lan (8.14.5/8.14.5/Submit) id q1HA2SqU004512;
+	Fri, 17 Feb 2012 11:02:28 +0100 (CET)
+	(envelope-from wcp)
+Message-ID: <20286.9651.890757.323027@scylla.home.lan>
+X-Mailer: VM 8.1.1 under 23.3.1 (amd64-portbld-freebsd8.2)
+Reply-To: walter@pelissero.de
+X-Attribution: WP
+X-For-Spammers: blacklistme@pelissero.de
+X-MArch-Processing-Time: 0.552s
+MIME-Version: 1.0
+Content-Type: multipart/mixed; boundary="615CiWUaGO"
+Content-Transfer-Encoding: 7BIT
+From: walter@pelissero.de (Walter C. Pelissero)
+To: wcp@scylla.home.lan
+Subject: test
+Date: Fri, 17 Feb 2012 11:02:27 +0100
+
+
+--615CiWUaGO
+Content-Type: text/plain; charset="us-ascii"
+Content-Transfer-Encoding: 7BIT
+Content-Description: message body text
+
+Hereafter three attachments.
+
+The first:
+
+--615CiWUaGO
+Content-Type: application/octet-stream; name="attach1"
+Content-Transfer-Encoding: BASE64
+Content-Disposition: attachment; filename="attach1"
+
+YXR0YWNoMQo=

+
+--615CiWUaGO
+Content-Type: text/plain; charset="us-ascii"
+Content-Transfer-Encoding: 7BIT
+Content-Description: message body text
+
+
+The second:
+
+--615CiWUaGO
+Content-Type: application/octet-stream; name="attach2"
+Content-Transfer-Encoding: BASE64
+Content-Disposition: attachment; filename="attach2"
+
+YXR0YWNoMgo=

+
+--615CiWUaGO
+Content-Type: text/plain; charset="us-ascii"
+Content-Transfer-Encoding: 7BIT
+Content-Description: message body text
+
+
+The third:
+
+--615CiWUaGO
+Content-Type: application/octet-stream; name="attach3"
+Content-Transfer-Encoding: BASE64
+Content-Disposition: attachment; filename="attach3"
+
+YXR0YWNoMwo=

+
+--615CiWUaGO
+Content-Type: text/plain; charset="us-ascii"
+Content-Transfer-Encoding: 7BIT
+Content-Description: .signature
+
+
+-- 
+http://pelissero.de
+--615CiWUaGO--
+
diff --git a/third_party/lisp/mime4cl/test/temp-file.lisp b/third_party/lisp/mime4cl/test/temp-file.lisp
new file mode 100644
index 000000000000..554f35844b46
--- /dev/null
+++ b/third_party/lisp/mime4cl/test/temp-file.lisp
@@ -0,0 +1,72 @@
+;;; temp-file.lisp --- temporary file creation
+
+;;;  Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 by Walter C. Pelissero
+;;;  Copyright (C) 2022 The TVL Authors
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+;;;
+;;;  Code taken from SCLF
+
+#+cmu (ext:file-comment "$Module: temp-file.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl-tests)
+
+(defvar *tmp-file-defaults* #P"/tmp/")
+
+(defun temp-file-name (&optional (default *tmp-file-defaults*))
+  "Create a random pathname based on DEFAULT.  No effort is made
+to make sure that the returned pathname doesn't identify an
+already existing file.  If missing DEFAULT defaults to
+*TMP-FILE-DEFAULTS*."
+  (make-pathname :defaults default
+                 :name (format nil "~36R" (random #.(expt 36 10)))))
+
+(defun open-temp-file (&optional default-pathname &rest open-args)
+  "Open a new temporary file and return a stream to it.  This function
+makes sure the pathname of the temporary file is unique.  OPEN-ARGS
+are arguments passed verbatim to OPEN.  If OPEN-ARGS specify
+the :DIRECTION it should be either :OUTPUT (default) or :IO;
+any other value causes an error.  If DEFAULT-PATHNAME is specified and
+not NIL it's used as defaults to produce the pathname of the temporary
+file, otherwise *TMP-FILE-DEFAULTS* is used."
+  (unless default-pathname
+    (setf default-pathname *tmp-file-defaults*))
+  ;; if :DIRECTION is specified check that it's compatible with the
+  ;; purpose of this function, otherwise make it default to :OUTPUT
+  (aif (getf open-args :direction)
+       (unless (member it '(:output :io))
+         (error "Can't create temporary file with open direction ~A." it))
+       (setf open-args (append '(:direction :output)
+                               open-args)))
+  (do* ((name #1=(temp-file-name default-pathname) #1#)
+        (stream #2=(apply #'open  name
+                          :if-exists nil
+                          :if-does-not-exist :create
+                          open-args) #2#))
+       (stream stream)))
+
+(defmacro with-temp-file ((stream &rest open-temp-args) &body body)
+  "Execute BODY within a dynamic extent where STREAM is bound to
+a STREAM open on a unique temporary file name.  OPEN-TEMP-ARGS are
+passed verbatim to OPEN-TEMP-FILE."
+  `(let ((,stream (open-temp-file ,@open-temp-args)))
+     (unwind-protect
+          (progn ,@body)
+       (close ,stream)
+       ;; body may decide to rename the file so we must ignore the errors
+       (ignore-errors
+         (delete-file (pathname ,stream))))))
diff --git a/third_party/lisp/moptilities.nix b/third_party/lisp/moptilities.nix
new file mode 100644
index 000000000000..d38fbcb9469a
--- /dev/null
+++ b/third_party/lisp/moptilities.nix
@@ -0,0 +1,13 @@
+# Compatibility layer for minor MOP implementation differences
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.moptilities;
+in depot.nix.buildLisp.library {
+  name = "moptilities";
+  deps = [ depot.third_party.lisp.closer-mop ];
+  srcs = [ "${src}/dev/moptilities.lisp" ];
+
+  brokenOn = [
+    "ecl" # TODO(sterni): https://gitlab.com/embeddable-common-lisp/ecl/-/issues/651
+  ];
+}
diff --git a/third_party/lisp/nibbles.nix b/third_party/lisp/nibbles.nix
new file mode 100644
index 000000000000..b71f439c939a
--- /dev/null
+++ b/third_party/lisp/nibbles.nix
@@ -0,0 +1,26 @@
+{ depot, pkgs, ... }:
+
+let
+  inherit (depot.nix.buildLisp) bundled;
+  src = with pkgs; srcOnly lispPackages.nibbles;
+in
+depot.nix.buildLisp.library {
+  name = "nibbles";
+
+  deps = with depot.third_party.lisp; [
+    (bundled "asdf")
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "types.lisp"
+    "macro-utils.lisp"
+    "vectors.lisp"
+    "streams.lisp"
+  ] ++ [
+    { sbcl = "${src}/sbcl-opt/fndb.lisp"; }
+    { sbcl = "${src}/sbcl-opt/nib-tran.lisp"; }
+    { sbcl = "${src}/sbcl-opt/x86-vm.lisp"; }
+    { sbcl = "${src}/sbcl-opt/x86-64-vm.lisp"; }
+  ];
+}
diff --git a/third_party/lisp/npg/.project b/third_party/lisp/npg/.project
new file mode 100644
index 000000000000..82a8fe48bbfb
--- /dev/null
+++ b/third_party/lisp/npg/.project
@@ -0,0 +1 @@
+NPG a Naive Parser Generator
diff --git a/third_party/lisp/npg/.skip-subtree b/third_party/lisp/npg/.skip-subtree
new file mode 100644
index 000000000000..5051f60d6b86
--- /dev/null
+++ b/third_party/lisp/npg/.skip-subtree
@@ -0,0 +1 @@
+prevent readTree from creating entries for subdirs that don't contain an .nix files
diff --git a/third_party/lisp/npg/COPYING b/third_party/lisp/npg/COPYING
new file mode 100644
index 000000000000..223ede7de3ec
--- /dev/null
+++ b/third_party/lisp/npg/COPYING
@@ -0,0 +1,504 @@
+		  GNU LESSER GENERAL PUBLIC LICENSE
+		       Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL.  It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it.  You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations below.
+
+  When we speak of free software, we are referring to freedom of use,
+not price.  Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+  To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights.  These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  To protect each distributor, we want to make it very clear that
+there is no warranty for the free library.  Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+
+  Finally, software patents pose a constant threat to the existence of
+any free program.  We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder.  Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+  Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License.  This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License.  We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+  When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library.  The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom.  The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+  We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License.  It also provides other free software developers Less
+of an advantage over competing non-free programs.  These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries.  However, the Lesser license provides advantages in certain
+special circumstances.
+
+  For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it becomes
+a de-facto standard.  To achieve this, non-free programs must be
+allowed to use the library.  A more frequent case is that a free
+library does the same job as widely used non-free libraries.  In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+  In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software.  For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+  Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+
+		  GNU LESSER GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+  
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+  6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Use a suitable shared library mechanism for linking with the
+    Library.  A suitable mechanism is one that (1) uses at run time a
+    copy of the library already present on the user's computer system,
+    rather than copying library functions into the executable, and (2)
+    will operate properly with a modified version of the library, if
+    the user installs one, as long as the modified version is
+    interface-compatible with the version that the work was made with.
+
+    c) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    d) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    e) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded.  In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+			    NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+           How to Apply These Terms to Your New Libraries
+
+  If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change.  You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+  To apply these terms, attach the following notices to the library.  It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the library's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
+That's all there is to it!
+
+
diff --git a/third_party/lisp/npg/OWNERS b/third_party/lisp/npg/OWNERS
new file mode 100644
index 000000000000..2e9580706346
--- /dev/null
+++ b/third_party/lisp/npg/OWNERS
@@ -0,0 +1 @@
+sterni
diff --git a/third_party/lisp/npg/README b/third_party/lisp/npg/README
new file mode 100644
index 000000000000..a1661e744a37
--- /dev/null
+++ b/third_party/lisp/npg/README
@@ -0,0 +1,48 @@
+
+		     NPG a Naive Parser Generator
+			   for Common Lisp
+
+	 Copyright (C) 2003-2006, 2010 by Walter C. Pelissero
+	 Copyright (C) 2021 by the TVL Authors
+
+Vendored into depot as it is a dependency of mime4cl and upstream has
+become inactive. Upstream and depot version may diverge.
+
+Upstream Website: http://wcp.sdf-eu.org/software/#npg
+Vendored Tarball: http://wcp.sdf-eu.org/software/npg-20150517T144652.tbz
+
+This library is  free software; you can redistribute  it and/or modify
+it  under  the terms  of  the GNU  Lesser  General  Public License  as
+published by the  Free Software Foundation; either version  2.1 of the
+License,  or (at  your option)  any  later version.   This library  is
+distributed  in the  hope  that it  will  be useful,  but WITHOUT  ANY
+WARRANTY;  without even  the  implied warranty  of MERCHANTABILITY  or
+FITNESS FOR A  PARTICULAR PURPOSE.  See the GNU  Lesser General Public
+License for more details.  You should  have received a copy of the GNU
+Lesser General Public  License along with this library;  if not, write
+to the  Free Software  Foundation, Inc., 59  Temple Place,  Suite 330,
+Boston, MA 02111-1307 USA
+
+
+This library generates on the fly (no external representation of the
+parser is produced) a recursive descent parser based on the grammar
+rules you have fed it with.  The parser object can then be used to
+scan tokenised input.  Although a facility to produce a lexical
+analiser is not provided, to write such a library is fairly easy for
+most languages.  NPG parsers require your lexer to adhere to a certain
+protocol to be able to communicate with them.  Examples are provided
+that explain these requirements.
+
+While quite possibly not producing the fastest parsers in town, it's
+fairly simple and hopefully easy to debug.  It accepts a lispy EBNF
+grammar description of arbitrary complexity with the exception of
+mutually left recursive rules (watch out, they produce undetected
+infinite recursion) and produces a backtracking recursive descent
+parser.  Immediate left recursive rules are properly simplified,
+though.
+
+Multiple concurrent parsers are supported.
+
+To compile, an ASDF and nix file are provided.
+
+See the examples directory for clues on how to use it.
diff --git a/third_party/lisp/npg/default.nix b/third_party/lisp/npg/default.nix
new file mode 100644
index 000000000000..af7ec53eaf93
--- /dev/null
+++ b/third_party/lisp/npg/default.nix
@@ -0,0 +1,14 @@
+# Copyright (C) 2021 by the TVL Authors
+# SPDX-License-Identifier: LGPL-2.1-or-later
+{ depot, pkgs, ... }:
+
+depot.nix.buildLisp.library {
+  name = "npg";
+
+  srcs = [
+    ./src/package.lisp
+    ./src/common.lisp
+    ./src/define.lisp
+    ./src/parser.lisp
+  ];
+}
diff --git a/third_party/lisp/npg/examples/python.lisp b/third_party/lisp/npg/examples/python.lisp
new file mode 100644
index 000000000000..a45ac614f716
--- /dev/null
+++ b/third_party/lisp/npg/examples/python.lisp
@@ -0,0 +1,336 @@
+;;;  python.lisp --- sample grammar definition for the Python language
+
+;;;  Copyright (C) 2003 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: NPG a Naive Parser Generator
+;;;  $Id: F-C1A8CD5961889C584B22F05E8B956006.lisp,v 1.3 2004/03/09 10:33:06 wcp Exp $
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+;;;  Commentary:
+;;;
+;;; This is far from being a complete Python grammar.  Actually I
+;;; haven't even read a Python book before starting to write this
+;;; stuff, so the code below comes mostly from wild guessing while
+;;; reading a Python source file.
+;;;
+;;; It's a design decision to avoid writing any transformation in this
+;;; module; only tagging is done at this level.  This improves the
+;;; separation between parsing and transformation, making the grammar
+;;; reusable for other purposes.
+
+
+#+cmu (ext:file-comment "$Id: F-C1A8CD5961889C584B22F05E8B956006.lisp,v 1.3 2004/03/09 10:33:06 wcp Exp $")
+
+(in-package :grammar)
+
+(deflazy define-grammar
+  (let ((*package* #.*package*)
+        (*compile-print* (and parser::*debug* t)))
+    (reset-grammar)
+    (format t "~&creating Python grammar...~%")
+    (populate-grammar)
+    (let ((grammar (parser:generate-grammar)))
+      (reset-grammar)
+      (parser:print-grammar-figures grammar)
+      grammar)))
+
+(defun populate-grammar ()
+
+(defrule program
+    := comment-string? statement+)
+
+(defrule comment-string
+    := string eol
+    :reduce string)
+
+;;; BOB = Beginning Of Block, EOB = End Of Block.  It's lexical
+;;; analyzer's task to find out where a statement or block starts/ends.
+
+(defrule suite
+    := statement-list eol
+    :reduce statement-list
+    := statement-block)
+
+(defrule commentable-suite
+    := statement-list eol
+    :reduce statement-list
+    := commented-statement-block)
+
+(defrule statement-block
+    := bob statement+ eob
+    :reduce $2)
+
+(defrule commented-statement-block
+    := bob comment-string? statement* eob
+    :reduce (cons comment-string statement))
+
+(defrule statement-list
+    := (+ simple-statement ";")
+    :reduce (if (cdr $1)
+                (cons :statement-list $1)
+                (car $1)))
+
+(defrule statement
+    := statement-list eol
+    :reduce statement-list
+    := compound-statement)
+
+(defrule simple-statement
+    := import-statement
+    := raise-statement
+    := assignment
+    := function-call
+    := return-statement
+    := assert-statement
+    := pass-statement
+    := break-statement
+    := continue-statement)
+
+(defrule compound-statement
+    := class-definition
+    := method-definition
+    := try-statement
+    := if-statement
+    := while-statement
+    := for-statement)
+
+(defrule import-statement
+    := "import" (+ package-name ",")
+    :tag :import
+    := "from" package-name "import" (+ symbol-name ",")
+    :tag :import-from)
+
+(defrule package-name := identifier)
+
+(defrule symbol-name
+    := identifier
+    := "*")
+
+(defrule try-statement
+    := "try" ":" suite try-except-part* try-finally-part?
+    :tag :try)
+
+(defrule try-except-part
+    := "except" exception-subject? ":" suite)
+
+(defrule try-finally-part
+    := "finally" ":" suite)
+
+(defrule exception-subject
+    := exception-name exception-variable?)
+
+(defrule exception-variable
+    := "," identifier)
+
+(defrule exception-name := class-name)
+
+(defrule class-name := identifier)
+
+(defrule raise-statement
+    := "raise"
+    :tag :raise-same
+    := "raise" exception-name
+    :tag :raise
+    := "raise" exception-name "," expression
+    :tag :raise
+    := "raise" exception-name "(" expression ")"
+    :tag :raise)
+
+(defrule assignment
+    := (+ variable-with-optional-subscript ",") "=" more-assignment
+    :tag :set)
+
+(defrule more-assignment
+    := expression
+    := assignment)
+
+(defrule variable-with-optional-subscript
+    := variable-name subscript
+    :tag :subscript
+    := variable-name)
+
+(defrule variable-name
+    := (+ identifier ".")
+    :tag :varef)
+
+(defrule expression
+    := expression "or" expression1
+    :tag :or
+    := expression1)
+
+(defrule expression1
+    := expression1 "and" expression2
+    :tag :and
+    := expression2)
+
+(defrule expression2
+    := expression2 "==" expression3
+    :tag :equal
+    := expression2 ">=" expression3
+    :tag :more-equal
+    := expression2 "<=" expression3
+    :tag :less-equal
+    := expression2 "!=" expression3
+    :tag :not-equal
+    := expression2 ">" expression3
+    :tag :more
+    := expression2 "<" expression3
+    :tag :less
+    := expression2 "is" expression3
+    :tag :equal
+    := expression2 "is" "not" expression3
+    :tag :not-equal
+    := expression3)
+
+(defrule expression3
+    := expression3 "+" expression4
+    :tag :plus
+    := expression3 "-" expression4
+    :tag :minus
+    := expression3 "|" expression4
+    :tag :bit-or
+    := expression4)
+
+;; high priority expression
+(defrule expression4
+    := expression4 "*" expression5
+    :tag :mult
+    := expression4 "/" expression5
+    :tag :div
+    := expression4 "%" expression5
+    :tag :modulo
+    := expression4 "&" expression5
+    :tag :bit-and
+    := expression4 "in" expression5
+    :tag :in
+    := expression5)
+
+(defrule expression5
+    := "~" expression5
+    :tag :bit-not
+    := "not" expression5
+    :tag :not
+    := "(" expression ")"
+    := expression6)
+
+(defrule expression6
+    := simple-expression subscript
+    :tag :subscript
+    := simple-expression)
+
+(defrule simple-expression
+    := function-call
+    := variable-name
+    := constant
+    := string-conversion
+    := list-constructor)
+
+(defrule subscript
+    := "[" expression "]"
+    := "[" expression ":" expression "]"
+    := "[" expression ":" "]"
+    :reduce (list expression nil)
+    := "[" ":" expression "]"
+    :reduce (list nil expression))
+
+(defrule string-conversion
+    := "`" expression "`"
+    :tag :to-string)
+
+(defrule constant
+    := number
+    := string
+    := lambda-expression)
+
+(defrule number
+    := float
+    := integer)
+
+(defrule list-constructor
+    := "[" (* expression ",") "]"
+    :tag :make-list)
+
+(defrule class-definition
+    := "class" class-name superclasses? ":" commentable-suite
+    :tag :defclass)
+
+(defrule superclasses
+    := "(" class-name+ ")")
+
+(defrule method-definition
+    := "def" method-name "(" method-arguments ")" ":" commentable-suite
+    :tag :defmethod)
+
+(defrule method-arguments
+    := (* method-argument ","))
+
+(defrule method-argument
+    := identifier argument-default?)
+
+(defrule argument-default
+    := "=" expression)
+
+(defrule method-name := identifier)
+
+(defrule if-statement
+    := "if" expression ":" suite elif-part* else-part?
+    :tag :if)
+
+(defrule else-part
+    :=  "else" ":" suite)
+
+(defrule elif-part
+    := "elif" expression ":" suite)
+
+(defrule lambda-expression
+    := "lambda" method-arguments ":" expression
+    :tag :lambda)
+
+(defrule function-call
+    := (+ identifier ".") "(" (* expression ",") ")"
+    :tag :funcall)
+
+(defrule for-statement
+    := "for" identifier "in" expression ":" suite
+    :tag :do-list
+    := "for" identifier "in" "range" "(" expression "," expression ")" ":" suite
+    :tag :do-range)
+
+(defrule while-statement
+    := "while" expression ":" suite
+    :tag :while)
+
+(defrule return-statement
+    := "return" expression?
+    :tag :return)
+
+(defrule assert-statement
+    := "assert" expression "," string
+    :tag :assert)
+
+(defrule pass-statement
+    := "pass"
+    :tag :pass)
+
+(defrule break-statement
+    := "break"
+    :tag :break)
+
+(defrule continue-statement
+    := "continue"
+    :tag :continue)
+
+)					; end of POPULATE-GRAMMAR
diff --git a/third_party/lisp/npg/examples/vs-cobol-ii.lisp b/third_party/lisp/npg/examples/vs-cobol-ii.lisp
new file mode 100644
index 000000000000..9ebd45a169ce
--- /dev/null
+++ b/third_party/lisp/npg/examples/vs-cobol-ii.lisp
@@ -0,0 +1,1901 @@
+;;;  vs-cobol-ii.lisp --- sample grammar for VS-Cobol II
+
+;;;  Copyright (C) 2003 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: NPG a Naive Parser Generator
+;;;  $Id: F-1D03709AEB30BA7644C1CFA2DF60FE8C.lisp,v 1.2 2004/03/09 10:33:07 wcp Exp $
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+;;;  Commentary:
+;;;
+;;; A fairly incomplete VS-Cobol II grammar fro NPG.  It's probably
+;;; not very accurate either.
+
+#+cmu (ext:file-comment "$Id: F-1D03709AEB30BA7644C1CFA2DF60FE8C.lisp,v 1.2 2004/03/09 10:33:07 wcp Exp $")
+
+(in-package :grammar)
+
+(defun make-keyword (string)
+  "Create a keyword from STRING."
+  (intern (string-upcase string) :keyword))
+
+(defun flatten-list (list)
+  "Remove one depth level in LIST."
+  (mapcan #'identity list))
+
+(deflazy define-grammar
+  (let ((*package* #.*package*)
+        (*compile-print* (and parser::*debug* t)))
+    (reset-grammar)
+    (format t "creating Cobol grammar...~%")
+    (populate-grammar)
+    (let ((grammar (parser:generate-grammar)))
+      (reset-grammar)
+      (parser:print-grammar-figures grammar)
+      grammar)))
+
+(defun populate-grammar ()
+;;;
+;;; Hereafter PP means Partial Program
+;;;
+
+#+nil
+(defrule pp--declarations
+    := identification-division environment-division? data-division? "PROCEDURE" "DIVISION" using-phrase? "." :rest)
+
+;;; We need to split the parsing of the declarations from the rest
+;;; because the declarations may change the lexical rules (ie decimal
+;;; point)
+
+(defrule pp--declarations
+    := identification-division environment-division? data-division-head-or-procedure-division-head :rest)
+
+(defrule data-division-head-or-procedure-division-head
+    := data-division-head
+    :reduce :data-division
+    := procedure-division-head
+    :reduce (list :procedure-division $1))
+
+(defrule pp--data-division
+    := data-division-content procedure-division-head :rest)
+
+(defrule pp--sentence
+    := sentence :rest
+    := :eof)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; The real grammar
+;;;
+
+(defrule cobol-source-program
+    := identification-division environment-division? data-division procedure-division end-program?)
+
+(defrule identification-division
+    := identification "DIVISION" "." program-id-cobol-source-program identification-division-content
+    :reduce program-id-cobol-source-program)
+
+(defrule priority-number
+    := integer)
+
+(defrule level-number
+    := integer)
+
+(defrule to-id-or-lit
+    := "TO" id-or-lit)
+
+(defrule inspect-by-argument
+    := variable-identifier
+    := string
+    := figurative-constant-simple)
+
+(defrule figurative-constant-simple
+    := "ZERO"
+    :reduce :zero
+    := "ZEROS"
+    :reduce :zero
+    := "ZEROES"
+    :reduce :zero
+    := "SPACE"
+    :reduce :space
+    := "SPACES"
+    :reduce :space
+    := "HIGH-VALUE"
+    :reduce :high
+    := "HIGH-VALUES"
+    :reduce :high
+    := "LOW-VALUE"
+    :reduce :low
+    := "LOW-VALUES"
+    :reduce :low
+    := "QUOTE"
+    :reduce :quote
+    := "QUOTES"
+    :reduce :quote
+    := "NULL"
+    :reduce :null
+    := "NULLS"
+    :reduce :null)
+
+(defrule write-exceptions
+    := at-end-of-page-statement-list? not-at-end-of-page-statement-list? invalid-key-statement-list? not-invalid-key-statement-list?)
+
+(defrule set-statement-phrase
+    := variable-identifier+ set-oper set-src)
+
+(defrule set-src
+    := variable-identifier
+    := literal
+    := "TRUE"
+    := "ON"
+    := "OFF")
+
+(defrule set-oper
+    := "TO"
+    :reduce :to
+    := "UP" "BY"
+    :reduce :up
+    := "DOWN" "BY"
+    :reduce :down)
+
+(defrule fce-phrase
+    := reserve-clause
+    := fce-organization
+    := fce-access-mode
+    := record-key-clause
+    := password-clause
+    := alternate-record-key-clause
+    := file-status-clause
+    := padding-character-clause
+    := record-delimiter-clause)
+
+(defrule fce-organization
+    := organization-is? alt-indexed-relative-sequential
+    :reduce (list :organization (make-keyword alt-indexed-relative-sequential)))
+
+(defrule fce-access-mode
+    := "ACCESS" "MODE"? "IS"? alt-sequential-random-dynamic relative-key-clause?
+    :reduce (list :access-mode (make-keyword alt-sequential-random-dynamic)))
+
+(defrule alt-indexed-relative-sequential
+    := "INDEXED"
+    := "RELATIVE"
+    := "SEQUENTIAL")
+
+(defrule is-not
+    := "IS"? "NOT"?)
+
+(defrule all-procedures
+    := "ALL" "PROCEDURES")
+
+(defrule next-sentence
+    := "NEXT" "SENTENCE")
+
+(defrule no-rewind
+    := "NO" "REWIND")
+
+(defrule for-removal
+    := "FOR"? "REMOVAL")
+
+(defrule values
+    := "VALUE"
+    := "VALUES")
+
+(defrule records
+    := "RECORD"
+    := "RECORDS")
+
+(defrule end-program
+    := "END" "PROGRAM" program-name ".")
+
+(defrule environment-division
+    := "ENVIRONMENT" "DIVISION" "." environment-division-content)
+
+(defrule data-division-head
+    := "DATA" "DIVISION" ".")
+
+(defrule data-division
+    := data-division-head data-division-content
+    :reduce data-division-content)
+
+(defrule identification
+    := "IDENTIFICATION"
+    := "ID")
+
+(defrule identification-division-content
+    := identification-division-phrase*)
+
+(defrule author
+    := "AUTHOR" ".")
+
+(defrule installation
+    := "INSTALLATION" ".")
+
+(defrule date-written
+    := "DATE-WRITTEN" ".")
+
+(defrule date-compiled
+    := "DATE-COMPILED" ".")
+
+(defrule security
+    := "SECURITY" ".")
+
+(defrule remarks
+    := "REMARKS" ".")
+
+(defrule identification-division-phrase
+    := author
+    := installation
+    := date-written
+    := date-compiled
+    := security
+    := remarks)
+
+(defrule program-id-cobol-source-program
+    := "PROGRAM-ID" "."? program-name initial-program? "."
+    :reduce program-name)
+
+(defrule initial-program
+    := "IS"? "INITIAL" "PROGRAM"?)
+
+(defrule environment-division-content
+    := configuration-section? input-output-section?)
+
+(defrule input-output-section
+    := "INPUT-OUTPUT" "SECTION" "." file-control-paragraph? i-o-control-paragraph?
+    :reduce file-control-paragraph)
+
+(defrule file-control-paragraph
+    := "FILE-CONTROL" "." file-control-entry*)
+
+(defrule file-control-entry
+    := select-clause assign-clause fce-phrase* "."
+    :reduce (append select-clause
+                    assign-clause
+                    (flatten-list fce-phrase)))
+
+(defrule organization-is
+    := "ORGANIZATION" "IS"?)
+
+(defrule alt-sequential-random-dynamic
+    := "SEQUENTIAL"
+    := "RANDOM"
+    := "DYNAMIC")
+
+(defrule select-clause
+    := "SELECT" "OPTIONAL"? file-name
+    :reduce (list file-name :optional (and $2 t)))
+
+(defrule assign-clause
+    := "ASSIGN" "TO"? alt-assignment-name-literal+
+    :reduce (list :assign alt-assignment-name-literal))
+
+(defrule alt-assignment-name-literal
+    := assignment-name
+    := literal)
+
+(defrule reserve-clause
+    := "RESERVE" integer areas?)
+
+(defrule areas
+    := "AREA"
+    := "AREAS")
+
+(defrule padding-character-clause
+    := "PADDING" "CHARACTER"? "IS"? alt-qualified-data-name-literal)
+
+(defrule record-delimiter-clause
+    := "RECORD" "DELIMITER" "IS"? record-delimiter-name)
+
+(defrule record-delimiter-name
+    := "STANDARD-1"
+    := assignment-name)
+
+(defrule password-clause
+    := "PASSWORD" "IS"? data-name)
+
+(defrule file-status-clause
+    := "FILE"? "STATUS" "IS"? qualified-data-name qualified-data-name?
+    :reduce (list :file-status qualified-data-name))
+
+(defrule relative-key-clause
+    := "RELATIVE" "KEY"? "IS"? qualified-data-name
+    :reduce (list :relative-key qualified-data-name))
+
+(defrule record-key-clause
+    := "RECORD" "KEY"? "IS"? qualified-data-name
+    :reduce (list :key qualified-data-name))
+
+(defrule alternate-record-key-clause
+    := "ALTERNATE" "RECORD"? "KEY"? "IS"? qualified-data-name password-clause? with-duplicates?
+    :reduce (list :alternate-key qualified-data-name with-duplicates))
+
+(defrule with-duplicates
+    := "WITH"? "DUPLICATES")
+
+(defrule i-o-control-paragraph
+    := "I-O-CONTROL" "." i-o-sam? i-o-sort-merge?)
+
+(defrule i-o-sam
+    := qsam-or-sam-or-vsam-i-o-control-entries+ ".")
+
+(defrule i-o-sort-merge
+    := sort-merge-i-o-control-entries ".")
+
+(defrule qsam-or-sam-or-vsam-i-o-control-entries
+    := qsam-or-sam-or-vsam-i-o-control-entries-1
+    := qsam-or-sam-or-vsam-i-o-control-entries-2
+    := qsam-or-sam-or-vsam-i-o-control-entries-3
+    := qsam-or-sam-or-vsam-i-o-control-entries-4)
+
+(defrule qsam-or-sam-or-vsam-i-o-control-entries-1
+    := "RERUN" "ON" alt-assignment-name-file-name "EVERY"? every-phrase "OF"? file-name)
+
+(defrule every-phrase-1
+    := integer "RECORDS")
+
+(defrule every-phrase-2
+    := "END" "OF"? alt-reel-unit)
+
+(defrule every-phrase
+    := every-phrase-1
+    := every-phrase-2)
+
+(defrule alt-assignment-name-file-name
+    := assignment-name
+    := file-name)
+
+(defrule qsam-or-sam-or-vsam-i-o-control-entries-2
+    := "SAME" "RECORD"? "AREA"? "FOR"? file-name file-name+)
+
+(defrule qsam-or-sam-or-vsam-i-o-control-entries-3
+    := "MULTIPLE" "FILE" "TAPE"? "CONTAINS"? file-name-position+)
+
+(defrule position
+    := "POSITION" integer)
+
+(defrule file-name-position
+    := file-name position?)
+
+(defrule qsam-or-sam-or-vsam-i-o-control-entries-4
+    := "APPLY" "WRITE-ONLY" "ON"? file-name+)
+
+(defrule sort-merge-i-o-control-entries
+    := rerun-on? same-area+)
+
+(defrule rerun-on
+    := "RERUN" "ON" assignment-name)
+
+(defrule record-sort
+    := "RECORD"
+    := "SORT"
+    := "SORT-MERGE")
+
+(defrule same-area
+    := "SAME" record-sort "AREA"? "FOR"? file-name file-name+)
+
+(defrule configuration-section
+    := "CONFIGURATION" "SECTION" "." configuration-section-paragraph*
+    :reduce (flatten-list configuration-section-paragraph))
+
+(defrule configuration-section-paragraph
+    := source-computer-paragraph
+    := object-computer-paragraph
+    := special-names-paragraph)
+
+(defrule source-computer-paragraph
+    := "SOURCE-COMPUTER" "." source-computer-name
+    :reduce (list :source-computer source-computer-name))
+
+(defrule with-debugging-mode
+    := "WITH"? "DEBUGGING" "MODE")
+
+(defrule source-computer-name
+    := computer-name with-debugging-mode? "."
+    :reduce computer-name)
+
+(defrule object-computer-paragraph
+    := "OBJECT-COMPUTER" "." object-computer-name
+    :reduce (list :object-computer object-computer-name))
+
+(defrule memory-size-type
+    := "WORDS"
+    := "CHARACTERS"
+    := "MODULES")
+
+(defrule memory-size
+    := "MEMORY" "SIZE"? integer memory-size-type)
+
+(defrule object-computer-name
+    := computer-name memory-size? object-computer-paragraph-sequence-phrase "."
+    :reduce computer-name)
+
+(defrule object-computer-paragraph-sequence-phrase
+    := program-collating-sequence? segment-limit?)
+
+(defrule program-collating-sequence
+    := "PROGRAM"? "COLLATING"? "SEQUENCE" "IS"? alphabet-name)
+
+(defrule segment-limit
+    := "SEGMENT-LIMIT" "IS"? priority-number)
+
+(defrule special-names-paragraph
+    := "SPECIAL-NAMES" "." special-names-paragraph-phrase* special-names-paragraph-clause* "."
+    :reduce (flatten-list special-names-paragraph-clause))
+
+(defrule is-mnemonic-name
+    := "IS"? mnemonic-name special-names-paragraph-status-phrase?)
+
+(defrule special-names-paragraph-phrase-tail
+    := is-mnemonic-name
+    := special-names-paragraph-status-phrase)
+
+(defrule special-names-paragraph-phrase
+    := environment-name special-names-paragraph-phrase-tail)
+
+(defrule special-names-paragraph-status-phrase
+    := special-names-paragraph-status-phrase-1
+    := special-names-paragraph-status-phrase-2)
+
+(defrule special-names-paragraph-status-phrase-1
+    := "ON" "STATUS"? "IS"? condition off-status?)
+
+(defrule off-status
+    := "OFF" "STATUS"? "IS"? condition)
+
+(defrule special-names-paragraph-status-phrase-2
+    := "OFF" "STATUS"? "IS"? condition on-status?)
+
+(defrule on-status
+    := "ON" "STATUS"? "IS"? condition)
+
+(defrule special-names-paragraph-clause
+    ;; := alphabet-clause
+    ;; := symbolic-characters-clause
+    := currency-sign-clause
+    := decimal-point-clause)
+
+(defrule alphabet-clause
+    := "ALPHABET" alphabet-name "IS"? alphabet-type)
+
+(defrule alphabet-type-also
+    := "ALSO" literal)
+
+(defrule alphabet-type-alsos
+    := alphabet-type-also+)
+
+(defrule alphabet-type-also-through
+    := through-literal
+    := alphabet-type-alsos)
+
+(defrule alphabet-type-other
+    := literal alphabet-type-also-through?)
+
+(defrule alphabet-type-others
+    := alphabet-type-other+)
+
+(defrule alphabet-type
+    := "STANDARD-1"
+    := "STANDARD-2"
+    := "NATIVE"
+    := "EBCDIC"
+    := alphabet-type-others)
+
+(defrule symbolic-characters-clause
+    := "SYMBOLIC" "CHARACTERS"? symbolic-character-mapping+ in-alphabet-name?)
+
+(defrule are
+    := "ARE"
+    := "IS")
+
+(defrule symbolic-character-mapping
+    := symbolic-character+ are? integer+)
+
+(defrule in-alphabet-name
+    := "IN" alphabet-name)
+
+(defrule currency-sign-clause
+    := "CURRENCY" "SIGN"? "IS"? literal
+    :reduce (list :currency-sign literal))
+
+(defrule decimal-point-clause
+    := "DECIMAL-POINT" "IS"? "COMMA"
+    :reduce (list :decimal-point #\,))
+
+(defrule data-division-content
+    := file-section? working-storage-section? linkage-section?)
+
+(defrule file-section-entry
+    := file-and-sort-description-entry data-description-entry+
+    :reduce (cons file-and-sort-description-entry data-description-entry))
+
+(defrule file-section-head
+    := "FILE" "SECTION" ".")
+
+(defrule file-section
+    := file-section-head file-section-entry*
+    :reduce $2)
+
+(defrule working-storage-section-head
+    := "WORKING-STORAGE" "SECTION" ".")
+
+(defrule working-storage-section
+    := working-storage-section-head data-description-entry*
+    :reduce $2)
+
+(defrule linkage-section-head
+    := "LINKAGE" "SECTION" ".")
+
+(defrule linkage-section
+    := linkage-section-head data-description-entry*
+    :reduce $2)
+
+(defrule file-and-sort-description-entry
+    := alt-fd-sd file-name file-and-sort-description-entry-clause* "."
+    :reduce (list (make-keyword alt-fd-sd) file-name file-and-sort-description-entry-clause))
+
+(defrule alt-fd-sd
+    := "FD"
+    := "SD")
+
+(defrule file-and-sort-description-entry-clause
+    := external-clause
+    := global-clause
+    := block-contains-clause
+    := record-clause
+    := label-records-clause
+    := value-of-clause
+    := data-records-clause
+    := linage-clause
+    := recording-mode-clause
+    := code-set-clause)
+
+(defrule integer-to
+    := integer "TO")
+
+(defrule block-contains-clause
+    := "BLOCK" "CONTAINS"? integer-to? integer alt-characters-records?)
+
+(defrule alt-characters-records
+    := "CHARACTERS"
+    := "RECORDS"
+    := "RECORD")
+
+(defrule record-clause
+    := "RECORD" record-clause-tail)
+
+(defrule depending-on
+    := "DEPENDING" "ON"? data-name)
+
+(defrule record-clause-tail-1
+    := "CONTAINS"? integer "CHARACTERS"?)
+
+(defrule record-clause-tail-2
+    := "CONTAINS"? integer "TO" integer "CHARACTERS"?)
+
+(defrule record-clause-tail-3
+    := record-varying-phrase depending-on?)
+
+(defrule record-clause-tail
+    := record-clause-tail-2
+    := record-clause-tail-1
+    := record-clause-tail-3)
+
+(defrule record-varying-phrase
+    := "IS"? "VARYING" "IN"? "SIZE"? from-integer? to-integer? "CHARACTERS"?)
+
+(defrule from-integer
+    := "FROM"? integer)
+
+(defrule to-integer
+    := "TO" integer)
+
+(defrule label-records-clause
+    := "LABEL" records-are label-records-clause-tail
+    :reduce (list :label-record label-records-clause-tail))
+
+(defrule data-names
+    := data-name+)
+
+(defrule label-records-clause-tail
+    := "STANDARD" :reduce :standard
+    := "OMITTED" :reduce :omitted
+    := data-names)
+
+(defrule value-of-clause
+    := "VALUE" "OF" value-of-clause-tail+)
+
+(defrule alt-qualified-data-name-literal
+    := qualified-data-name
+    := literal)
+
+(defrule value-of-clause-tail
+    := variable-identifier "IS"? alt-qualified-data-name-literal)
+
+(defrule data-records-clause
+    := "DATA" records-are data-name+)
+
+(defrule records-are
+    := records are?)
+
+(defrule linage-clause
+    := "LINAGE" "IS"? alt-data-name-integer "LINES"? linage-footing-phrase)
+
+(defrule linage-footing-phrase
+    := footing? lines-top? lines-bottom?)
+
+(defrule alt-data-name-integer
+    := data-name
+    := integer)
+
+(defrule footing
+    := "WITH"? "FOOTING" "AT"? alt-data-name-integer)
+
+(defrule lines-top
+    := "LINES"? "AT"? "TOP" alt-data-name-integer)
+
+(defrule lines-bottom
+    := "LINES"? "AT"? "BOTTOM" alt-data-name-integer)
+
+(defrule recording-mode-clause
+    := "RECORDING" "MODE"? "IS"? variable-identifier)
+
+(defrule code-set-clause
+    := "CODE-SET" "IS"? alphabet-name)
+
+(defrule data-description-entry
+    := level-number alt-data-name-filler? data-description-entry-clause* "."
+    :reduce (append (list level-number alt-data-name-filler)
+                    (flatten-list data-description-entry-clause)))
+
+(defrule alt-data-name-filler
+    := data-name
+    := "FILLER"
+    :reduce (list))
+
+(defrule data-description-entry-clause
+    := picture-clause
+    := redefines-clause
+    := blank-when-zero-clause
+    := external-clause
+    := global-clause
+    := justified-clause
+    := occurs-clause
+    := sign-clause
+    := synchronized-clause
+    := usage-clause
+    := renames-clause
+    := value-clause)
+
+(defrule value-clause
+    := "VALUE" "IS"? literal
+    :reduce (list :value literal))
+
+(defrule redefines-clause
+    := "REDEFINES" data-name
+    :reduce `(:redefines ,data-name))
+
+(defrule blank-when-zero-clause
+    := "BLANK" "WHEN"? zeroes
+    :reduce '(:blank-when-zero t))
+
+(defrule zeroes
+    := "ZERO"
+    := "ZEROS"
+    := "ZEROES")
+
+(defrule external-clause
+    := "IS"? "EXTERNAL"
+    :reduce '(:external t))
+
+(defrule global-clause
+    := "IS"? "GLOBAL"
+    :reduce '(:global t))
+
+(defrule justified-clause
+    := justified "RIGHT"?
+    :reduce `(:justified ,(if $2 :right :left)))
+
+(defrule justified
+    := "JUSTIFIED"
+    := "JUST")
+
+(defrule occurs-clause
+    := "OCCURS" integer "TIMES"? occurs-clause-key* indexed-by?
+    ;; to be completed -wcp16/7/03.
+    :reduce `(:times ,integer)
+    := "OCCURS" integer "TO" integer "TIMES"? "DEPENDING" "ON"? qualified-data-name occurs-clause-key* indexed-by?
+    ;; to be completed -wcp16/7/03.
+    :reduce `(:times (,integer ,integer2 ,qualified-data-name)))
+
+(defrule occurs-clause-key
+    := alt-ascending-descending "KEY"? "IS"? qualified-data-name+)
+
+(defrule indexed-by
+    := "INDEXED" "BY"? index-name+)
+
+(defrule picture-clause
+    := picture "IS"? picture-string
+    :reduce `(:picture ,picture-string))
+
+(defrule picture
+    := "PICTURE"
+    := "PIC")
+
+(defrule sign-clause
+    := sign-is? alt-leading-trailing separate-character?
+    :reduce `(:separate-sign ,separate-character :sign-position ,alt-leading-trailing))
+
+(defrule sign-is
+    := "SIGN" "IS"?)
+
+(defrule separate-character
+    := "SEPARATE" "CHARACTER"?
+    :reduce t)
+
+(defrule alt-leading-trailing
+    := "LEADING"
+    :reduce :leading
+    := "TRAILING"
+    :reduce :trailing)
+
+(defrule synchronized-clause
+    := synchronized alt-left-right?
+    :reduce `(:synchronized ,(if alt-left-right
+                                 alt-left-right
+                                 t)))
+
+(defrule alt-left-right
+    := "LEFT"
+    :reduce :left
+    := "RIGHT"
+    :reduce :right)
+
+(defrule synchronized
+    := "SYNCHRONIZED"
+    := "SYNC")
+
+(defrule usage-clause
+    := usage-is? usage
+    :reduce (list :encoding usage))
+
+(defrule usage-is
+    := "USAGE" "IS"?)
+
+(defrule usage
+    := "BINARY"
+    :reduce :binary
+    := "COMP"
+    :reduce :comp
+    := "COMP-1"
+    :reduce :comp1
+    := "COMP-2"
+    :reduce :comp2
+    := "COMP-3"
+    :reduce :comp3
+    := "COMP-4"
+    :reduce :comp4
+    := "COMPUTATIONAL"
+    :reduce :comp
+    := "COMPUTATIONAL-1"
+    :reduce :comp1
+    := "COMPUTATIONAL-2"
+    :reduce :comp2
+    := "COMPUTATIONAL-3"
+    :reduce :comp3
+    := "COMPUTATIONAL-4"
+    :reduce :comp4
+    := "DISPLAY"
+    :reduce :display
+    := "DISPLAY-1"
+    :reduce :display1
+    := "INDEX"
+    :reduce :index
+    := "PACKED-DECIMAL"
+    :reduce :packed-decimal
+    := "POINTER"
+    :reduce :pointer)
+
+(defrule renames-clause
+    := "RENAMES" qualified-data-name through-qualified-data-name?
+    :reduce `(:renames ,qualified-data-name ,through-qualified-data-name))
+
+(defrule through-qualified-data-name
+    := through qualified-data-name
+    :reduce qualified-data-name)
+
+(defrule condition-value-clause
+    := values-are literal-through-literal+)
+
+(defrule through-literal
+    := through literal)
+
+(defrule literal-through-literal
+    := literal through-literal?)
+
+(defrule values-are
+    := values are?)
+
+(defrule procedure-division-head
+    := "PROCEDURE" "DIVISION" using-phrase? ".")
+
+(defrule procedure-division
+    := procedure-division-head sentence+)
+
+(defrule using-phrase
+    := "USING" data-name+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defrule declaratives
+    := "DECLARATIVES" "." declaratives-content+ "END" "DECLARATIVES" ".")
+
+(defrule declaratives-content
+    := cobol-identifier "SECTION" "." use-statement "." sentence*)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defrule paragraph-header
+    := cobol-identifier "SECTION"?
+    :reduce (list (if $2 :section :label) $1))
+
+(defrule sentence
+    := declaratives
+    := statement* "."
+    :reduce $1
+    := paragraph-header "."
+    :reduce $1)
+
+(defrule statement
+    := move-statement
+    := if-statement
+    := perform-statement
+    := go-to-statement
+    := accept-statement
+    := add-statement
+    := alter-statement
+    := call-statement
+    := cancel-statement
+    := close-statement
+    := compute-statement
+    := continue-statement
+    := delete-statement
+    := display-statement
+    := divide-statement
+    := entry-statement
+    := evaluate-statement
+    := exit-program-statement
+    := exit-statement
+    := goback-statement
+    := initialize-statement
+    := inspect-statement
+    := merge-statement
+    := multiply-statement
+    := open-statement
+    := read-statement
+    := release-statement
+    := return-statement
+    := rewrite-statement
+    := search-statement
+    := set-statement
+    := sort-statement
+    := start-statement
+    := stop-statement
+    := string-statement
+    := subtract-statement
+    := unstring-statement
+    := write-statement
+    := paragraph-header)
+
+(defrule accept-statement
+    := "ACCEPT" variable-identifier "FROM" date
+    := "ACCEPT" variable-identifier "AT" screen-coordinates
+    :reduce (apply #'list 'accept-at variable-identifier screen-coordinates)
+    := "ACCEPT" variable-identifier from-environment-name?)
+
+(defrule from-environment-name
+    := "FROM" cobol-identifier)
+
+
+(defrule date
+    := "DATE"
+    := "DAY"
+    := "DAY-OF-WEEK"
+    := "TIME")
+
+(defrule add-statement
+    := "ADD" id-or-lit+ to-id-or-lit? "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-ADD"?
+    := "ADD" id-or-lit+ "TO" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-ADD"?
+    := "ADD" corresponding variable-identifier "TO" variable-identifier "ROUNDED"? on-size-error-statement-list? not-on-size-error-statement-list? "END-ADD"?)
+
+(defrule statement-list
+    := statement+)
+
+(defrule alter-statement
+    := "ALTER" procedure-to-procedure+)
+
+(defrule proceed-to
+    := "PROCEED" "TO")
+
+(defrule procedure-to-procedure
+    := procedure-name "TO" proceed-to? procedure-name)
+
+(defrule call-statement
+    := "CALL" id-or-lit using-parameters? call-rest-phrase "END-CALL"?
+    :reduce (list 'call id-or-lit (cons 'list using-parameters)))
+
+(defrule by-reference
+    := "BY"? "REFERENCE")
+
+(defrule content-parameter-value
+    := cobol-identifier
+    := literal)
+
+(defrule reference-parameter
+    := by-reference? variable-identifier)
+
+(defrule content-parameter
+    := "BY"? "CONTENT" content-parameter-value+)
+
+(defrule parameter
+    := reference-parameter
+    := content-parameter
+    := literal)
+
+(defrule using-parameters
+    := "USING" parameter+)
+
+(defrule call-rest-phrase
+    := on-exception-statement-list? not-on-exception-statement-list? on-overflow-statement-list?)
+
+(defrule on-exception-statement-list
+    := "ON"? "EXCEPTION" statement-list)
+
+(defrule not-on-exception-statement-list
+    := "NOT" "ON"? "EXCEPTION" statement-list)
+
+(defrule cancel-statement
+    := "CANCEL" id-or-lit+)
+
+(defrule close-statement
+    := "CLOSE" close-statement-file-name+
+    :reduce (list 'close close-statement-file-name))
+
+(defrule alt-removal-no-rewind
+    := for-removal
+    := with-no-rewind)
+
+(defrule alt-reel-unit
+    := "REEL"
+    := "UNIT")
+
+(defrule alt-no-rewind-lock
+    := no-rewind
+    := "LOCK")
+
+(defrule close-statement-options-1
+    := alt-reel-unit alt-removal-no-rewind?)
+
+(defrule close-statement-options-2
+    := "WITH"? alt-no-rewind-lock)
+
+(defrule close-statement-options
+    := close-statement-options-1
+    := close-statement-options-2)
+
+(defrule close-statement-file-name
+    := file-name close-statement-options?)
+
+(defrule compute-statement
+    := "COMPUTE" cobword-rounded+ equal arithmetic-expression on-size-error-statement-list? not-on-size-error-statement-list? "END-COMPUTE"?
+    :reduce (list 'compute cobword-rounded arithmetic-expression :on-size-error on-size-error-statement-list
+                  :not-on-size-error not-on-size-error-statement-list))
+
+(defrule equal
+    := "="
+    := "EQUAL")
+
+(defrule continue-statement
+    := "CONTINUE")
+
+(defrule delete-statement
+    := "DELETE" file-name "RECORD"? invalid-key-statement-list? not-invalid-key-statement-list? "END-DELETE"?
+    :reduce (list 'delete file-name :invalid invalid-key-statement-list :not-invalid not-invalid-key-statement-list))
+
+(defrule display-statement
+    := "DISPLAY" id-or-lit+ upon-environment-name? with-no-advancing?
+    :reduce (list 'display (cons 'list id-or-lit) :upon upon-environment-name :advance (not with-no-advancing))
+    := "DISPLAY" id-or-lit "AT" screen-coordinates
+    :reduce (apply #'list 'display-at id-or-lit screen-coordinates))
+
+(defrule screen-coordinates
+    := integer
+    :reduce (multiple-value-list (truncate integer 100)))
+
+(defrule upon-environment-name
+    := "UPON" cobol-identifier)
+
+(defrule with-no-advancing
+    := "WITH"? "NO" "ADVANCING")
+
+(defrule divide-statement
+    := "DIVIDE" id-or-lit "INTO" id-or-lit "GIVING" variable-identifier "ROUNDED"? "REMAINDER" variable-identifier on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?
+    := "DIVIDE" id-or-lit "BY" id-or-lit "GIVING" variable-identifier "ROUNDED"? "REMAINDER" variable-identifier on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?
+    := "DIVIDE" id-or-lit "INTO" id-or-lit "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?
+    := "DIVIDE" id-or-lit "BY" id-or-lit "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?
+    := "DIVIDE" id-or-lit "INTO" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?)
+
+(defrule entry-statement
+    := "ENTRY" literal using-phrase?)
+
+(defrule evaluate-statement
+    := "EVALUATE" evaluate-condition also-phrase* when-phrases+ when-other-phrase? "END-EVALUATE"?)
+
+(defrule evaluate-condition
+    := condition
+    := "TRUE"
+    := "FALSE")
+
+(defrule also-phrase
+    := "ALSO" evaluate-condition)
+
+(defrule when-phrase-also-phrase
+    := "ALSO" evaluate-phrase)
+
+(defrule when-phrase
+    := "WHEN" evaluate-phrase when-phrase-also-phrase*)
+
+(defrule when-phrases
+    := when-phrase+ statement-list)
+
+(defrule when-other-phrase
+    := "WHEN" "OTHER" statement-list)
+
+(defrule evaluate-phrase
+    := "ANY"
+    := condition
+    := "TRUE"
+    := "FALSE"
+    := evaluate-phrase-1)
+
+(defrule evaluate-phrase-1
+    := "NOT"? arithmetic-expression through-arithmetic-expression?)
+
+(defrule through-arithmetic-expression
+    := through arithmetic-expression)
+
+(defrule exit-statement
+    := "EXIT"
+    :reduce '(exit-paragraph))
+
+(defrule exit-program-statement
+    := "EXIT" "PROGRAM"
+    :reduce '(exit-program))
+
+(defrule goback-statement
+    := "GOBACK"
+    :reduce '(go-back))
+
+(defrule go-to-statement
+    := "GO" "TO"? procedure-name+ "DEPENDING" "ON"? variable-identifier
+    :reduce (list 'goto-depending variable-identifier procedure-name)
+    := "GO" "TO"? procedure-name
+    :reduce (list 'goto procedure-name))
+
+(defrule if-phrase
+    := "IF" condition "THEN"? alt-statement-list-next-sentence "ELSE" alt-statement-list-next-sentence
+    :reduce (list 'if condition
+                  (if (cdr alt-statement-list-next-sentence)
+                      (cons 'progn alt-statement-list-next-sentence)
+                      (car alt-statement-list-next-sentence))
+                  (if (cdr alt-statement-list-next-sentence2)
+                      (cons 'progn alt-statement-list-next-sentence2)
+                      (car alt-statement-list-next-sentence2)))
+    := "IF" condition "THEN"? alt-statement-list-next-sentence
+    :reduce (append (list 'when condition) alt-statement-list-next-sentence))
+
+(defrule if-statement
+    := if-phrase "END-IF"?
+    :reduce $1)
+
+(defrule initialize-statement
+    := "INITIALIZE" variable-identifier+ initialize-replacing-phrase?)
+
+(defrule initialize-replacing-type
+    := "ALPHABETIC"
+    := "ALPHANUMERIC"
+    := "NUMERIC"
+    := "ALPHANUMERIC-EDITED"
+    := "NUMERIC-EDITED"
+    := "DBCS"
+    := "EGCS")
+
+(defrule initialize-replacing-argument
+    := initialize-replacing-type "DATA"? "BY" id-or-lit)
+
+(defrule initialize-replacing-phrase
+    := "REPLACING" initialize-replacing-argument+)
+
+(defrule inspect-statement
+    := inspect-statement-1
+    := inspect-statement-2
+    := inspect-statement-3
+    := inspect-statement-4)
+
+(defrule inspect-statement-1
+    := "INSPECT" variable-identifier "TALLYING" tallying-argument+)
+
+(defrule inspect-statement-2
+    := "INSPECT" variable-identifier "CONVERTING" id-or-lit "TO" id-or-lit before-after-phrase*)
+
+(defrule inspect-statement-3
+    := "INSPECT" variable-identifier "TALLYING" tallying-argument+ "REPLACING" inspect-replacing-phrase+)
+
+(defrule tallying-for-id-or-lit
+    := id-or-lit before-after-phrase*)
+
+(defrule alt-all-leading
+    := "ALL"
+    := "LEADING")
+
+(defrule tallying-for-argument-1
+    := "CHARACTERS" before-after-phrase*)
+
+(defrule tallying-for-argument-2
+    := alt-all-leading tallying-for-id-or-lit+)
+
+(defrule tallying-for-argument
+    := tallying-for-argument-1
+    := tallying-for-argument-2)
+
+(defrule tallying-argument
+    := variable-identifier "FOR" tallying-for-argument+)
+
+(defrule inspect-statement-4
+    := "INSPECT" variable-identifier "REPLACING" inspect-replacing-phrase+)
+
+(defrule inspect-replacing-argument
+    := inspect-by-argument "BY" inspect-by-argument before-after-phrase*)
+
+(defrule alt-all-leading-first
+    := "ALL"
+    := "LEADING"
+    := "FIRST")
+
+(defrule inspect-replacing-phrase-1
+    := "CHARACTERS" "BY" id-or-lit before-after-phrase*)
+
+(defrule inspect-replacing-phrase-2
+    := alt-all-leading-first inspect-replacing-argument+)
+
+(defrule inspect-replacing-phrase
+    := inspect-replacing-phrase-1
+    := inspect-replacing-phrase-2)
+
+(defrule before-after-phrase
+    := alt-before-after "INITIAL"? id-or-lit)
+
+(defrule merge-statement
+    := "MERGE" file-name on-key-phrase+ collating-sequence? "USING" file-name file-name+ merge-statement-tail)
+
+(defrule on-key-phrase
+    := "ON"? alt-ascending-descending "KEY"? qualified-data-name+)
+
+(defrule merge-statement-tail
+    := output-procedure
+    := giving-file-names)
+
+(defrule move-statement
+    := "MOVE" id-or-lit "TO" variable-identifier+
+    :reduce (apply #'list 'move id-or-lit variable-identifier)
+    := "MOVE" corresponding variable-identifier "TO" variable-identifier+
+    :reduce (apply #'list 'move-corresponding variable-identifier variable-identifier2))
+
+(defrule multiply-statement
+    := "MULTIPLY" id-or-lit "BY" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-MULTIPLY"?
+    :reduce (list 'multiply id-or-lit cobword-rounded :on-size-error on-size-error-statement-list
+                  :not-on-size-error not-on-size-error-statement-list)
+    := "MULTIPLY" id-or-lit "BY" id-or-lit "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-MULTIPLY"?
+    :reduce (list 'multiply id-or-lit id-or-lit2 :giving cobword-rounded
+                  :on-size-error on-size-error-statement-list
+                  :not-on-size-error not-on-size-error-statement-list))
+
+(defrule open-statement
+    := "OPEN" open-statement-phrase+
+    :reduce (list 'open open-statement-phrase))
+
+(defrule alt-reversed-with-no-rewind
+    := "REVERSED"
+    := with-no-rewind)
+
+(defrule open-statement-input-file-name
+    := file-name alt-reversed-with-no-rewind?)
+
+(defrule with-no-rewind
+    := "WITH"? "NO" "REWIND")
+
+(defrule open-statement-output-file-name
+    := file-name with-no-rewind?)
+
+(defrule open-statement-input
+    := "INPUT" open-statement-input-file-name+)
+
+(defrule open-statement-output
+    := "OUTPUT" open-statement-output-file-name+)
+
+(defrule open-statement-i-o
+    := "I-O" file-name+)
+
+(defrule open-statement-extend
+    := "EXTEND" file-name+)
+
+(defrule open-statement-phrase
+    := open-statement-input
+    := open-statement-output
+    := open-statement-i-o
+    := open-statement-extend)
+
+(defrule perform-statement
+    := "PERFORM" procedure-name through-procedure-name? perform-until-phrase
+    :reduce `(perform-until ,procedure-name ,through-procedure-name ,perform-until-phrase)
+    := "PERFORM" procedure-name through-procedure-name? perform-varying-phrase perform-after-phrase*
+    :reduce `(perform-varying ,perform-varying-phrase ,procedure-name ,through-procedure-name ,perform-after-phrase)
+    := "PERFORM" procedure-name through-procedure-name? cobword-int "TIMES"
+    :reduce `(perform-times ,cobword-int ,procedure-name ,through-procedure-name)
+    := "PERFORM" procedure-name through-procedure-name?
+    :reduce (append (list 'perform procedure-name) through-procedure-name))
+
+(defrule perform-varying-phrase
+    := with-test? "VARYING" variable-identifier "FROM" id-or-lit "BY" id-or-lit "UNTIL" condition)
+
+(defrule perform-after-phrase
+    := "AFTER" variable-identifier "FROM" id-or-lit "BY" id-or-lit "UNTIL" condition)
+
+(defrule perform-until-phrase
+    := with-test? "UNTIL" condition)
+
+(defrule with-test
+    := "WITH"? "TEST" alt-before-after
+    :reduce alt-before-after)
+
+(defrule read-statement
+    := "READ" file-name "NEXT"? "RECORD"? into-identifier? key-is-qualified-data-name? invalid-key-statement-list? not-invalid-key-statement-list? at-end-statement-list? not-at-end-statement-list? "END-READ"?)
+
+(defrule key-is-qualified-data-name
+    := "KEY" "IS"? qualified-data-name)
+
+(defrule release-statement
+    := "RELEASE" record-name from-identifier?)
+
+(defrule return-statement
+    := "RETURN" file-name "RECORD"? into-identifier? "AT"? "END" statement-list not-at-end-statement-list? "END-RETURN"?)
+
+(defrule into-identifier
+    := "INTO" variable-identifier)
+
+(defrule not-at-end-statement-list
+    := "NOT" "AT"? "END" statement-list)
+
+(defrule rewrite-statement
+    := "REWRITE" record-name from-identifier? invalid-key-statement-list? not-invalid-key-statement-list? "END-REWRITE"?)
+
+(defrule search-statement
+    := search-statement-1
+    := search-statement-2)
+
+(defrule search-statement-1
+    := "SEARCH" cobol-identifier varying-identifier? at-end-statement-list? when-condition-stats+ "END-SEARCH"?)
+
+(defrule varying-identifier
+    := "VARYING" variable-identifier)
+
+(defrule when-condition-stats
+    := "WHEN" condition alt-statement-list-next-sentence)
+
+(defrule search-statement-2
+    := "SEARCH" "ALL" variable-identifier at-end-statement-list? "WHEN" search-statement-condition search-statement-condition-tail* alt-statement-list-next-sentence "END-SEARCH"?)
+
+(defrule at-end-statement-list
+    := "AT"? "END" statement-list)
+
+(defrule search-statement-equal-expression
+    := variable-identifier "IS"? equal-to arithmetic-expression
+    :reduce (list '= variable-identifier arithmetic-expression))
+
+(defrule search-statement-condition
+    := search-statement-equal-expression
+    := condition-name-reference)
+
+(defrule search-statement-condition-tail
+    := "AND" search-statement-condition)
+
+(defrule alt-statement-list-next-sentence
+    := statement+
+    := next-sentence
+    :reduce :next-sentence)
+
+(defrule set-statement
+    := "SET" set-statement-phrase+)
+
+(defrule sort-statement
+    := "SORT" file-name on-key-is-phrase+ with-duplicates-in-order? collating-sequence? sort-statement-in sort-statement-out)
+
+(defrule key-is
+    := "KEY" "IS"?)
+
+(defrule alt-ascending-descending
+    := "ASCENDING"
+    := "DESCENDING")
+
+(defrule on-key-is-phrase
+    := "ON"? alt-ascending-descending key-is? qualified-data-name+)
+
+(defrule with-duplicates-in-order
+    := "WITH"? "DUPLICATES" "IN"? "ORDER"?)
+
+(defrule collating-sequence
+    := "COLLATING"? "SEQUENCE" "IS"? alphabet-name)
+
+(defrule through
+    := "THROUGH"
+    := "THRU")
+
+(defrule through-procedure-name
+    := through procedure-name
+    :reduce procedure-name)
+
+(defrule using-file-names
+    := "USING" file-name+)
+
+(defrule input-procedure
+    := "INPUT" "PROCEDURE" "IS"? procedure-name through-procedure-name?)
+
+(defrule giving-file-names
+    := "GIVING" file-name+)
+
+(defrule output-procedure
+    := "OUTPUT" "PROCEDURE" "IS"? procedure-name through-procedure-name?)
+
+(defrule sort-statement-in
+    := using-file-names
+    := input-procedure)
+
+(defrule sort-statement-out
+    := giving-file-names
+    := output-procedure)
+
+(defrule start-statement
+    := "START" file-name key-is-rel-op-qualified-data-name? invalid-key-statement-list? not-invalid-key-statement-list? "END-START"?)
+
+(defrule rel-op
+    := equal-to
+    :reduce '=
+    := greater-than
+    :reduce '>
+    := greater-equal
+    :reduce '>=)
+
+(defrule key-is-rel-op-qualified-data-name
+    := "KEY" "IS"? rel-op qualified-data-name
+    :reduce (list rel-op qualified-data-name))
+
+(defrule stop-statement
+    := "STOP" alt-run-literal
+    :reduce '(stop))
+
+(defrule alt-run-literal
+    := "RUN"
+    := literal)
+
+(defrule string-statement
+    := "STRING" delimited-by-phrase+ "INTO" variable-identifier with-pointer-identifier? on-overflow-statement-list? not-on-overflow-statement-list? "END-STRING"?
+    :reduce (list 'string-concat delimited-by-phrase variable-identifier :with-pointer with-pointer-identifier :on-overflow on-overflow-statement-list :not-on-overflow not-on-overflow-statement-list))
+
+(defrule id-or-lit-size
+    := literal
+    := variable-identifier
+    := "SIZE")
+
+(defrule delimited-by-phrase
+    := id-or-lit+ "DELIMITED" "BY"? id-or-lit-size
+    :reduce (list id-or-lit id-or-lit-size))
+
+(defrule subtract-statement
+    := "SUBTRACT" id-or-lit+ "FROM" id-or-lit "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-SUBTRACT"?
+    :reduce (list 'subtract-giving id-or-lit id-or-lit2 cobword-rounded
+                  :on-size-error on-size-error-statement-list
+                  :not-on-size-error not-on-size-error-statement-list)
+    := "SUBTRACT" id-or-lit+ "FROM" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-SUBTRACT"?
+    :reduce (list 'subtract id-or-lit cobword-rounded
+                  :on-size-error on-size-error-statement-list
+                  :not-on-size-error not-on-size-error-statement-list)
+    := "SUBTRACT" corresponding variable-identifier "FROM" variable-identifier "ROUNDED"? on-size-error-statement-list? not-on-size-error-statement-list? "END-SUBTRACT"?
+    :reduce (list 'subtract-corr variable-identifier variable-identifier
+                  :rounded (and $5 t)
+                  :on-size-error on-size-error-statement-list
+                  :not-on-size-error not-on-size-error-statement-list))
+
+(defrule cobword-rounded
+    := variable-identifier "ROUNDED"?
+    :reduce (list variable-identifier (and $2 t)))
+
+(defrule on-size-error-statement-list
+    := "ON"? "SIZE" "ERROR" statement-list
+    :reduce statement-list)
+
+(defrule not-on-size-error-statement-list
+    := "NOT" "ON"? "SIZE" "ERROR" statement-list
+    :reduce statement-list)
+
+(defrule corresponding
+    := "CORRESPONDING"
+    := "CORR")
+
+(defrule unstring-statement
+    := "UNSTRING" variable-identifier delimited-by-all-phrase? "INTO" unstring-statement-dst+ with-pointer-identifier? tallying-in-identifier? on-overflow-statement-list? not-on-overflow-statement-list? "END-UNSTRING"?
+    :reduce (list 'unstring variable-identifier unstring-statement-dst
+                  :delimited-by-all delimited-by-all-phrase
+                  :with-pointer with-pointer-identifier
+                  :tallying tallying-in-identifier
+                  :on-overflow on-overflow-statement-list
+                  :not-on-overflow not-on-overflow-statement-list))
+
+(defrule id-or-lit
+    := literal
+    := variable-identifier)
+
+(defrule or-all-id-or-lit
+    := "OR" "ALL"? id-or-lit)
+
+(defrule delimited-by-all-phrase
+    := "DELIMITED" "BY"? "ALL"? id-or-lit or-all-id-or-lit*)
+
+(defrule delimiter-in-identifier
+    := "DELIMITER" "IN"? variable-identifier)
+
+(defrule count-in-identifier
+    := "COUNT" "IN"? variable-identifier)
+
+(defrule unstring-statement-dst
+    := variable-identifier delimiter-in-identifier? count-in-identifier?)
+
+(defrule with-pointer-identifier
+    := "WITH"? "POINTER" variable-identifier)
+
+(defrule tallying-in-identifier
+    := "TALLYING" "IN"? variable-identifier)
+
+(defrule on-overflow-statement-list
+    := "ON"? "OVERFLOW" statement-list)
+
+(defrule not-on-overflow-statement-list
+    := "NOT" "ON"? "OVERFLOW" statement-list)
+
+(defrule write-statement
+    := "WRITE" record-name from-identifier? advancing-phrase? write-exceptions "END-WRITE"?)
+
+(defrule lines
+    := "LINE"
+    := "LINES")
+
+(defrule cobword-int
+    := cobol-identifier
+    := integer)
+
+(defrule nr-lines-phrase
+    := cobword-int lines?)
+
+(defrule page-phrase
+    := nr-lines-phrase
+    := "PAGE")
+
+(defrule alt-before-after
+    := "BEFORE"
+    := "AFTER")
+
+(defrule advancing-phrase
+    := alt-before-after "ADVANCING"? page-phrase)
+
+(defrule from-identifier
+    := "FROM" variable-identifier)
+
+(defrule invalid-key-statement-list
+    := "INVALID" "KEY"? statement-list
+    :reduce statement-list)
+
+(defrule not-invalid-key-statement-list
+    := "NOT" "INVALID" "KEY"? statement-list
+    :reduce statement-list)
+
+(defrule end-of-page
+    := "END-OF-PAGE"
+    := "EOP")
+
+(defrule at-end-of-page-statement-list
+    := "AT"? end-of-page statement-list
+    :reduce statement-list)
+
+(defrule not-at-end-of-page-statement-list
+    := "NOT" "AT"? end-of-page statement-list
+    :reduce statement-list)
+
+;; This is left in the grammar but is not used.  COPYs are handled by
+;; the lexical scanner.
+(defrule copy-statement
+    := "COPY" alt-text-name-literal in-library? "SUPPRESS"? copy-statement-replacing-phrase?)
+
+(defrule in
+    := "OF"
+    := "IN")
+
+(defrule alt-library-name-literal
+    := library-name
+    := literal)
+
+(defrule in-library
+    := in alt-library-name-literal)
+
+(defrule copy-statement-by-phrase
+    := copy-operand "BY" copy-operand)
+
+(defrule copy-statement-replacing-phrase
+    := "REPLACING" copy-statement-by-phrase+)
+
+(defrule alt-text-name-literal
+    := text-name
+    := literal)
+
+(defrule copy-operand
+    := cobol-identifier
+    := literal)
+
+(defrule use-statement
+    := use-statement-1
+    := use-statement-2
+    := use-statement-3)
+
+(defrule use-statement-1
+    := "USE" "GLOBAL"? "AFTER" "STANDARD"? alt-exception-error "PROCEDURE" "ON"? alt-file-names-i-o)
+
+(defrule alt-exception-error
+    := "EXCEPTION"
+    := "ERROR")
+
+(defrule use-statement-2
+    := "USE" "GLOBAL"? "AFTER" "STANDARD"? alt-beginning-ending? alt-file-reel-unit? "LABEL" "PROCEDURE" "ON"? alt-file-names-i-o)
+
+(defrule alt-beginning-ending
+    := "BEGINNING"
+    := "ENDING")
+
+(defrule alt-file-reel-unit
+    := "FILE"
+    := "REEL"
+    := "UNIT")
+
+(defrule file-names
+    := file-name+)
+
+(defrule alt-file-names-i-o
+    := file-names
+    := "INPUT"
+    := "OUTPUT"
+    := "I-O"
+    := "EXTEND")
+
+(defrule use-statement-3
+    := "USE" "FOR"? "DEBUGGING" "ON"? alt-procedures-all-procedures)
+
+(defrule procedure-names
+    := procedure-name+)
+
+(defrule alt-procedures-all-procedures
+    := procedure-names
+    := all-procedures)
+
+(defrule condition
+    := combinable-condition
+    := combinable-condition "AND" condition
+    :reduce `(and ,combinable-condition ,condition)
+    := combinable-condition "OR" condition
+    :reduce `(or ,combinable-condition ,condition)
+    := combinable-condition "AND" id-or-lit
+    :reduce `(and ,combinable-condition (,(car combinable-condition) ,(cadr combinable-condition) ,id-or-lit))
+    := combinable-condition "OR" id-or-lit
+    :reduce `(or ,combinable-condition (,(car combinable-condition) ,(cadr combinable-condition) ,id-or-lit)))
+
+(defrule combinable-condition
+    := "NOT"? simple-condition
+    :reduce (if $1
+                (list 'not simple-condition)
+                simple-condition))
+
+(defrule simple-condition
+    := class-condition
+    := relation-condition
+    := sign-condition
+    := "(" condition ")"
+    ;; not sure if it's necessary -wcp15/7/03.
+    ;; := arithmetic-expression
+    )
+
+(defrule class-condition
+    := variable-identifier "IS"? "NOT"? class-type
+    :reduce (if $3
+                (list 'not (list 'type-of variable-identifier (make-keyword class-type)))
+                (list 'type-of variable-identifier (make-keyword class-type))))
+
+(defrule class-type
+    := "NUMERIC"
+    := "ALPHABETIC"
+    := "ALPHABETIC-LOWER"
+    := "ALPHABETIC-UPPER"
+    := "DBCS")
+
+(defun unfold-subrelations (main-relation subs)
+  (destructuring-bind (main-operator main-variable other-variable) main-relation
+    (declare (ignore other-variable))
+    (labels ((unfold (subs)
+               (if (null subs)
+                   main-relation
+                   (destructuring-bind (connection operator variable) (car subs)
+                     (list connection
+                           (list (or operator main-operator) main-variable variable)
+                           (unfold (cdr subs)))))))
+      (unfold subs))))
+
+(defrule relation-condition
+    ;; This is too complex
+    ;; := arithmetic-expression relational-operator simple-condition
+    := id-or-lit relational-operator id-or-lit subordinate-relation*
+    :reduce (unfold-subrelations (list relational-operator id-or-lit id-or-lit2) subordinate-relation))
+
+(defrule or-and
+    := "OR" :reduce 'or
+    := "AND" :reduce 'and)
+
+(defrule subordinate-relation
+    := or-and relational-operator? id-or-lit
+    :reduce (list or-and relational-operator id-or-lit))
+
+(defrule relational-operator
+    := "IS"? relational-operator-type
+    :reduce relational-operator-type)
+
+(defrule less-than
+    := "LESS" "THAN"?
+    := "<")
+
+(defrule greater-equal
+    := "GREATER" "THAN"? "OR" "EQUAL" "TO"?
+    := ">="
+    := ">" "="
+    := "NOT" "<"
+    := "NOT" "LESS" "THAN"?)
+
+(defrule less-equal
+    := "LESS" "THAN"? "OR" "EQUAL" "TO"?
+    := "<="
+    := "<" "="
+    := "NOT" ">"
+    := "NOT" "GREATER" "THAN"?)
+
+(defrule greater-than
+    := "GREATER" "THAN"?
+    := ">")
+
+(defrule equal-to
+    := "EQUAL" "TO"?
+    := "=")
+
+(defrule relational-operator-type
+    := greater-equal
+    :reduce 'cob>=
+    := less-equal
+    :reduce 'cob<=
+    := greater-than
+    :reduce 'cob>
+    := less-than
+    :reduce 'cob<
+    := equal-to
+    :reduce 'cob=
+    := "NOT" equal-to
+    :reduce 'cob-not=)
+
+(defrule sign-condition
+    := arithmetic-expression "IS"? "NOT"? sign-type
+    :reduce (if $3
+                `(not (,sign-type ,arithmetic-expression))
+                `(,sign-type ,arithmetic-expression)))
+
+(defrule sign-type
+    := "POSITIVE" :reduce '>
+    := "NEGATIVE" :reduce '<
+    := "ZERO" :reduce '=
+    := "ZEROES" :reduce '=
+    := "ZEROS" :reduce '=)
+
+(defrule procedure-name
+    := paragraph-or-section-name in-section-name
+    :reduce (list paragraph-or-section-name in-section-name)
+    := paragraph-or-section-name
+    :reduce paragraph-or-section-name)
+
+(defrule in-section-name
+    := in cobol-identifier
+    :reduce cobol-identifier)
+
+(defrule variable-identifier
+    := qualified-data-name subscript-parentheses* ;; reference-modification?
+    :reduce (if subscript-parentheses
+                (list :aref qualified-data-name subscript-parentheses)
+                qualified-data-name))
+
+(defrule reference-modification
+    := "(" leftmost-character-position ":" length? ")"
+    :reduce (if length
+                (list :range leftmost-character-position length)
+                leftmost-character-position))
+
+(defrule condition-name-reference
+    := condition-name in-data-or-file-or-mnemonic-name* subscript-parentheses*)
+
+(defrule in-data-or-file-or-mnemonic-name
+    := in data-or-file-or-mnemonic-name)
+
+(defrule subscript-parentheses
+    := "(" subscript ")")
+
+(defrule subscript
+    := subscript-expression+)
+
+(defrule plus-minus-integer
+    := plus-or-minus integer)
+
+(defrule subscript-expression-ambiguous
+    := qualified-data-name plus-minus-integer?)
+
+(defrule subscript-expression
+    := literal
+    := subscript-expression-ambiguous)
+
+(defrule qualified-data-name
+    := data-name in-data-or-file-name*
+    :reduce (if in-data-or-file-name
+                (list data-name in-data-or-file-name) ; incomplete -wcp15/7/03.
+                data-name)
+    := "ADDRESS" "OF" data-name
+    :reduce (list 'address-of data-name)
+    := "LENGTH" "OF" cobol-identifier
+    :reduce (list 'length-of cobol-identifier))
+
+(defrule in-data-or-file-name
+    := in data-or-file-name)
+
+(defrule leftmost-character-position
+    := arithmetic-expression)
+
+(defrule length
+    := arithmetic-expression)
+
+(defrule arithmetic-expression
+    := times-div
+    := times-div "+" arithmetic-expression
+    :reduce `(+ ,times-div ,arithmetic-expression)
+    := times-div "-" arithmetic-expression
+    :reduce `(- ,times-div ,arithmetic-expression))
+
+(defrule times-div
+    := power
+    := power "*" times-div
+    :reduce `(* ,power ,times-div)
+    := power "/" times-div
+    :reduce `(/ ,power ,times-div))
+
+(defrule power
+    := plus-or-minus? basis
+    := plus-or-minus? basis "**" power
+    :reduce (if plus-or-minus
+                `(plus-or-minus (expt basis basis2))
+                `(expt basis basis2)))
+
+(defrule plus-or-minus
+    := "+"
+    :reduce '+
+    := "-"
+    :reduce '-)
+
+;; (defrule power-tail
+;;     := "**" basis)
+
+(defrule basis
+    := literal
+    := variable-identifier
+    := "(" arithmetic-expression ")")
+
+(defrule alphabet-name
+    := cobol-identifier)
+
+(defrule condition-name
+    := cobol-identifier)
+
+(defrule data-name
+    := cobol-identifier)
+
+(defrule cobol-identifier
+    := identifier
+    :reduce (intern (string-upcase identifier)))
+
+(defrule file-name
+    := cobol-identifier)
+
+(defrule data-or-file-name
+    := cobol-identifier)
+
+(defrule index-name
+    := cobol-identifier)
+
+(defrule mnemonic-name
+    := cobol-identifier)
+
+(defrule data-or-file-or-mnemonic-name
+    := cobol-identifier)
+
+(defrule record-name
+    := qualified-data-name)
+
+(defrule symbolic-character
+    := cobol-identifier)
+
+(defrule library-name
+    := cobol-identifier)
+
+(defrule program-name
+    := cobol-identifier
+    := string)
+
+(defrule text-name
+    := cobol-identifier)
+
+(defrule paragraph-or-section-name
+    := cobol-identifier
+    := integer)
+
+(defrule computer-name
+    := identifier)
+
+(defrule environment-name
+    := cobol-identifier)
+
+(defrule assignment-name
+    := cobol-identifier)
+
+(defrule figurative-constant
+    := figurative-constant-simple
+    := figurative-constant-all)
+
+(defrule figurative-constant-all
+    := "ALL" literal)
+
+(defrule literal
+    := string
+    := float
+    := integer
+    := figurative-constant)
+
+)					; defun populate-grammar
diff --git a/third_party/lisp/npg/npg.asd b/third_party/lisp/npg/npg.asd
new file mode 100644
index 000000000000..1e35186d6c8c
--- /dev/null
+++ b/third_party/lisp/npg/npg.asd
@@ -0,0 +1,55 @@
+;;;  npg.asd --- declaration of this system
+
+;;;  Copyright (C) 2003, 2006 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: NPG a Naive Parser Generator
+
+#+cmu (ext:file-comment "$Module: npg.asd, Time-stamp: <2006-01-03 17:20:21 wcp> $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(defpackage :npg-system
+  (:use :common-lisp :asdf))
+
+(in-package :npg-system)
+
+(defclass sample-file (doc-file) ())
+(defmethod source-file-type ((c sample-file) (s module))
+  "lisp")
+
+(defsystem npg
+  :name "NPG"
+  :author "Walter C. Pelissero <walter@pelissero.de>"
+  :maintainer "Walter C. Pelissero <walter@pelissero.de>"
+  :licence "Lesser General Public License"
+  :description "NPG a Naive Parser Generator"
+  :long-description
+  "NPG is a backtracking recursive descent parser generator for
+Common Lisp. It accepts rules in a Lispy EBNF syntax without indirect
+left recursive rules."
+  :components
+  ((:doc-file "README")
+   (:doc-file "COPYING")
+   (:doc-file ".project")
+   (:module :examples
+            :components
+            ((:sample-file "python")
+             (:sample-file "vs-cobol-ii")))
+   (:module :src
+            :components
+            ((:file "package")
+             (:file "common" :depends-on ("package"))
+             (:file "define" :depends-on ("package" "common"))
+             (:file "parser" :depends-on ("package" "common"))))))
diff --git a/third_party/lisp/npg/src/common.lisp b/third_party/lisp/npg/src/common.lisp
new file mode 100644
index 000000000000..8b64f5cc0a7b
--- /dev/null
+++ b/third_party/lisp/npg/src/common.lisp
@@ -0,0 +1,79 @@
+;;;  common.lisp --- common stuff
+
+;;;  Copyright (C) 2003-2006, 2009 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: NPG a Naive Parser Generator
+
+#+cmu (ext:file-comment "$Module: common.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :naive-parser-generator)
+
+(eval-when (:compile-toplevel :load-toplevel)
+  (defstruct grammar
+    rules
+    keywords
+    equal-p)
+
+  (defstruct rule
+    name
+    productions)
+
+  (defstruct (production (:conc-name prod-))
+    tokens
+    (tokens-length 0 :type fixnum)
+    action)
+
+  (defstruct token
+    type		     ; type of token (identifier, number, ...)
+    value				; its actual value
+    position)			     ; line/column in the input stream
+  ) ; eval-when
+
+(defmethod print-object ((obj rule) stream)
+  (format stream "#R(~A)" (rule-name obj)))
+
+(defmethod print-object ((obj production) stream)
+  (format stream "#P(action: ~S)" (prod-action obj)))
+
+(defmethod print-object ((obj token) stream)
+  (format stream "#T:~A=~S" (token-type obj) (token-value obj)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declaim (inline make-rules-table find-rule add-rule))
+
+(defun make-rules-table ()
+  (make-hash-table))
+
+(defun find-rule (rule-name rules)
+  (gethash rule-name rules))
+
+(defun add-rule (rule-name rule rules)
+  (setf (gethash rule-name rules) rule))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declaim (inline make-keywords-table find-keyword add-keyword))
+
+(defun make-keywords-table ()
+   (make-hash-table :test 'equal))
+
+(defun find-keyword (keyword-name keywords)
+  (gethash keyword-name keywords))
+
+(defun add-keyword (keyword keywords)
+  (setf (gethash keyword keywords) t))
diff --git a/third_party/lisp/npg/src/define.lisp b/third_party/lisp/npg/src/define.lisp
new file mode 100644
index 000000000000..783f071fc5d9
--- /dev/null
+++ b/third_party/lisp/npg/src/define.lisp
@@ -0,0 +1,408 @@
+;;;  define.lisp --- grammar rules definition
+
+;;;  Copyright (C) 2003-2006, 2009 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: NPG a Naive Parser Generator
+
+#+cmu (ext:file-comment "$Module: define.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :naive-parser-generator)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *smart-default-reduction* t
+  "If true the default reductions take only the non-static tokens -
+those that are not declared as strings in the grammar.")
+
+;; These two are filled with DEFRULE.
+(defvar *rules* (make-rules-table))
+(defvar *keywords* (make-keywords-table))
+
+(defun make-action-arguments (tokens)
+  "Given a list of tokens making up a production, return three values:
+the list of variables for the function reducing this production, those
+that are non static and their unambiguous user-friendly names."
+  (flet ((unique (sym list)
+           (if (not (assoc sym list))
+               sym
+               (loop
+                  for i of-type fixnum from 2
+                  for x = (intern (format nil "~:@(~A~)~A" sym i))
+                  while (assoc x list)
+                  finally (return x)))))
+    (loop
+       for tok in tokens
+       for i of-type fixnum from 1
+       for arg = (intern (format nil "$~A" i) (find-package #.*package*))
+       collect arg into args
+       unless (const-terminal-p tok)
+         collect arg into vars
+         and when (symbolp tok)
+           collect (list (unique tok named-vars) arg) into named-vars
+       when (and (listp tok)
+                 (symbolp (cadr tok)))
+         collect (list (unique (cadr tok) named-vars) arg) into named-vars
+       finally
+       (return (values args vars named-vars)))))
+
+(defun make-action-function (name tokens action)
+  "Create a function with name NAME, arguments derived from TOKENS and
+body ACTION.  Return it's definition."
+  (let ((function
+         (multiple-value-bind (args vars named-vars)
+             (make-action-arguments tokens)
+           `(lambda ,args
+              (declare (ignorable ,@args))
+              (let (($vars (list ,@vars))
+                    ($all (list ,@args))
+                    ,@named-vars
+                    ($alist (list ,@(mapcar #'(lambda (v)
+                                                `(cons ',(intern (symbol-name (car v)))
+                                                       ,(cadr v)))
+                                            named-vars))))
+                (declare (ignorable $vars $all $alist ,@(mapcar #'car named-vars)))
+                (flet ((make-object (&optional type args)
+                         (apply #'make-instance (or type ',name)
+                                (append args $alist))))
+                  ,action))))))
+    (when *compile-print*
+      (if *compile-verbose*
+          (format t "; Compiling ~S:~%  ~S~%" name function)
+          (format t "; Compiling ~S~%" name)))
+    (compile name function)))
+
+(defun define-rule (name productions)
+  "Accept a rule in EBNF-like syntax, translate it into a sexp and a
+call to INSERT-RULE-IN-CURRENT-GRAMMAR."
+  (flet ((transform (productions)
+           (loop
+              for tok in productions
+              with prod = nil
+              with action = nil
+              with phase = nil
+              with new-prods = nil
+              while tok
+              do (cond ((eq tok :=)
+                        (push (list (nreverse prod) action) new-prods)
+                        (setf prod nil
+                              action nil
+                              phase :prod))
+                       ((eq tok :reduce)
+                        (setf phase :action))
+                       ((eq tok :tag)
+                        (setf phase :tag))
+                       ((eq phase :tag)
+                        (setf action `(cons ,tok $vars)))
+                       ((eq phase :action)
+                        (setf action tok))
+                       ((eq phase :prod)
+                        (push tok prod)))
+              finally
+                (return (cdr (nreverse (cons (list (nreverse prod) action) new-prods)))))))
+    (insert-rule-in-current-grammar name (transform productions))))
+
+(defmacro defrule (name &rest productions)
+  "Wrapper macro for DEFINE-RULE."
+  `(define-rule ',name ',productions))
+
+(defun make-optional-rule (token)
+  "Make a rule for a possibly missing (non)terminal (? syntax) and
+return it."
+  (insert-rule-in-current-grammar
+   (gensym (concatenate 'string "OPT-"
+                        (if (rule-p token)
+                            (symbol-name (rule-name token))
+                            (string-upcase token))))
+   `(((,token)) (()))))
+
+(defun make-alternative-rule (tokens)
+  "Make a rule for a list of alternatives (\"or\" syntax) and return it."
+  (insert-rule-in-current-grammar
+   (gensym "ALT")
+   (mapcar #'(lambda (alternative)
+               `((,alternative)))
+           tokens)))
+
+(defun make-nonempty-list-rule (token &optional separator)
+  "Make a rule for a non-empty list (+ syntax) and return it."
+  (let ((rule-name (gensym (concatenate 'string "NELST-"
+                                        (if (rule-p token)
+                                            (symbol-name (rule-name token))
+                                            (string-upcase token))))))
+    (insert-rule-in-current-grammar
+     rule-name
+     (if separator
+         `(((,token ,separator ,rule-name)
+            (cons $1 $3))
+           ((,token) ,#'list))
+         `(((,token ,rule-name)
+            (cons $1 $2))
+           ((,token) ,#'list))))))
+
+(defun make-list-rule (token &optional separator)
+  "Make a rule for a possibly empty list (* syntax) return it."
+  (make-optional-rule (make-nonempty-list-rule token separator)))
+
+(defun const-terminal-p (object)
+  (or (stringp object)
+      (keywordp object)))
+
+(defun expand-production-token (tok)
+  "Translate token of the type NAME? or NAME* or NAME+ into (? NAME)
+or (* NAME) or (+ NAME).  This is used by the DEFRULE macro."
+  (if (symbolp tok)
+      (let* ((name (symbol-name tok))
+             (last (char name (1- (length name))))
+             ;; this looks silly but we need to make sure that we
+             ;; return symbols interned in this package, no one else
+             (op (cadr (assoc last '((#\? ?) (#\+ +) (#\* *))))))
+        (if (and (> (length name) 1) op)
+            (list op
+                  (intern (subseq name 0 (1- (length name)))))
+            tok))
+      tok))
+
+(defun EBNF-to-SEBNF (tokens)
+  "Take a production as a list of TOKENS and expand it.  This turns a
+EBNF syntax into a sexp-based EBNF syntax or SEBNF."
+  (loop
+     for tok in tokens
+     for token = (expand-production-token tok)
+     with new-tokens = '()
+     do (cond ((member token '(* + ?))
+               (setf (car new-tokens)
+                     (list token (car new-tokens))))
+              (t
+               (push token new-tokens)))
+     finally (return (nreverse new-tokens))))
+
+(defun SEBNF-to-BNF (tokens)
+  "Take a production in SEBNF (Symbolic Extended BNF) syntax and turn
+it into BNF.  The production is simplified but the current grammar is
+populated with additional rules."
+  (flet ((make-complex-token-rule (tok)
+           (ecase (car tok)
+             (* (apply #'make-list-rule (cdr tok)))
+             (+ (apply #'make-nonempty-list-rule (cdr tok)))
+             (? (make-optional-rule (cadr tok)))
+             (or (make-alternative-rule (cdr tok))))))
+    (loop
+       for token in tokens
+       with new-tokens = '()
+       with keywords = '()
+       do (cond ((listp token)
+                 (push (make-complex-token-rule token) new-tokens))
+                (t
+                 (push token new-tokens)
+                 (when (const-terminal-p token)
+                   (push token keywords))))
+       finally (return (values (nreverse new-tokens) keywords)))))
+
+(defun make-default-action-function (name tokens)
+  "Create a sexp to be used as default action in case one is not
+supplied in the production.  This is usually a quite sensible
+one.  That is, only the non-constant tokens are returned in a
+list and in case only a variable token is available that one is
+returned (not included in a list).  If all the tokens are
+constant, then all of them are returned in a list."
+  (cond ((null tokens)
+         ;; if the production matched the empty list (no tokens) we
+         ;; return always nil, that is the function LIST applied to no
+         ;; arguments
+         #'list)
+        ((null (cdr tokens))
+         ;; if the production matches just one token we simply return
+         ;; that
+         #'identity)
+        (*smart-default-reduction*
+         ;; If we are required to be "smart" then create a function
+         ;; that simply returns the non static tokens of the
+         ;; production.  If the production doesn't have nonterminal,
+         ;; then return all the tokens.  If the production has only
+         ;; one argument then return that one only.
+         (make-action-function name tokens '(cond
+                                             ((null $vars) $all)
+                                             ((null (cdr $vars)) (car $vars))
+                                             (t $vars))))
+        (t
+         ;; in all the other cases we return all the token matching
+         ;; the production
+         #'list)))
+
+(defun make-production-from-descr (name production-description)
+  "Take a production NAME and its description in the form of a sexp
+and return a production structure object together with a list of used
+keywords."
+  (destructuring-bind (tokens &optional action) production-description
+    (let ((expanded-tokens (EBNF-to-SEBNF tokens)))
+      (multiple-value-bind (production-tokens keywords)
+          (sebnf-to-bnf expanded-tokens)
+      (let ((funct
+             (cond ((not action)
+                    (make-default-action-function name expanded-tokens))
+                   ((or (listp action)
+                        ;; the case when the action is simply to
+                        ;; return a token (ie $2) or a constant value
+                        (symbolp action))
+                    (make-action-function name expanded-tokens action))
+                   ((functionp action)
+                    action)
+                   (t			; action is a constant
+                    #'(lambda (&rest args)
+                        (declare (ignore args))
+                        action)))))
+        (values
+         ;; Make a promise instead of actually resolving the
+         ;; nonterminals.  This avoids endless recursion.
+         (make-production :tokens production-tokens
+                          :tokens-length (length production-tokens)
+                          :action funct)
+         keywords))))))
+
+(defun remove-immediate-left-recursivity (rule)
+  "Turn left recursive rules of the type
+    A -> A x | y
+into
+    A -> y A2
+    A2 -> x A2 | E
+where E is the empty production."
+  (let ((name (rule-name rule))
+        (productions (rule-productions rule)))
+    (loop
+       for prod in productions
+       for tokens = (prod-tokens prod)
+       ;; when immediately left recursive
+       when (eq (car tokens) rule)
+       collect prod into left-recursive
+       else
+       collect prod into non-left-recursive
+       finally
+         ;; found any left recursive production?
+         (when left-recursive
+           (warn "rule ~S is left recursive" name)
+           (let ((new-rule (make-rule :name (gensym "REWRITE"))))
+             ;; A -> y A2
+             (setf (rule-productions rule)
+                   (mapcar #'(lambda (p)
+                               (let ((tokens (prod-tokens p))
+                                     (action (prod-action p)))
+                                 (make-production :tokens (append tokens (list new-rule))
+                                                  :tokens-length (1+ (prod-tokens-length p))
+                                                  :action #'(lambda (&rest args)
+                                                              (let ((f-A2 (car (last args)))
+                                                                    (head (butlast args)))
+                                                                (funcall f-A2 (apply action head)))))))
+                           non-left-recursive))
+             ;; A2 -> x A2 | E
+             (setf (rule-productions new-rule)
+                   (append
+                    (mapcar #'(lambda (p)
+                                (let ((tokens (prod-tokens p))
+                                      (action (prod-action p)))
+                                  (make-production :tokens (append (cdr tokens) (list new-rule))
+                                                   :tokens-length (prod-tokens-length p)
+                                                   :action #'(lambda (&rest args)
+                                                               (let ((f-A2 (car (last args)))
+                                                                     (head (butlast args)))
+                                                                 #'(lambda (x)
+                                                                     (funcall f-A2 (apply action x head))))))))
+                            left-recursive)
+                    (list
+                     (make-production :tokens nil
+                                      :tokens-length 0
+                                      :action #'(lambda () #'(lambda (arg) arg)))))))))))
+
+(defun remove-left-recursivity-from-rules (rules)
+  (loop
+     for rule being each hash-value in rules
+     do
+     ;; More to be done here.  For now only the trivial immediate left
+     ;; recursivity is removed -wcp18/11/03.
+       (remove-immediate-left-recursivity rule)))
+
+(defun resolve-all-nonterminals (rules)
+  (loop
+     for rule being each hash-value in rules
+     do (loop
+           for production in (rule-productions rule)
+           do (setf (prod-tokens production)
+                    (resolve-nonterminals (prod-tokens production) rules)))))
+
+(defun make-rule-productions (rule-name production-descriptions)
+  "Return a production object that belongs to RULE-NAME made according
+to PRODUCTION-DESCRIPTIONS.  See also MAKE-PRODUCTION-FROM-DESCR."
+  (loop
+     for descr in production-descriptions
+     for i of-type fixnum from 1 by 1
+     for prod-name = (intern (format nil "~:@(~A~)-PROD~A" rule-name i))
+     with productions = '()
+     with keywords = '()
+     do (progn
+          (multiple-value-bind (production keyws)
+              (make-production-from-descr prod-name descr)
+            (push production productions)
+            (setf keywords (append keyws keywords))))
+     finally (return
+               (values (nreverse productions) keywords))))
+
+(defun create-rule (name production-descriptions)
+  "Return a new rule object together with a list of keywords making up
+the production definitions."
+  (multiple-value-bind (productions keywords)
+      (make-rule-productions name production-descriptions)
+    (values (make-rule :name name :productions productions)
+            keywords)))
+
+(defun insert-rule-in-current-grammar (name productions)
+  "Add rule to the current grammar and its keywords to the keywords
+hash table.  You don't want to use this directly.  See DEFRULE macro
+instead."
+  (when (find-rule name *rules*)
+    (error "redefining rule ~A" name))
+  (multiple-value-bind (rule keywords)
+      (create-rule name productions)
+    (add-rule name rule *rules*)
+    (dolist (term keywords)
+      (add-keyword term *keywords*))
+    rule))
+
+(defun resolve-nonterminals (tokens rules)
+  "Given a list of production tokens, try to expand the nonterminal
+ones with their respective rule from the the RULES pool."
+  (flet ((resolve-symbol (sym)
+           (or (find-rule sym rules)
+               sym)))
+    (mapcar #'(lambda (tok)
+                (if (symbolp tok)
+                    (resolve-symbol tok)
+                    tok))
+            tokens)))
+
+(defun reset-grammar ()
+  "Empty the current grammar from any existing rule."
+  (setf *rules* (make-rules-table)
+        *keywords* (make-keywords-table)))
+
+(defun generate-grammar (&optional (equal-p #'string-equal))
+  "Return a GRAMMAR structure suitable for the PARSE function, using
+the current rules.  EQUAL-P, if present, is a function to be used to
+match the input tokens; it defaults to STRING-EQUAL."
+  (resolve-all-nonterminals *rules*)
+  (remove-left-recursivity-from-rules *rules*)
+  (make-grammar :rules *rules*
+                :keywords *keywords*
+                :equal-p equal-p))
diff --git a/third_party/lisp/npg/src/package.lisp b/third_party/lisp/npg/src/package.lisp
new file mode 100644
index 000000000000..b405f7b5f19e
--- /dev/null
+++ b/third_party/lisp/npg/src/package.lisp
@@ -0,0 +1,50 @@
+;;;  package.lisp --- backtracking parser package definition
+
+;;;  Copyright (C) 2003-2006, 2009 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: NPG a Naive Parser Generator
+
+#+cmu (ext:file-comment "$Module: package.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :cl-user)
+
+(defpackage :naive-parser-generator
+  (:nicknames :npg)
+  (:use :common-lisp)
+  (:export
+   #:parse				; The Parser
+   #:reset-grammar
+   #:generate-grammar
+   #:print-grammar-figures
+   #:grammar-keyword-p
+   #:keyword
+   #:grammar
+   #:make-token
+   #:token-value
+   #:token-type
+   #:token-position
+   #:later-position
+   #:defrule				; to define grammars
+   #:deftoken				; to define a lexer
+   #:input-cursor-mixin
+   #:copy-input-cursor-slots
+   #:dup-input-cursor
+   #:read-next-tokens
+   #:end-of-input
+   #:? #:+ #:* #:or
+   #:$vars #:$all #:$alist
+   #:$1 #:$2 #:$3 #:$4 #:$5 #:$6 #:$7 #:$8 #:$9 #:$10))
diff --git a/third_party/lisp/npg/src/parser.lisp b/third_party/lisp/npg/src/parser.lisp
new file mode 100644
index 000000000000..c15d26fe394e
--- /dev/null
+++ b/third_party/lisp/npg/src/parser.lisp
@@ -0,0 +1,234 @@
+;;;  parser.lisp --- runtime parser
+
+;;;  Copyright (C) 2003-2006, 2009 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: NPG a Naive Parser Generator
+
+#+cmu (ext:file-comment "$Module: parser.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+;;;  Commentary:
+;;;
+;;; This is the runtime part of the parser.  The code that is
+;;; responsible to execute the parser defined with the primitives
+;;; found in define.lisp.
+
+(in-package :naive-parser-generator)
+
+(defvar *debug* nil
+  "Either nil or a stream where to write the debug informations.")
+#+debug (declaim (fixnum *maximum-recursion-depth*))
+#+debug (defvar *maximum-recursion-depth* 1000
+  "Maximum depth the parser is allowed to recursively call itself.
+This is the only way for the parser to detect a loop in the grammar.
+Tune this if your grammar is unusually complex.")
+
+(declaim (inline reduce-production))
+(defun reduce-production (production arguments)
+  "Apply PRODUCTION's action on ARGUMENTS.  This has the effect of
+  \"reducing\" the production."
+  (when *debug*
+    (format *debug* "reducing ~S on ~S~%" production arguments))
+  (flet ((safe-token-value (token)
+           (if (token-p token)
+               (token-value token)
+               token)))
+    (apply (prod-action production) (mapcar #'safe-token-value arguments))))
+
+(defgeneric later-position (pos1 pos2)
+  (:documentation
+   "Compare two file postions and return true if POS1 is later than
+POS2 in the input stream."))
+
+;; This is meant to be overloaded in the lexer
+(defmethod later-position ((pos1 integer) (pos2 integer))
+  (> pos1 pos2))
+
+;; this looks silly but turns out to be useful (see below)
+(defmethod later-position (pos1 pos2)
+  (and (eq pos1 :eof) (not (eq pos2 :eof))))
+
+(defgeneric read-next-tokens (tokens-source)
+  (:documentation "Read next token from a lexical analysed stream.  The nature of
+TOKENS-SOURCE is implementation dependent and any lexical analyzer is
+supposed to specialise this method."))
+
+;; This is the actual parser.  the algorithm is pretty
+;; straightforward, the execution of the reductions a bit less.  Error
+;; recovery is rather clumsy.
+
+(defun parse (grammar start tokenizer)
+  "Match a GRAMMAR against the list of input tokens coming from TOKENIZER.
+Return the reduced values according to the nonterminal actions.  Raise
+an error on failure."
+  (declare (type grammar grammar)
+           (type symbol start))
+  (labels
+      ((match-token (expected token)
+         (when *debug*
+           (format *debug* "match-token ~S ~S -> " expected token))
+         (let ((res (cond ((symbolp expected)
+                           ;; non-costant terminal (like identifiers)
+                           (eq expected (token-type token)))
+                          ((and (stringp expected)
+                                (stringp (token-value token)))
+                           ;; string costant terminal
+                           (funcall (the function (grammar-equal-p grammar)) expected (token-value token)))
+                          ((functionp expected)
+                           ;; custom equality predicate (must be able
+                           ;; to deal with token objects)
+                           (funcall expected token))
+                          ;; all the rest
+                          (t (equal expected (token-value token))))))
+           (when *debug*
+             (format *debug* "~Amatched~%" (if res "" "not ")))
+           res))
+       (match (expected matched #+debug depth)
+         (declare (list expected matched)
+                  #+debug (fixnum depth))
+         (let ((first-expected (car expected)))
+           (cond #+debug ((> depth *maximum-recursion-depth*)
+                  (error "endless recursion on ~A ~A at ~A expecting ~S"
+                         (token-type (car matched)) (token-value (car matched))
+                         (token-position (car matched)) expected))
+                 ((eq first-expected :any)
+                  (match (cdr expected) (cdr matched) #+debug depth))
+                 ;; This is a trick to obtain partial parses.  When we
+                 ;; reach this expected token we assume we succeeded
+                 ;; the parsing and return the remaining tokens as
+                 ;; part of the match.
+                 ((eq first-expected :rest)
+                  ;; we could be at the end of input so we check this
+                  (unless (cdr matched)
+                    (setf (cdr matched) (list :rest)))
+                  (list nil nil))
+                 ((rule-p first-expected)
+                  ;; If it's a rule, then we try to match all its
+                  ;; productions.  We return the first that succeeds.
+                  (loop
+                     for production in (rule-productions first-expected)
+                     for production-tokens of-type list = (prod-tokens production)
+                     with last-error-position = nil
+                     with last-error = nil
+                     for (error-position error-descr) =
+                       (progn
+                         (when *debug*
+                           (format *debug* "trying to match ~A: ~S~%"
+                                   (rule-name first-expected) production-tokens))
+                         (match (append production-tokens (cdr expected)) matched #+debug (1+ depth)))
+                     do (cond ((not error-position)
+                               (return (let ((args-count (prod-tokens-length production)))
+                                         (setf (cdr matched)
+                                               (cons (reduce-production
+                                                      production
+                                                      (subseq (the list (cdr matched)) 0 args-count))
+                                                     (nthcdr (1+ args-count) matched)))
+                                         (list nil nil))))
+                              ((or (not last-error)
+                                   (later-position error-position last-error-position))
+                               (setf last-error-position error-position
+                                     last-error error-descr)))
+                     ;; if everything fails return the "best" error
+                     finally (return (list last-error-position
+                                           (if *debug*
+                                               #'(lambda ()
+                                                   (format nil "~A, trying to match ~A"
+                                                           (funcall (the function last-error))
+                                                           (rule-name first-expected)))
+                                               last-error)))))
+                 (t
+                  ;; if necessary load the next tokens
+                  (when (null (cdr matched))
+                    (setf (cdr matched) (read-next-tokens tokenizer)))
+                  (cond ((and (or (null expected) (eq first-expected :eof))
+                              (null (cdr matched)))
+                         ;; This point is reached only once for each complete
+                         ;; parsing.  The expected tokens and the input
+                         ;; tokens have been exhausted at the same time.
+                         ;; Hence we succeeded the parsing.
+                         (setf (cdr matched) (list :eof))
+                         (list nil nil))
+                        ((null expected)
+                         ;; Garbage at end of parsing.  This may mean that we
+                         ;; have considered a production completed too soon.
+                         (list (token-position (car matched))
+                               #'(lambda ()
+                                   "garbage at end of parsing")))
+                        ((null (cdr matched))
+                         ;; EOF error
+                         (list :eof
+                               #'(lambda ()
+                                   (format nil "end of input expecting ~S" expected))))
+                        (t ;; normal token
+                         (let ((first-token (cadr matched)))
+                           (if (match-token first-expected first-token)
+                               (match (cdr expected) (cdr matched) #+debug depth)
+                               ;; failed: we return the error
+                               (list (token-position first-token)
+                                     #'(lambda ()
+                                         (format nil "expected ~S but got ~S ~S"
+                                                 first-expected (token-type first-token)
+                                                 (token-value first-token)))))))))))))
+    (declare (inline match-token))
+    (let ((result (list :head)))
+      (destructuring-bind (error-position error)
+          (match (list (find-rule start (grammar-rules grammar))) result #+debug 0)
+        (when error-position
+          (error "~A at ~A~%" (funcall (the function error)) error-position))
+        (cadr result)))))
+
+(defgeneric terminals-in-grammar (grammar-or-hashtable)
+  (:documentation
+   "Find non constant terminal symbols in GRAMMAR."))
+
+(defmethod terminals-in-grammar ((grammar hash-table))
+  (loop
+     for rule being each hash-value of grammar
+     with terminals = '()
+     do (loop
+           for prod in (rule-productions rule)
+           do (loop
+                 for tok in (prod-tokens prod)
+                 when (symbolp tok)
+                 do (pushnew tok terminals)))
+     finally (return terminals)))
+
+(defmethod terminals-in-grammar ((grammar grammar))
+  (terminals-in-grammar (grammar-rules grammar)))
+
+(defun print-grammar-figures (grammar &optional (stream *standard-output*))
+  (format stream "rules: ~A~%constant terminals: ~A~%variable terminals: ~S~%"
+          (hash-table-count (grammar-rules grammar))
+          (hash-table-count (grammar-keywords grammar))
+          (terminals-in-grammar (grammar-rules grammar))))
+
+
+(defun grammar-keyword-p (keyword grammar)
+  "Check if KEYWORD is part of this grammar."
+  (find-keyword keyword (grammar-keywords grammar)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *grammars* (make-hash-table))
+
+(defun find-grammar (name)
+  (gethash name *grammars*))
+
+(defun delete-grammar (name)
+  (remhash name *grammars*))
+
+(defun add-grammar (name grammar)
+  (setf (gethash name *grammars*) grammar))
diff --git a/third_party/lisp/parse-float.nix b/third_party/lisp/parse-float.nix
new file mode 100644
index 000000000000..e90824108ed1
--- /dev/null
+++ b/third_party/lisp/parse-float.nix
@@ -0,0 +1,15 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.parse-float;
+in depot.nix.buildLisp.library {
+  name = "parse-float";
+
+  deps = with depot.third_party.lisp; [
+    alexandria
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "parse-float.lisp"
+  ];
+}
diff --git a/third_party/lisp/parse-number.nix b/third_party/lisp/parse-number.nix
new file mode 100644
index 000000000000..61b0b1fddbda
--- /dev/null
+++ b/third_party/lisp/parse-number.nix
@@ -0,0 +1,9 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.parse-number;
+in depot.nix.buildLisp.library {
+  name = "parse-number";
+  srcs = map (f: src + ("/" + f)) [
+    "parse-number.lisp"
+  ];
+}
diff --git a/third_party/lisp/parseq.nix b/third_party/lisp/parseq.nix
new file mode 100644
index 000000000000..23c67c2d9c30
--- /dev/null
+++ b/third_party/lisp/parseq.nix
@@ -0,0 +1,13 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.parseq;
+in depot.nix.buildLisp.library {
+  name = "parseq";
+
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "conditions.lisp"
+    "utils.lisp"
+    "defrule.lisp"
+  ];
+}
diff --git a/third_party/lisp/physical-quantities.nix b/third_party/lisp/physical-quantities.nix
new file mode 100644
index 000000000000..d594ff1a1cf7
--- /dev/null
+++ b/third_party/lisp/physical-quantities.nix
@@ -0,0 +1,24 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.physical-quantities;
+in depot.nix.buildLisp.library {
+  name = "physical-quantities";
+
+  deps = with depot.third_party.lisp; [
+    parseq
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "utils.lisp"
+    "conditions.lisp"
+    "unit-factor.lisp"
+    "unit-database.lisp"
+    "units.lisp"
+    "quantity.lisp"
+    "numeric.lisp"
+    "parse-rules.lisp"
+    "read-macro.lisp"
+    "si-units.lisp"
+  ];
+}
diff --git a/third_party/lisp/postmodern.nix b/third_party/lisp/postmodern.nix
new file mode 100644
index 000000000000..25e0625c20bc
--- /dev/null
+++ b/third_party/lisp/postmodern.nix
@@ -0,0 +1,94 @@
+{ depot, pkgs, ... }:
+
+let
+  inherit (depot.nix.buildLisp) bundled;
+  src = with pkgs; srcOnly lispPackages.postmodern;
+
+  cl-postgres = depot.nix.buildLisp.library {
+    name = "cl-postgres";
+    deps = with depot.third_party.lisp; [
+      md5
+      split-sequence
+      ironclad
+      cl-base64
+      uax-15
+      usocket
+    ];
+
+    srcs = map (f: src + ("/cl-postgres/" + f)) [
+      "package.lisp"
+      "features.lisp"
+      "config.lisp"
+      "oid.lisp"
+      "errors.lisp"
+      "data-types.lisp"
+      "sql-string.lisp"
+      "trivial-utf-8.lisp"
+      "strings-utf-8.lisp"
+      "communicate.lisp"
+      "messages.lisp"
+      "ieee-floats.lisp"
+      "interpret.lisp"
+      "saslprep.lisp"
+      "scram.lisp"
+      "protocol.lisp"
+      "public.lisp"
+      "bulk-copy.lisp"
+    ];
+  };
+
+  s-sql = depot.nix.buildLisp.library {
+    name = "s-sql";
+    deps = with depot.third_party.lisp; [
+      cl-postgres
+      alexandria
+    ];
+
+    srcs = map (f: src + ("/s-sql/" + f)) [
+      "package.lisp"
+      "config.lisp"
+      "s-sql.lisp"
+    ];
+  };
+
+  postmodern = depot.nix.buildLisp.library {
+    name = "postmodern";
+
+    deps = with depot.third_party.lisp; [
+      alexandria
+      cl-postgres
+      s-sql
+      global-vars
+      split-sequence
+      cl-unicode
+      closer-mop
+      bordeaux-threads
+    ];
+
+    srcs = [
+      "${src}/postmodern.asd"
+    ] ++ (map (f: src + ("/postmodern/" + f)) [
+      "package.lisp"
+      "config.lisp"
+      "connect.lisp"
+      "json-encoder.lisp"
+      "query.lisp"
+      "prepare.lisp"
+      "roles.lisp"
+      "util.lisp"
+      "transaction.lisp"
+      "namespace.lisp"
+      "execute-file.lisp"
+      "table.lisp"
+      "deftable.lisp"
+    ]);
+
+    brokenOn = [
+      "ecl" # TODO(sterni): https://gitlab.com/embeddable-common-lisp/ecl/-/issues/651
+    ];
+  };
+
+in
+postmodern // {
+  inherit s-sql cl-postgres;
+}
diff --git a/third_party/lisp/prove.nix b/third_party/lisp/prove.nix
new file mode 100644
index 000000000000..af481499207f
--- /dev/null
+++ b/third_party/lisp/prove.nix
@@ -0,0 +1,29 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.prove;
+in depot.nix.buildLisp.library {
+  name = "prove";
+
+  deps = [
+    depot.third_party.lisp.alexandria
+    depot.third_party.lisp.cl-ansi-text
+    depot.third_party.lisp.cl-colors
+    depot.third_party.lisp.cl-ppcre
+    (depot.nix.buildLisp.bundled "asdf")
+  ];
+
+  srcs = [
+    "${src}/src/color.lisp"
+    "${src}/src/output.lisp"
+    "${src}/src/asdf.lisp"
+    "${src}/src/report.lisp"
+    "${src}/src/reporter.lisp"
+    "${src}/src/reporter/fiveam.lisp"
+    "${src}/src/reporter/list.lisp"
+    "${src}/src/reporter/dot.lisp"
+    "${src}/src/reporter/tap.lisp"
+    "${src}/src/suite.lisp"
+    "${src}/src/test.lisp"
+    "${src}/src/prove.lisp"
+  ];
+}
diff --git a/third_party/lisp/puri.nix b/third_party/lisp/puri.nix
new file mode 100644
index 000000000000..f7146ba93f1f
--- /dev/null
+++ b/third_party/lisp/puri.nix
@@ -0,0 +1,10 @@
+# Portable URI library
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.puri;
+in depot.nix.buildLisp.library {
+  name = "puri";
+  srcs = [
+    (src + "/src.lisp")
+  ];
+}
diff --git a/third_party/lisp/qbase64/coreutils-base64.patch b/third_party/lisp/qbase64/coreutils-base64.patch
new file mode 100644
index 000000000000..5a2f2a9f0864
--- /dev/null
+++ b/third_party/lisp/qbase64/coreutils-base64.patch
@@ -0,0 +1,13 @@
+diff --git a/qbase64-test.lisp b/qbase64-test.lisp
+index 310fdf3..b92abb5 100644
+--- a/qbase64-test.lisp
++++ b/qbase64-test.lisp
+@@ -14,7 +14,7 @@
+       (with-open-temporary-file (tmp :direction :output :element-type '(unsigned-byte 8))
+         (write-sequence bytes tmp)
+         (force-output tmp)
+-        (let* ((encoded (uiop:run-program `("base64" "-b" ,(format nil "~A" linebreak) "-i" ,(namestring tmp)) :output (if (zerop linebreak) '(:string :stripped t) :string)))
++        (let* ((encoded (uiop:run-program `("base64" "-w" ,(format nil "~A" linebreak) ,(namestring tmp)) :output (if (zerop linebreak) '(:string :stripped t) :string) :error-output *error-output*))
+                (length (length encoded)))
+           (cond ((and (> length 1)
+                       (string= (subseq encoded (- length 2))
diff --git a/third_party/lisp/qbase64/default.nix b/third_party/lisp/qbase64/default.nix
new file mode 100644
index 000000000000..40a93e04f062
--- /dev/null
+++ b/third_party/lisp/qbase64/default.nix
@@ -0,0 +1,57 @@
+{ depot, pkgs, ... }:
+
+let
+  src = pkgs.applyPatches {
+    src = pkgs.fetchFromGitHub {
+      owner = "chaitanyagupta";
+      repo = "qbase64";
+      rev = "4ac193ed6b35a867ca453ed74acc128c9a077407";
+      sha256 = "06daqqfdd51wkx0pyxgz7zq4ibzsqsgn3qs04jabx67gyybgnmjm";
+    };
+
+    patches = [
+      # qbase64 expects macOS base64
+      ./coreutils-base64.patch
+    ];
+  };
+
+  getSrcs = builtins.map (p: "${src}/${p}");
+
+in
+
+depot.nix.buildLisp.library {
+  name = "qbase64";
+
+  srcs = getSrcs [
+    "package.lisp"
+    "utils.lisp"
+    "stream-utils.lisp"
+    "qbase64.lisp"
+  ];
+
+  deps = [
+    depot.third_party.lisp.trivial-gray-streams
+    depot.third_party.lisp.metabang-bind
+  ];
+
+  tests = {
+    name = "qbase64-tests";
+
+    srcs = getSrcs [
+      "qbase64-test.lisp"
+    ];
+
+    deps = [
+      {
+        sbcl = depot.nix.buildLisp.bundled "uiop";
+        default = depot.nix.buildLisp.bundled "asdf";
+      }
+      depot.third_party.lisp.fiveam
+      depot.third_party.lisp.cl-fad
+    ];
+
+    expression = ''
+      (fiveam:run! '(qbase64-test::encoder 'qbase64-test::decoder))
+    '';
+  };
+}
diff --git a/third_party/lisp/quasiquote_2/README.md b/third_party/lisp/quasiquote_2/README.md
new file mode 100644
index 000000000000..2d590a0564ae
--- /dev/null
+++ b/third_party/lisp/quasiquote_2/README.md
@@ -0,0 +1,258 @@
+quasiquote-2.0
+==============
+
+Why should it be hard to write macros that write other macros?
+Well, it shouldn't!
+
+quasiquote-2.0 defines slightly different rules for quasiquotation,
+that make writing macro-writing macros very smooth experience.
+
+NOTE: quasiquote-2.0 does horrible things to shared structure!!!
+(it does a lot of COPY-TREE's, so shared-ness is destroyed).
+So, it's indeed a tool to construct code (where it does not matter much if the
+structure is shared or not) and not the data (or, at least, not the data with shared structure)
+
+
+```lisp
+(quasiquote-2.0:enable-quasiquote-2.0)
+
+(defmacro define-my-macro (name args &body body)
+  `(defmacro ,name ,args
+     `(sample-thing-to-expand-to
+        ,,@body))) ; note the difference from usual way
+
+(define-my-macro foo (x y)
+  ,x ; now here injections of quotation constructs work
+  ,y)
+
+(define-my-macro bar (&body body)
+  ,@body) ; splicing is also easy
+```
+
+The "injections" in macros FOO and BAR work as naively expected, as if I had written
+```lisp
+(defmacro foo (x y)
+  `(sample-thing-to-expand-to ,x ,y))
+
+(defmacro bar (&body body)
+  `(sample-thing-to-expand-to ,@body))
+
+(macroexpand-1 '(foo a b))
+
+  '(SAMPLE-THING-TO-EXPAND-TO A B)
+
+(macroexpand-1 '(bar a b c))
+
+  '(SAMPLE-THING-TO-EXPAND-TO A B C)
+```
+
+
+So, how is this effect achieved?
+
+
+DIG, INJECT and SPLICE
+-------------------------
+
+The transformations of backquote occur at macroexpansion-time and not at read-time.
+It is totally possible not to use any special reader syntax, but just
+underlying macros directly!
+
+At the core is a macro DIG, which expands to the code that generates the
+expression according to the rules, which are roughly these:
+  * each DIG increases "depth" by one (hence the name)
+  * each INJECT or SPLICE decreases "depth" by one
+  * if depth is 0, evaluation is turned on
+  * if depth if not zero (even if it's negative!) evaluation is off
+  * SPLICE splices the form, similarly to ordinary `,@`, INJECT simply injects, same as `,`
+
+```lisp
+;; The example using macros, without special reader syntax
+
+(dig ; depth is 1 here
+  (a b
+     (dig ; depth is 2 here
+       ((inject c) ; this inject is not evaluated, because depth is nonzero
+        (inject (d ;depth becomes 1 here again
+                (inject e) ; and this inject is evaluated, because depth becomes zero
+                ))
+        (inject 2 f) ; this inject with level specification is evaluated, because it
+                     ; decreases depth by 2
+        ))))
+
+
+;; the same example using ENABLE-QUASIQUOTE-2.0 syntax is written as
+`(a b `(,c ,(d ,e) ,,f)) ; note double comma acts different than usually
+```
+
+
+The ENABLE-QUASIQUOTE-2.0 macro just installs reader that reads
+`FORM as (DIG FORM), ,FORM as (INJECT FORM) and ,@FORM as (SPLICE FORM).
+You can just as well type DIG's, INJECT's and SPLICE's directly, 
+(in particular, when writing utility functions that generate macro-generating code)
+or roll your own convenient reader syntax (pull requests are welcome).
+
+So, these two lines (with ENABLE-QUASIQUOTE-2.0) read the same
+```lisp
+`(a (,b `,,c) d)
+
+(dig (a ((inject b) (dig (inject 2 c))) d))
+```
+
+You may notice the (INJECT 2 ...) form appearing, which is described below.
+
+
+At "level 1", i.e. when only \` , and ,@ are used, and not, say \`\` ,, ,', ,,@ ,',@
+this behaves exactly as usual quasiquotation.
+
+
+The optional N argument
+--------------
+
+All quasiquote-2.0 operators accept optional "depth" argument,
+which goes before the form for human readability.
+
+Namely, (DIG N FORM) increases depth by N instead of one and
+(INJECT N FORM) decreases depth by N instead of one.
+
+```lisp
+(DIG 2 (INJECT 2 A))
+
+; gives the same result as
+
+(DIG (INJECT A))
+```
+
+
+In fact, with ENABLE-QUASIQUOTE-2.0, say, ,,,,,FORM (5 quotes) reads as (INJECT 5 FORM)
+and ,,,,,@FORM as (SPLICE 5 FORM)
+
+
+More examples
+-------------
+
+For fairly complicated example, which uses ,,,@ and OINJECT (see below),
+ see DEFINE-BINOP-DEFINER macro
+in CG-LLVM (https://github.com/mabragor/cg-llvm/src/basics.lisp),
+desire to write which was the initial impulse for this project.
+
+
+For macro, that is not a macro-writing macro, yet benefits from
+ability to inject using `,` and `,@`, consider JOINING-WITH-COMMA-SPACE macro
+(also from CG-LLVM)
+
+```lisp
+(defmacro joining-with-comma-space (&body body)
+  ;; joinl just joins strings in the list with specified string
+  `(joinl ", " (mapcar #'emit-text-repr
+		       (remove-if-not #'identity  `(,,@body)))))
+
+;; the macro can be then used uniformly over strings and lists of strings
+(defun foo (x y &rest z)
+  (joining-with-comma-space ,x ,y ,@z))
+
+(foo "a" "b" "c" "d")
+  ;; produces
+  "a, b, c, d"
+```
+
+
+ODIG and OINJECT and OSPLICE
+----------------------------
+
+Sometimes you don't want DIG's macroexpansion to look further into the structure of
+some INJECT or SPLICE or DIG in its subform,
+if the depth does not match. In these cases you need "opaque" versions of
+DIG, INJECT and SPLICE, named, respectively, ODIG, OINJECT and OSPLICE.
+
+```lisp
+;; here injection of B would occur
+(defun foo (b)
+  (dig (dig (inject (a (inject b))))))
+
+;; and here not, because macroexpansion does not look into OINJECT form
+(defun bar (b)
+  (dig (dig (oinject (a (inject b))))))
+
+(foo 1)
+
+  '(DIG (INJECT (A 1)))
+
+(bar 1)
+
+  '(DIG (OINJECT (A (INJECT B))))
+```
+
+MACRO-INJECT and MACRO-SPLICE
+-----------------------------
+
+Sometimes you just want to abstract-out some common injection patterns...
+That is, you want macros, that expand into common injection patterns.
+However, you want this only sometimes, and only in special circumstances.
+So it won't do, if INJECT and SPLICE just expanded something, whenever it
+turned out to be macro. For that, use MACRO-INJECT and MACRO-SPLICE.
+
+```lisp
+;; with quasiquote-2.0 syntax turned on
+(defmacro inject-n-times (form n)
+  (make-list n :initial-element `(inject ,form)))
+
+(let (x 0)
+  `(dig (a (macro-inject (inject-n-times (incf x) 3)))))
+;; yields
+'(a (1 2 3))
+
+;;and same with MACRO-SPLICE
+(let (x 0)
+  `(dig (a (macro-splice (inject-n-times (incf x) 3)))))
+;; yields
+'(a 1 2 3)
+```
+
+OMACRO-INJECT and OMACRO-SPLICE are, as usual, opaque variants of MACRO-INJECT and MACRO-SPLICE.
+
+Both MACRO-INJECT and MACRO-SPLICE expand their subform exactly once (using MACROEXPAND-1),
+before plugging it into list.
+If you want to expand as much as it's possible, use MACRO-INJECT-ALL and MACRO-SPLICE-ALL,
+which expand using MACROEXPAND before injecting/splicing, respectively.
+That implies, that while subform of MACRO-INJECT and MACRO-SPLICE is checked to be
+macro-form, the subform of MACRO-INJECT-ALL is not.
+
+
+Terse syntax of the ENABLE-QUASIQUOTE-2.0
+-----------------------------------------
+
+Of course, typing all those MACRO-INJECT-ALL, or OMACRO-SPLICE-ALL or whatever explicitly
+every time you want this special things is kind of clumsy. For that, default reader
+of quasiquote-2.0 provides extended syntax
+
+```lisp
+',,,,!oma@x
+
+;; reads as
+'(OMACRO-SPLICE-ALL 4 X)
+```
+
+That is, the regexp of the syntax is
+[,]+![o][m][a][@]<whatever>
+
+As usual, number of commas determine the anti-depth of the injector, exclamation mark
+turns on the syntax, if `o` is present, opaque version of injector will be used,
+if `m` is present, macro-expanding version of injector will be used and if
+`a` is present, macro-all version of injector will be used.
+
+Note: it's possible to write ,!ax, which will read as (INJECT-ALL X), but
+this will not correspond to the actual macro name.
+
+Note: it was necessary to introduce special escape-char for extended syntax,
+since usual idioms like `,args` would otherwise be completely screwed.
+
+
+TODO
+----
+
+* WITH-QUASIQUOTE-2.0 read-macro-token for local enabling of ` and , overloading
+* wrappers for convenient definition of custom overloading schemes
+* some syntax for opaque operations
+
+P.S. Name "quasiquote-2.0" comes from "patronus 2.0" spell from www.hpmor.com
+     and has nothing to do with being "the 2.0" version of quasiquote.
\ No newline at end of file
diff --git a/third_party/lisp/quasiquote_2/default.nix b/third_party/lisp/quasiquote_2/default.nix
new file mode 100644
index 000000000000..521c384787fe
--- /dev/null
+++ b/third_party/lisp/quasiquote_2/default.nix
@@ -0,0 +1,17 @@
+# Quasiquote more suitable for macros that define other macros
+{ depot, ... }:
+
+depot.nix.buildLisp.library {
+  name = "quasiquote-2.0";
+
+  deps = [
+    depot.third_party.lisp.iterate
+  ];
+
+  srcs = [
+    ./package.lisp
+    ./quasiquote-2.0.lisp
+    ./macros.lisp
+    ./readers.lisp
+  ];
+}
diff --git a/third_party/lisp/quasiquote_2/macros.lisp b/third_party/lisp/quasiquote_2/macros.lisp
new file mode 100644
index 000000000000..6ebeb47d081e
--- /dev/null
+++ b/third_party/lisp/quasiquote_2/macros.lisp
@@ -0,0 +1,15 @@
+
+(in-package #:quasiquote-2.0)
+
+(defmacro define-dig-like-macro (name)
+  `(defmacro ,name (n-or-form &optional (form nil form-p) &environment env)
+     (if (not form-p)
+	 `(,',name 1 ,n-or-form)
+	 (let ((*env* env))
+	   (transform-dig-form `(,',name ,n-or-form ,form))))))
+
+
+(define-dig-like-macro dig)
+(define-dig-like-macro odig)
+
+
diff --git a/third_party/lisp/quasiquote_2/package.lisp b/third_party/lisp/quasiquote_2/package.lisp
new file mode 100644
index 000000000000..9b140ef84c32
--- /dev/null
+++ b/third_party/lisp/quasiquote_2/package.lisp
@@ -0,0 +1,11 @@
+;;;; package.lisp
+
+(defpackage #:quasiquote-2.0
+  (:use #:cl #:iterate)
+  (:export #:%codewalk-dig-form #:transform-dig-form
+	   #:dig #:inject #:splice #:odig #:oinject #:osplice
+	   #:macro-inject #:omacro-inject #:macro-splice #:omacro-splice
+	   #:macro-inject-all #:omacro-inject-all #:macro-splice-all #:omacro-splice-all
+	   #:enable-quasiquote-2.0 #:disable-quasiquote-2.0))
+
+
diff --git a/third_party/lisp/quasiquote_2/quasiquote-2.0.asd b/third_party/lisp/quasiquote_2/quasiquote-2.0.asd
new file mode 100644
index 000000000000..3acfd32b80e6
--- /dev/null
+++ b/third_party/lisp/quasiquote_2/quasiquote-2.0.asd
@@ -0,0 +1,30 @@
+;;;; quasiquote-2.0.asd
+
+(defpackage :quasiquote-2.0-system
+  (:use :cl :asdf))
+
+(in-package quasiquote-2.0-system)
+
+(asdf:defsystem #:quasiquote-2.0
+  :serial t
+  :description "Writing macros that write macros. Effortless."
+  :author "Alexandr Popolitov <popolit@gmail.com>"
+  :license "MIT"
+  :version "0.3"
+  :depends-on (#:iterate)
+  :components ((:file "package")
+               (:file "quasiquote-2.0")
+	       (:file "macros")
+	       (:file "readers")))
+
+(defsystem :quasiquote-2.0-tests
+  :description "Tests for QUASIQUOTE-2.0"
+  :licence "MIT"
+  :depends-on (:quasiquote-2.0 :fiveam)
+  :components ((:file "tests")
+	       (:file "tests-macro")
+	       ))
+
+(defmethod perform ((op test-op) (sys (eql (find-system :quasiquote-2.0))))
+  (load-system :quasiquote-2.0)
+  (funcall (intern "RUN-TESTS" :quasiquote-2.0)))
diff --git a/third_party/lisp/quasiquote_2/quasiquote-2.0.lisp b/third_party/lisp/quasiquote_2/quasiquote-2.0.lisp
new file mode 100644
index 000000000000..10043fe0ecbc
--- /dev/null
+++ b/third_party/lisp/quasiquote_2/quasiquote-2.0.lisp
@@ -0,0 +1,340 @@
+;;;; quasiquote-2.0.lisp
+
+(in-package #:quasiquote-2.0)
+
+(defparameter *env* nil)
+
+(defmacro nonsense-error (str)
+  `(error ,(concatenate 'string
+			str
+			" appears as a bare, non DIG-enclosed form. "
+			"For now I don't know how to make sense of this.")))
+
+(defmacro define-nonsense-when-bare (name)
+  `(defmacro ,name (n-or-form &optional form)
+     (declare (ignore n-or-form form))
+     (nonsense-error ,(string name))))
+
+(define-nonsense-when-bare inject)
+(define-nonsense-when-bare oinject)
+(define-nonsense-when-bare splice)
+(define-nonsense-when-bare osplice)
+(define-nonsense-when-bare macro-inject)
+
+(defparameter *depth* 0)
+
+
+(defparameter *injectors* nil)
+
+(defparameter *void-elt* nil)
+(defparameter *void-filter-needed* nil)
+
+;; (defmacro with-injector-parsed (form)
+;;   `(let ((kwd (intern (string 
+
+(defun reset-injectors ()
+  (setf *injectors* nil))
+
+(defparameter *known-injectors* '(inject splice oinject osplice
+				  macro-inject omacro-inject
+				  macro-splice omacro-splice
+				  macro-inject-all omacro-inject-all
+				  macro-splice-all omacro-splice-all))
+
+(defun injector-form-p (form)
+  (and (consp form)
+       (find (car form) *known-injectors* :test #'eq)))
+
+(defun injector-level (form)
+  (if (equal 2 (length form))
+      1
+      (cadr form)))
+
+(defun injector-subform (form)
+  (if (equal 2 (length form))
+      (values (cdr form) '(cdr))
+      (values (cddr form) '(cddr))))
+
+(defparameter *opaque-injectors* '(odig oinject osplice omacro-inject))
+
+(defun transparent-p (form)
+  (not (find (car form) *opaque-injectors* :test #'eq)))
+
+(defun look-into-injector (form path)
+  (let ((*depth* (- *depth* (injector-level form))))
+    (multiple-value-bind (subform subpath) (injector-subform form)
+      (search-all-active-sites subform (append subpath path) nil))))
+
+(defparameter *known-diggers* '(dig odig))
+
+(defun dig-form-p (form)
+  (and (consp form)
+       (find (car form) *known-diggers* :test #'eq)))
+
+(defun look-into-dig (form path)
+  (let ((*depth* (+ *depth* (injector-level form))))
+    (multiple-value-bind (subform subpath) (injector-subform form)
+      (search-all-active-sites subform (append subpath path) nil))))
+
+(defun handle-macro-1 (form)
+  (if (atom form)
+      (error "Sorry, symbol-macros are not implemented for now")
+      (let ((fun (macro-function (car form) *env*)))
+	(if (not fun)
+	    (error "The subform of MACRO-1 injector is supposed to be macro, perhaps, something went wrong..."))
+	(macroexpand-1 form *env*))))
+
+(defun handle-macro-all (form)
+  (if (atom form)
+      (error "Sorry, symbol-macros are not implemented for now")
+      (macroexpand form *env*)))
+
+
+(defparameter *macro-handlers* `((macro-inject . ,#'handle-macro-1)
+				 (omacro-inject . ,#'handle-macro-1)
+				 (macro-splice . ,#'handle-macro-1)
+				 (omacro-splice . ,#'handle-macro-1)
+				 (macro-inject-all . ,#'handle-macro-all)
+				 (omacro-inject-all . ,#'handle-macro-all)
+				 (macro-splice-all . ,#'handle-macro-all)
+				 (omacro-splice-all . ,#'handle-macro-all)))
+
+(defun get-macro-handler (sym)
+  (or (cdr (assoc sym *macro-handlers*))
+      (error "Don't know how to handle this macro injector: ~a" sym)))
+
+	
+
+(defun macroexpand-macroinjector (place)
+  (if (not (splicing-injector (car place)))
+      (progn (setf (car place) (funcall (get-macro-handler (caar place))
+					(car (injector-subform (car place)))))
+	     nil)
+      (let ((new-forms (funcall (get-macro-handler (caar place))
+				(car (injector-subform (car place))))))
+	(cond ((not new-forms)
+	       (setf *void-filter-needed* t
+		     (car place) *void-elt*))
+	      ((atom new-forms) (error "We need to splice the macroexpansion, but got atom: ~a" new-forms))
+	      (t (setf (car place) (car new-forms))
+		 (let ((tail (cdr place)))
+		   (setf (cdr place) (cdr new-forms)
+			 (cdr (last new-forms)) tail))))
+	t)))
+	    
+
+(defun search-all-active-sites (form path toplevel-p)
+  ;; (format t "SEARCH-ALL-ACTIVE-SITES: got form ~a~%" form)
+  (if (not form)
+      nil
+      (if toplevel-p
+	  (cond ((atom (car form)) :just-quote-it!)
+		((injector-form-p (car form)) (if (equal *depth* (injector-level (car form)))
+						  :just-form-it!
+						  (if (transparent-p (car form))
+						      (look-into-injector (car form) (cons 'car path)))))
+		((dig-form-p (car form))
+		 ;; (format t "Got dig form ~a~%" form)
+		 (if (transparent-p (car form))
+		     (look-into-dig (car form) (cons 'car path))))
+		(t (search-all-active-sites (car form) (cons 'car path) nil)
+		   (search-all-active-sites (cdr form) (cons 'cdr path) nil)))
+	  (when (consp form)
+	    (cond ((dig-form-p (car form))
+		   ;; (format t "Got dig form ~a~%" form)
+		   (if (transparent-p (car form))
+		       (look-into-dig (car form) (cons 'car path))))
+		  ((injector-form-p (car form))
+		   ;; (format t "Got injector form ~a ~a ~a~%" form *depth* (injector-level (car form)))
+		   (if (equal *depth* (injector-level (car form)))
+		       (if (macro-injector-p (car form))
+			   (progn (macroexpand-macroinjector form)
+				  (return-from search-all-active-sites
+				    (search-all-active-sites form path nil)))
+			   (progn (push (cons form (cons 'car path)) *injectors*)
+				  nil))
+		       (if (transparent-p (car form))
+			   (look-into-injector (car form) (cons 'car path)))))
+		  (t (search-all-active-sites (car form) (cons 'car path) nil)))
+	    (search-all-active-sites (cdr form) (cons 'cdr path) nil)))))
+
+	  
+	      
+(defun codewalk-dig-form (form)
+  (reset-injectors)
+  (let ((it (search-all-active-sites form nil t)))
+    (values (nreverse *injectors*) it)))
+
+(defun %codewalk-dig-form (form)
+  (if (not (dig-form-p form))
+      (error "Supposed to be called on dig form")
+      (let ((*depth* (+ (injector-level form) *depth*)))
+	(codewalk-dig-form (injector-subform form)))))
+
+(defun path->setfable (path var)
+  (let ((res var))
+    ;; First element is artifact of extra CAR-ing
+    (dolist (spec (cdr (reverse path)))
+      (setf res (list spec res)))
+    res))
+
+(defun tree->cons-code (tree)
+  (if (atom tree)
+      `(quote ,tree)
+      `(cons ,(tree->cons-code (car tree))
+	     ,(tree->cons-code (cdr tree)))))
+
+(defparameter *known-splicers* '(splice osplice
+				 macro-splice omacro-splice
+				 macro-splice-all omacro-splice-all))
+
+(defun splicing-injector (form)
+  (and (consp form)
+       (find (car form) *known-splicers* :test #'eq)))
+
+(defparameter *known-macro-injectors* '(macro-inject omacro-inject
+					macro-splice omacro-splice
+					macro-inject-all omacro-inject-all
+					macro-splice-all omacro-splice-all
+					))
+
+(defun macro-injector-p (form)
+  (and (consp form)
+       (find (car form) *known-macro-injectors* :test #'eq)))
+
+(defun filter-out-voids (lst void-sym)
+  (let (caars cadrs cdars cddrs)
+    ;; search for all occurences of VOID
+    (labels ((rec (x)
+	       (if (consp x)
+		   (progn (cond ((consp (car x))
+				 (cond ((eq void-sym (caar x)) (push x caars))
+				       ((eq void-sym (cdar x)) (push x cdars))))
+				((consp (cdr x))
+				 (cond ((eq void-sym (cadr x)) (push x cadrs))
+				       ((eq void-sym (cddr x)) (push x cddrs)))))
+			  (rec (car x))
+			  (rec (cdr x))))))
+      (rec lst))
+    (if (or cdars cddrs)
+	(error "Void sym found on CDR position, which should not have happened"))
+    ;; destructively transform LST
+    (dolist (elt caars)
+      (setf (car elt) (cdar elt)))
+    (dolist (elt cadrs)
+      (setf (cdr elt) (cddr elt)))
+    ;; check that we indeed filtered-out all VOIDs
+    (labels ((rec (x)
+	       (if (not (atom x))
+		   (progn (rec (car x))
+			  (rec (cdr x)))
+		   (if (eq void-sym x)
+		       (error "Not all VOIDs were filtered")))))
+      (rec lst))
+    lst))
+
+(defun transform-dig-form (form)
+  (let ((the-form (copy-tree form)))
+    (let ((*void-filter-needed* nil)
+	  (*void-elt* (gensym "VOID")))
+      (multiple-value-bind (site-paths cmd) (%codewalk-dig-form the-form)
+	(cond ((eq cmd :just-quote-it!)
+	       `(quote ,(car (injector-subform the-form))))
+	      ((eq cmd :just-form-it!)
+	       (car (injector-subform (car (injector-subform the-form)))))
+	      (t (let ((cons-code (if (not site-paths)
+				      (tree->cons-code (car (injector-subform the-form)))
+				      (really-transform-dig-form the-form site-paths))))
+		   (if (not *void-filter-needed*)
+		       cons-code
+		       `(filter-out-voids ,cons-code ',*void-elt*)))))))))
+
+(defmacro make-list-form (o!-n form)
+  (let ((g!-n (gensym "N"))
+	(g!-i (gensym "I"))
+	(g!-res (gensym "RES")))
+    `(let ((,g!-n ,o!-n)
+	   (,g!-res nil))
+       (dotimes (,g!-i ,g!-n)
+	 (push ,form ,g!-res))
+       (nreverse ,g!-res))))
+
+(defun mk-splicing-injector-let (x)
+  `(let ((it ,(car (injector-subform x))))
+     (assert (listp it))
+     (copy-list it)))
+
+
+
+(defun mk-splicing-injector-setf (path g!-list g!-splicee)
+  (assert (eq 'car (car path)))
+  (let ((g!-rest (gensym "REST")))
+    `(let ((,g!-rest ,(path->setfable (cons 'cdr (cdr path)) g!-list)))
+       (assert (or (not ,g!-rest) (consp ,g!-rest)))
+       (if (not ,g!-splicee)
+	   (setf ,(path->setfable (cdr path) g!-list)
+		 ,g!-rest)
+	   (progn (setf ,(path->setfable (cdr path) g!-list) ,g!-splicee)
+		  (setf (cdr (last ,g!-splicee)) ,g!-rest))))))
+
+
+(defun really-transform-dig-form (the-form site-paths)
+  (let ((gensyms (make-list-form (length site-paths) (gensym "INJECTEE"))))
+    (let ((g!-list (gensym "LIST")))
+      (let ((lets nil)
+	    (splicing-setfs nil)
+	    (setfs nil))
+	(do ((site-path site-paths (cdr site-path))
+	     (gensym gensyms (cdr gensym)))
+	    ((not site-path))
+	  (destructuring-bind (site . path) (car site-path)
+	    (push `(,(car gensym) ,(if (not (splicing-injector (car site)))
+				       (car (injector-subform (car site)))
+				       (mk-splicing-injector-let (car site))))
+		  lets)
+	    (if (not (splicing-injector (car site)))
+		(push `(setf ,(path->setfable path g!-list) ,(car gensym)) setfs)
+		(push (mk-splicing-injector-setf path g!-list (car gensym)) splicing-setfs))
+	    (setf (car site) nil)))
+	`(let ,(nreverse lets)
+	   (let ((,g!-list ,(tree->cons-code (car (injector-subform the-form)))))
+	     ,@(nreverse setfs)
+	     ;; we apply splicing setf in reverse order for them not to bork the paths of each other
+	     ,@splicing-setfs
+	     ,g!-list))))))
+
+
+;; There are few types of recursive injection that may happen:
+;;   * compile-time injection:
+;;     (dig (inject (dig (inject a)))) -- this type will be handled automatically by subsequent macroexpansions
+;;   * run-time injection:
+;;     (dig (dig (inject 2 a)))
+;;     and A is '(dig (inject 3 'foo)) -- this one we guard against ? (probably, first we just ignore it
+;;     -- do not warn about it, and then it wont really happen.
+;;   * macroexpanded compile-time injection:
+;;     (dig (inject (my-macro a b c))),
+;;     where MY-MACRO expands into, say (splice (list 'a 'b 'c))
+;;     This is *not* handled automatically, and therefore we must do it by hand.
+
+      
+;; OK, now how to implement splicing ?
+;;   (dig (a (splice (list b c)) d))
+;; should transform into code that yields
+;;   (a b c d)
+;; what this code is?
+;;   (let ((#:a (copy-list (list b c))))
+;;     (let ((#:res (cons 'a nil 'd)))
+;;       ;; all non-splicing injects go here, as they do not spoil the path-structure
+;;       (setf (cdr #:res) #:a)
+;;       (setf (cdr (last #:a)) (cdr (cdr #:res)))
+;;       #:res)))
+
+
+;; How this macroexpansion should work in general?
+;;   * We go over the cons-tree, keeping track of the depth level, which is
+;;   controlled by DIG's
+;;   * Once we find the INJECT with matching level, we remember the place, where
+;;     this happens
+;;   * We have two special cases:
+;;     * cons-tree is an atom
+;;     * cons-tree is just a single INJECT
diff --git a/third_party/lisp/quasiquote_2/readers.lisp b/third_party/lisp/quasiquote_2/readers.lisp
new file mode 100644
index 000000000000..7c4c5a30c98e
--- /dev/null
+++ b/third_party/lisp/quasiquote_2/readers.lisp
@@ -0,0 +1,77 @@
+
+
+(in-package #:quasiquote-2.0)
+
+(defun read-n-chars (stream char)
+  (let (new-char
+	(n 0))
+    (loop
+       (setf new-char (read-char stream nil :eof t))
+       (if (not (char= new-char char))
+	   (progn (unread-char new-char stream)
+		  (return n))
+	   (incf n)))))
+
+(defmacro define-dig-reader (name symbol)
+  `(defun ,name (stream char)
+     (let ((depth (1+ (read-n-chars stream char))))
+       (if (equal 1 depth)
+	   (list ',symbol (read stream t nil t))
+	   (list ',symbol
+		 depth
+		 (read stream t nil t))))))
+
+(define-dig-reader dig-reader dig)
+(define-dig-reader odig-reader odig)
+
+(defun expect-char (char stream)
+  (let ((new-char (read-char stream t nil t)))
+    (if (char= char new-char)
+	t
+	(unread-char new-char stream))))
+
+(defun guess-injector-name (opaque-p macro-p all-p splicing-p)
+  (intern (concatenate 'string
+		       (if opaque-p "O" "")
+		       (if macro-p "MACRO-" "")
+		       (if splicing-p "SPLICE" "INJECT")
+		       (if all-p "-ALL" ""))
+	  "QUASIQUOTE-2.0"))
+
+(defun inject-reader (stream char)
+  (let ((anti-depth (1+ (read-n-chars stream char)))
+	(extended-syntax (expect-char #\! stream)))
+    (let ((injector-name (if (not extended-syntax)
+			     (guess-injector-name nil nil nil (expect-char #\@ stream))
+			     (guess-injector-name (expect-char #\o stream)
+						  (expect-char #\m stream)
+						  (expect-char #\a stream)
+						  (expect-char #\@ stream)))))
+      `(,injector-name ,@(if (not (equal 1 anti-depth)) `(,anti-depth))
+		       ,(read stream t nil t)))))
+
+
+
+(defvar *previous-readtables* nil)
+
+(defun %enable-quasiquote-2.0 ()
+  (push *readtable*
+        *previous-readtables*)
+  (setq *readtable* (copy-readtable))
+  (set-macro-character #\` #'dig-reader)
+  (set-macro-character #\, #'inject-reader)
+  (values))
+
+(defun %disable-quasiquote-2.0 ()
+  (if *previous-readtables*
+      (setf *readtable* (pop *previous-readtables*))
+      (setf *readtable* (copy-readtable nil)))
+  (values))
+
+(defmacro enable-quasiquote-2.0 ()
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (%enable-quasiquote-2.0)))
+(defmacro disable-quasiquote-2.0 ()
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (%disable-quasiquote-2.0)))
+  
diff --git a/third_party/lisp/quasiquote_2/tests-macro.lisp b/third_party/lisp/quasiquote_2/tests-macro.lisp
new file mode 100644
index 000000000000..df6c43e21d77
--- /dev/null
+++ b/third_party/lisp/quasiquote_2/tests-macro.lisp
@@ -0,0 +1,21 @@
+
+(in-package #:quasiquote-2.0-tests)
+
+(in-suite quasiquote-2.0)
+
+(enable-quasiquote-2.0)
+
+(defmacro define-sample-macro (name args &body body)
+  `(defmacro ,name ,args
+     `(sample-thing-to-macroexpand-to
+       ,,@body)))
+
+(define-sample-macro sample-macro-1 (x y)
+  ,x ,y)
+
+(define-sample-macro sample-macro-2 (&body body)
+  ,@body)
+
+(test macro-defined-macroexpansions
+  (is (equal '(sample-thing-to-macroexpand-to a b) (macroexpand-1 '(sample-macro-1 a b))))
+  (is (equal '(sample-thing-to-macroexpand-to a b c) (macroexpand-1 '(sample-macro-2 a b c)))))
\ No newline at end of file
diff --git a/third_party/lisp/quasiquote_2/tests.lisp b/third_party/lisp/quasiquote_2/tests.lisp
new file mode 100644
index 000000000000..6c8ab08cc1af
--- /dev/null
+++ b/third_party/lisp/quasiquote_2/tests.lisp
@@ -0,0 +1,143 @@
+(in-package :cl-user)
+
+(defpackage :quasiquote-2.0-tests
+  (:use :cl :quasiquote-2.0 :fiveam)
+  (:export #:run-tests))
+
+(in-package :quasiquote-2.0-tests)
+
+(def-suite quasiquote-2.0)
+(in-suite quasiquote-2.0)
+
+(defun run-tests ()
+  (let ((results (run 'quasiquote-2.0)))
+    (fiveam:explain! results)
+    (unless (fiveam:results-status results)
+      (error "Tests failed."))))
+
+(test basic
+  (is (equal '(nil :just-quote-it!) (multiple-value-list (%codewalk-dig-form '(dig nil)))))
+  (is (equal '(nil :just-form-it!) (multiple-value-list (%codewalk-dig-form '(dig (inject a))))))
+  (is (equal '(nil :just-form-it!) (multiple-value-list (%codewalk-dig-form '(dig 2 (inject 2 a))))))
+  (is (equal '(((((inject b) c (inject d)) car cdr car) (((inject d)) car cdr cdr cdr car)) nil)
+	     (multiple-value-list (%codewalk-dig-form '(dig (a (inject b) c (inject d)))))))
+  (is (equal '(nil nil)
+	     (multiple-value-list (%codewalk-dig-form '(dig (dig (a (inject b) c (inject d))))))))
+  (is (equal '(((((inject 2 d)) car cdr cdr cdr car cdr car)) nil)
+	     (multiple-value-list (%codewalk-dig-form '(dig (dig (a (inject b) c (inject 2 d)))))))))
+  
+(test transform
+  (is (equal '(quote a) (transform-dig-form '(dig a))))
+  (is (equal '(quote a) (transform-dig-form '(dig 2 a))))
+  (is (equal 'a (transform-dig-form '(dig (inject a)))))
+  (is (equal 'a (transform-dig-form '(dig 2 (inject 2 a))))))
+
+(defun foo (b d)
+  (dig (a (inject b) c (inject d))))
+
+(defun foo1-transparent (x)
+  (declare (ignorable x))
+  (dig (dig (a (inject (b (inject x) c))))))
+
+(defun foo1-opaque (x)
+  (declare (ignorable x))
+  (dig (dig (a (oinject (b (inject x) c))))))
+
+(defun foo-recursive (x y)
+  (dig (a (inject (list x (dig (c (inject y))))))))
+  
+
+(test foos
+  (is (equal '(a 1 c 2) (foo 1 2)))
+  (is (equal '(a 100 c 200) (foo 100 200))))
+
+(test opaque-vs-transparent
+  (is (equal '(quote a) (transform-dig-form '(odig a))))
+  (is (equal '(quote a) (transform-dig-form '(odig 2 a))))
+  (is (equal 'a (transform-dig-form '(odig (inject a)))))
+  (is (equal 'a (transform-dig-form '(odig 2 (inject 2 a)))))
+  (is (equal '(odig (inject 2 a)) (eval (transform-dig-form '(dig (odig (inject 2 a)))))))
+  (is (equal '(dig (a (inject (b 3 c)))) (foo1-transparent 3)))
+  (is (equal '(dig (a (oinject (b (inject x) c)))) (foo1-opaque 3))))
+
+(test recursive-compile-time
+  (is (equal '(a (1 (c 2))) (foo-recursive 1 2))))
+	     
+
+(test splicing
+  (is (equal '(a b c d) (eval (transform-dig-form '(dig (a (splice '(b c)) d))))))
+  (is (equal '(b c d) (eval (transform-dig-form '(dig ((splice '(b c)) d))))))
+  (is (equal '(a b c) (eval (transform-dig-form '(dig (a (splice '(b c))))))))
+  (is (equal '(a b) (eval (transform-dig-form '(dig (a (splice nil) b))))))
+  (is (equal '(b) (eval (transform-dig-form '(dig ((splice nil) b))))))
+  (is (equal '(a) (eval (transform-dig-form '(dig (a (splice nil)))))))
+  (is (equal '() (eval (transform-dig-form '(dig ((splice nil)))))))
+  (is (equal '(a b) (eval (transform-dig-form '(dig ((splice '(a b)))))))))
+
+
+(test are-they-macro
+  (is (not (equal '(dig (a b)) (macroexpand-1 '(dig (a b))))))
+  (is (not (equal '(odig (a b)) (macroexpand-1 '(odig (a b)))))))
+
+
+(defmacro triple-var (x)
+  `((inject ,x) (inject ,x) (inject ,x)))
+
+(test correct-order-of-effects
+  (is (equal '(a 1 2 3) (let ((x 0))
+			  (dig (a (inject (incf x)) (inject (incf x)) (inject (incf x)))))))
+  (is (equal '(a (((1))) 2)
+	     (let ((x 0))
+	       (dig (a ((((inject (incf x))))) (inject (incf x))))))))
+
+(test macro-injects
+  (is (equal '(a (3 3 3)) (let ((x 3))
+			    (dig (a (macro-inject (triple-var x)))))))
+  (is (equal '(a (1 2 3)) (let ((x 0))
+			    (dig (a (macro-inject (triple-var (incf x))))))))
+  (macrolet ((frob (form n)
+	       (mapcar (lambda (x)
+			 `(inject ,x))
+		       (make-list n :initial-element form)))
+	     (frob1 (form)
+	       `(frob ,form 4)))
+    (is (equal '(a (1 2 3 4 5))
+	       (let ((x 0))
+		 (dig (a (macro-inject (frob (incf x) 5)))))))
+    (is (equal '(a 1 2 3 4 5)
+	       (let ((x 0))
+		 (dig (a (macro-splice (frob (incf x) 5)))))))
+    (is (equal '(a)
+	       (let ((x 0))
+		 (declare (ignorable x))
+		 (dig (a (macro-splice (frob (incf x) 0)))))))
+    (is (equal '(a frob (incf x) 4)
+	       (let ((x 0))
+		 (declare (ignorable x))
+		 (dig (a (macro-splice (frob1 (incf x))))))))
+    (is (equal '(a 1 2 3 4)
+	       (let ((x 0))
+		 (dig (a (macro-splice-all (frob1 (incf x))))))))))
+    
+	       
+(quasiquote-2.0:enable-quasiquote-2.0)
+
+(test reader
+  (is (equal '(inject x) ',x))
+  (is (equal '(inject 3 x) ',,,x))
+  (is (equal '(splice x) ',@x))
+  (is (equal '(splice 3 x) ',,,@x))
+  (is (equal '(omacro-splice-all 4 x) ',,,,!oma@x))
+  (is (equal '(inject 4 oma@x) ',,,,oma@x)))
+
+(test macro-splices
+  (macrolet ((splicer (x)
+	       ``(splice ,x)))
+    (is (equal '(a 1 2 3) (let ((x '(1 2 3)))
+			    `(a ,!m(splicer x)))))))
+
+(test repeated-splices
+  (is (equal '(a) `(a ,@nil ,@nil ,@nil ,@nil)))
+  (is (equal '(a b c d e f g) `(a ,@(list 'b 'c) ,@(list 'd 'e) ,@nil ,@(list 'f 'g)))))
+
+  
\ No newline at end of file
diff --git a/third_party/lisp/rfc2388.nix b/third_party/lisp/rfc2388.nix
new file mode 100644
index 000000000000..b82a490c9d71
--- /dev/null
+++ b/third_party/lisp/rfc2388.nix
@@ -0,0 +1,12 @@
+# Implementation of RFC2388 (multipart/form-data)
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.rfc2388;
+in depot.nix.buildLisp.library {
+  name = "rfc2388";
+
+  srcs = map (f: src + ("/" + f)) [
+    "packages.lisp"
+    "rfc2388.lisp"
+  ];
+}
diff --git a/third_party/lisp/routes.nix b/third_party/lisp/routes.nix
new file mode 100644
index 000000000000..fc7d4e306713
--- /dev/null
+++ b/third_party/lisp/routes.nix
@@ -0,0 +1,39 @@
+{ depot, pkgs, ... }:
+
+let
+
+  src = pkgs.applyPatches {
+    name = "routes-source";
+    src = pkgs.fetchFromGitHub {
+      owner = "archimag";
+      repo = "cl-routes";
+      rev = "1b79e85aa653e1ec87e21ca745abe51547866fa9";
+      sha256 = "1zpk3cp2v8hm50ppjl10yxr437vv4552r8hylvizglzrq2ibsbr1";
+    };
+
+    patches = [
+      (pkgs.fetchpatch {
+        name = "fix-build-with-ccl.patch";
+        url = "https://github.com/archimag/cl-routes/commit/2296cdc316ef8e34310f2718b5d35a30040deee0.patch";
+        sha256 = "007c19kmymalam3v6l6y2qzch8xs3xnphrcclk1jrpggvigcmhax";
+      })
+    ];
+  };
+
+in
+depot.nix.buildLisp.library {
+  name = "routes";
+
+  deps = with depot.third_party.lisp; [
+    puri
+    iterate
+    split-sequence
+  ];
+
+  srcs = map (f: src + ("/src/" + f)) [
+    "package.lisp"
+    "uri-template.lisp"
+    "route.lisp"
+    "mapper.lisp"
+  ];
+}
diff --git a/third_party/lisp/s-sysdeps.nix b/third_party/lisp/s-sysdeps.nix
new file mode 100644
index 000000000000..9c4da4a02b25
--- /dev/null
+++ b/third_party/lisp/s-sysdeps.nix
@@ -0,0 +1,18 @@
+# A Common Lisp abstraction layer over platform dependent functionality.
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.s-sysdeps;
+in depot.nix.buildLisp.library {
+  name = "s-sysdeps";
+
+  srcs = [
+    "${src}/src/package.lisp"
+    "${src}/src/sysdeps.lisp"
+  ];
+
+  deps = with depot.third_party.lisp; [
+    bordeaux-threads
+    usocket
+    usocket-server
+  ];
+}
diff --git a/third_party/lisp/s-xml/0001-fix-definition-order-in-xml.lisp.patch b/third_party/lisp/s-xml/0001-fix-definition-order-in-xml.lisp.patch
new file mode 100644
index 000000000000..9e5838c3c545
--- /dev/null
+++ b/third_party/lisp/s-xml/0001-fix-definition-order-in-xml.lisp.patch
@@ -0,0 +1,26 @@
+From 789dc38399f4039b114de28384c149721d66b030 Mon Sep 17 00:00:00 2001
+From: Vincent Ambo <mail@tazj.in>
+Date: Thu, 16 Dec 2021 00:48:04 +0300
+Subject: [PATCH] fix definition order in xml.lisp
+
+---
+ src/xml.lisp | 3 +++
+ 1 file changed, 3 insertions(+)
+
+diff --git a/src/xml.lisp b/src/xml.lisp
+index 39c9b63..3232491 100644
+--- a/src/xml.lisp
++++ b/src/xml.lisp
+@@ -19,6 +19,9 @@
+ 
+ ;;; error reporting
+ 
++(defvar *ignore-namespaces* nil
++  "When t, namespaces are ignored like in the old version of S-XML")
++
+ (define-condition xml-parser-error (error)
+   ((message :initarg :message :reader xml-parser-error-message)
+    (args :initarg :args :reader xml-parser-error-args)
+-- 
+2.34.0
+
diff --git a/third_party/lisp/s-xml/default.nix b/third_party/lisp/s-xml/default.nix
new file mode 100644
index 000000000000..486e1c1ac8d3
--- /dev/null
+++ b/third_party/lisp/s-xml/default.nix
@@ -0,0 +1,25 @@
+# XML serialiser for Common Lisp.
+{ depot, pkgs, ... }:
+
+let
+  src = pkgs.applyPatches {
+    name = "s-xml-source";
+    src = pkgs.lispPackages.s-xml.src;
+
+    patches = [
+      ./0001-fix-definition-order-in-xml.lisp.patch
+    ];
+  };
+in
+depot.nix.buildLisp.library {
+  name = "s-xml";
+
+  srcs = map (f: src + ("/src/" + f)) [
+    "package.lisp"
+    "xml.lisp"
+    "dom.lisp"
+    "lxml-dom.lisp"
+    "sxml-dom.lisp"
+    "xml-struct-dom.lisp"
+  ];
+}
diff --git a/third_party/lisp/split-sequence.nix b/third_party/lisp/split-sequence.nix
new file mode 100644
index 000000000000..4e8f723c3182
--- /dev/null
+++ b/third_party/lisp/split-sequence.nix
@@ -0,0 +1,15 @@
+# split-sequence is a library for, well, splitting sequences apparently.
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.split-sequence;
+in depot.nix.buildLisp.library {
+  name = "split-sequence";
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "vector.lisp"
+    "list.lisp"
+    "extended-sequence.lisp"
+    "api.lisp"
+    "documentation.lisp"
+  ];
+}
diff --git a/third_party/lisp/trivial-backtrace.nix b/third_party/lisp/trivial-backtrace.nix
new file mode 100644
index 000000000000..27949e8be1e4
--- /dev/null
+++ b/third_party/lisp/trivial-backtrace.nix
@@ -0,0 +1,15 @@
+# Imported from http://common-lisp.net/project/trivial-backtrace/trivial-backtrace.git
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.trivial-backtrace;
+in depot.nix.buildLisp.library {
+  name = "trivial-backtrace";
+
+  srcs = map (f: src + ("/dev/" + f)) [
+    "packages.lisp"
+    "utilities.lisp"
+    "backtrace.lisp"
+    "map-backtrace.lisp"
+    "fallback.lisp"
+  ];
+}
diff --git a/third_party/lisp/trivial-features.nix b/third_party/lisp/trivial-features.nix
new file mode 100644
index 000000000000..02abac54a853
--- /dev/null
+++ b/third_party/lisp/trivial-features.nix
@@ -0,0 +1,13 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.trivial-features;
+in depot.nix.buildLisp.library {
+  name = "trivial-features";
+  srcs = [
+    {
+      sbcl = src + "/src/tf-sbcl.lisp";
+      ecl = src + "/src/tf-ecl.lisp";
+      ccl = src + "/src/tf-openmcl.lisp";
+    }
+  ];
+}
diff --git a/third_party/lisp/trivial-garbage.nix b/third_party/lisp/trivial-garbage.nix
new file mode 100644
index 000000000000..74224df60d91
--- /dev/null
+++ b/third_party/lisp/trivial-garbage.nix
@@ -0,0 +1,9 @@
+# trivial-garbage provides a portable API to finalizers, weak
+# hash-tables and weak pointers
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.trivial-garbage;
+in depot.nix.buildLisp.library {
+  name = "trivial-garbage";
+  srcs = [ (src + "/trivial-garbage.lisp") ];
+}
diff --git a/third_party/lisp/trivial-gray-streams.nix b/third_party/lisp/trivial-gray-streams.nix
new file mode 100644
index 000000000000..62a30f1e94f3
--- /dev/null
+++ b/third_party/lisp/trivial-gray-streams.nix
@@ -0,0 +1,13 @@
+# Portability library for CL gray streams.
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.trivial-gray-streams;
+in depot.nix.buildLisp.library {
+  name = "trivial-gray-streams";
+  srcs = [
+    (src + "/package.lisp")
+    (src + "/streams.lisp")
+  ];
+}
+
+
diff --git a/third_party/lisp/trivial-indent.nix b/third_party/lisp/trivial-indent.nix
new file mode 100644
index 000000000000..70a6e19d48a9
--- /dev/null
+++ b/third_party/lisp/trivial-indent.nix
@@ -0,0 +1,10 @@
+{ depot, pkgs, ... }:
+
+let src = with pkgs; srcOnly lispPackages.trivial-indent;
+in depot.nix.buildLisp.library {
+  name = "trivial-indent";
+
+  srcs = map (f: src + ("/" + f)) [
+    "indent.lisp"
+  ];
+}
diff --git a/third_party/lisp/trivial-ldap.nix b/third_party/lisp/trivial-ldap.nix
new file mode 100644
index 000000000000..c85fe2accbb9
--- /dev/null
+++ b/third_party/lisp/trivial-ldap.nix
@@ -0,0 +1,28 @@
+{ depot, pkgs, ... }:
+
+let
+  src = pkgs.fetchFromGitHub {
+    owner = "rwiker";
+    repo = "trivial-ldap";
+    rev = "3b8f1ff85f29ea63e6ab2d0d27029d68b046faf8";
+    sha256 = "1zaa4wnk5y5ff211pkg6dl27j4pjwh56hq0246slxsdxv6kvp1z9";
+  };
+in
+depot.nix.buildLisp.library {
+  name = "trivial-ldap";
+
+  deps = with depot.third_party.lisp; [
+    usocket
+    cl-plus-ssl
+    cl-yacc
+  ];
+
+  srcs = map (f: src + ("/" + f)) [
+    "package.lisp"
+    "trivial-ldap.lisp"
+  ];
+
+  brokenOn = [
+    "ecl" # dynamic cffi
+  ];
+}
diff --git a/third_party/lisp/trivial-mimes.nix b/third_party/lisp/trivial-mimes.nix
new file mode 100644
index 000000000000..b097a3d0ee67
--- /dev/null
+++ b/third_party/lisp/trivial-mimes.nix
@@ -0,0 +1,26 @@
+{ depot, pkgs, ... }:
+
+let
+  src = with pkgs; srcOnly lispPackages.trivial-mimes;
+
+  mime-types = pkgs.runCommand "mime-types.lisp" { } ''
+    substitute ${src}/mime-types.lisp $out \
+      --replace /etc/mime.types ${src}/mime.types \
+      --replace "(asdf:system-source-directory :trivial-mimes)" '"/bogus-dir"'
+      # We want to prevent an ASDF lookup at build time since this will
+      # generally fail — we are not using ASDF after all.
+  '';
+
+in
+depot.nix.buildLisp.library {
+  name = "trivial-mimes";
+
+  deps = [
+    {
+      sbcl = depot.nix.buildLisp.bundled "uiop";
+      default = depot.nix.buildLisp.bundled "asdf";
+    }
+  ];
+
+  srcs = [ mime-types ];
+}
diff --git a/third_party/lisp/uax-15.nix b/third_party/lisp/uax-15.nix
new file mode 100644
index 000000000000..f98c029d3688
--- /dev/null
+++ b/third_party/lisp/uax-15.nix
@@ -0,0 +1,43 @@
+{ depot, pkgs, ... }:
+
+let
+  inherit (pkgs) runCommand;
+  inherit (depot.nix.buildLisp) bundled;
+  src = with pkgs; srcOnly lispPackages.uax-15;
+in
+depot.nix.buildLisp.library {
+  name = "uax-15";
+
+  deps = with depot.third_party.lisp; [
+    split-sequence
+    cl-ppcre
+    (bundled "asdf")
+  ];
+
+  srcs = [
+    "${src}/src/package.lisp"
+    "${src}/src/utilities.lisp"
+    "${src}/src/trivial-utf-16.lisp"
+
+    # uax-15 has runtime data files that need to have their references
+    # replaced with store paths.
+    #
+    # additionally there are some wonky variable usages of variables
+    # that are never defined, for which we patch in defvar statements.
+    (runCommand "precomputed-tables.lisp" { } ''
+      substitute ${src}/src/precomputed-tables.lisp precomputed-tables.lisp \
+        --replace "(asdf:system-source-directory (asdf:find-system 'uax-15 nil))" \
+                  '"${src}/"'
+
+      sed -i precomputed-tables.lisp \
+        -e '10i(defvar *canonical-decomp-map*)' \
+        -e '10i(defvar *compatible-decomp-map*)' \
+        -e '10i(defvar *canonical-combining-class*)'
+
+      cp precomputed-tables.lisp $out
+    '')
+
+    "${src}/src/normalize-backend.lisp"
+    "${src}/src/uax-15.lisp"
+  ];
+}
diff --git a/third_party/lisp/unix-opts.nix b/third_party/lisp/unix-opts.nix
new file mode 100644
index 000000000000..248296113263
--- /dev/null
+++ b/third_party/lisp/unix-opts.nix
@@ -0,0 +1,12 @@
+# unix-opts is a portable command line argument parser
+{ depot, pkgs, ... }:
+
+
+let src = with pkgs; srcOnly lispPackages.unix-opts;
+in depot.nix.buildLisp.library {
+  name = "unix-opts";
+
+  srcs = [
+    "${src}/unix-opts.lisp"
+  ];
+}
diff --git a/third_party/lisp/usocket-server.nix b/third_party/lisp/usocket-server.nix
new file mode 100644
index 000000000000..5d6d04535f0c
--- /dev/null
+++ b/third_party/lisp/usocket-server.nix
@@ -0,0 +1,19 @@
+# Universal socket library for Common Lisp (server side)
+{ depot, pkgs, ... }:
+
+let
+  inherit (depot.nix) buildLisp;
+  src = with pkgs; srcOnly lispPackages.usocket-server;
+in
+buildLisp.library {
+  name = "usocket-server";
+
+  deps = with depot.third_party.lisp; [
+    usocket
+    bordeaux-threads
+  ];
+
+  srcs = [
+    "${src}/server.lisp"
+  ];
+}
diff --git a/third_party/lisp/usocket.nix b/third_party/lisp/usocket.nix
new file mode 100644
index 000000000000..589a3a0cfc92
--- /dev/null
+++ b/third_party/lisp/usocket.nix
@@ -0,0 +1,46 @@
+# Usocket is a portable socket library
+{ depot, pkgs, ... }:
+
+let
+  inherit (depot.nix) buildLisp;
+  src = with pkgs; srcOnly lispPackages.usocket;
+in
+buildLisp.library {
+  name = "usocket";
+  deps = with depot.third_party.lisp; [
+    (buildLisp.bundled "asdf")
+    {
+      ecl = buildLisp.bundled "sb-bsd-sockets";
+      sbcl = buildLisp.bundled "sb-bsd-sockets";
+    }
+    split-sequence
+  ];
+
+  srcs = [
+    # usocket also reads its version from ASDF, but there's further
+    # shenanigans happening there that I don't intend to support right
+    # now. Behold:
+    (builtins.toFile "usocket.asd" ''
+      (in-package :asdf)
+      (defsystem usocket
+        :version "0.8.3")
+    '')
+  ] ++
+  # Now for the regularly scheduled programming:
+  (map (f: src + ("/" + f)) [
+    "package.lisp"
+    "usocket.lisp"
+    "condition.lisp"
+  ] ++ [
+    { sbcl = "${src}/backend/sbcl.lisp"; }
+
+    # ECL actually has two files, it supports the SBCL backend,
+    # but usocket also has some ECL specific code
+    { ecl = "${src}/backend/sbcl.lisp"; }
+    { ecl = "${src}/backend/ecl.lisp"; }
+
+    # Same for CCL
+    { ccl = "${src}/backend/openmcl.lisp"; }
+    { ccl = "${src}/backend/clozure.lisp"; }
+  ]);
+}